mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
ozzloy_ is now known as ozzloy
bluestorm has quit [Remote closed the connection]
brooksbp has joined #ocaml
mwc has joined #ocaml
ita has quit [Remote closed the connection]
hsuh has joined #ocaml
|Catch22| has quit []
<palomer> http://ocaml.pastebin.com/m4e1c2f84 <--this error has been bothering me for an hour
<palomer> http://ocaml.pastebin.com/m1b6da54a <--a far simpler test case
<palomer> woops, there's missing a coercion in my test case
<palomer> (which my original version has)
<palomer> http://ocaml.pastebin.com/m736407a8 <-- test case
<palomer> can anyone explain this?
schme has joined #ocaml
schme has quit ["bfirc sucks."]
hsuh has quit [Remote closed the connection]
evn has joined #ocaml
<palomer> it seems that you can't coerce to a type that hasn't finished being defined
<palomer> man that sucks!
evn has left #ocaml []
<palomer> http://ocaml.pastebin.com/m196ba137 <--question about the difference between class types and purely virtual classes
<palomer> is there a difference?
thermoplyae has left #ocaml []
<palomer> is it possible to inherit from polymorphic classes
<palomer> class ['a] foo = ...
<palomer> class bar = object ; inherit int foo ; ...
<palomer> (which, of course, doesn't work)
asymptote has joined #ocaml
<thelema> palomer: you can't inherit from a class type.
<palomer> I guess I have to use a functor here, eh?
<palomer> thelema, does that answer the question from before?
<palomer> http://ocaml.pastebin.com/m44875294 <--yet this works fine
* thelema tries to make your cast work
<thelema> palomer: I don't see any problems with the m448 paste
<palomer> yeah
<palomer> im inheriting from a class type, though
<thelema> but your m736 paste might be solvable
<thelema> I don't think the inheritance matters.
<palomer> <thelema> palomer: you can't inherit from a class type. <--was providing a counter example
<palomer> m736 is due to the fact that node hasn't finished being defined
<palomer> there doesn't seem to be a solution to this
<thelema> class type can inherit from a class type. a class can't. But a class can inherit from a virtual class.
<palomer> so a class can't inherit from a class type
<thelema> I get the same problem in the m736 example even if I break the recursion.
<thelema> # class virtual b = object inherit a val mutable c = None method d e = c <- Some (e : b :> a) end;;
<thelema> The abbreviation b expands to type < d : b -> unit > but is used with type
<thelema> < >
<thelema> inherit a does nothing.
<thelema> inheriting from an empty class does nothing.
<palomer> I don't get an error if I break the recursion
<palomer> here's the code
<palomer> (btw, I've come up with simpler test cases if you're interested)
<thelema> hmmm... now I don't either...
<palomer> from Garrigue himself:
<thelema> ah, I see his post.
<palomer> You cannot coerce to a type that is not yet (fully) defined.
<palomer> In practice, what happens is that (e :> a) is just interpreted as
<palomer> (e : a), so that you are unifying a and b, with the above error.
<thelema> well, that's a nice way of doing casts... heh.
<palomer> hmm?
<thelema> I don't think functors will solve your problem. I recommend breaking the recursion and passing additional arguments.
<palomer> as in parametric classes?
<palomer> is it possible to inherit from parametric classes?
asymptote has quit ["Leaving"]
<thelema> no, having an extra argument in one object that accepts the piece of the other object it needs to use, and completing the recursion after declaration of both classes.
<thelema> I think it's possible to inherit from parametric classes, you just have to fill the type hole, either by inehriting within a parametric class, or by giving it a specific type when you inherit.
<palomer> I've decided to do away with the recursion altogether
<palomer> btw, how do I do this:
<palomer> module X = Term(struct type t = expression end)
<palomer> open X
<palomer> class expression (b:[`App of (function_signature*expression list)]) =
<palomer> which doesn't work because expression hasn't been defined yet
<palomer> I've declared a class inside Term which is parametric in T
<palomer> err, in t
<thelema> (sorry, distracted for a few minutes more)
<palomer> http://ocaml.pastebin.com/m4a18f06e <-- here's what I'm trying to do exactly
<palomer> take your time
<palomer> an alternative to using the functor is using a parametric class, but I have no idea how to inherit from them
<thelema> palomer: rec module E = struct class expression ... inherit X.term ... end type t = expression end and X = Term(E)
<thelema> this should work.
<thelema> term would be parametric if you didn't use the functor?
<palomer> yeah
<palomer> but what's the syntax for inheriting from a parametric class?
<thelema> so you'd have 'a term?
<palomer> yup
<thelema> [inherit expression term] might work, but then it might not inside expression itself.
<palomer> The class expression
<palomer> is not yet completely defined
<thelema> either use functors, or break this recursion too.
<palomer> module rec E =
<palomer> struct
<palomer> class expression ....
<palomer> end
<palomer> and X = Term(E)
<palomer> Parse error: [module_rec_binding] expected after 'rec' (in [str_item])
<palomer> (assuming you meant module rec and not rec module)
* thelema always gets syntax wrong
<palomer> it seems that I _have_ to put the signatures if I want to use recursive modules
<thelema> eww, that'll cause some problems. I forgot that part...
<palomer> definition::=...
<palomer> ∣ module rec module-name : module-type = module-expr { and module-name: module-type = module-expr }
* thelema does his best to avoid recursive modules.
<palomer> ditto
<thelema> the hard part comes in giving the full type of your objects, I expect.
<thelema> any way to break the recursion between expression and type?
<palomer> well, err, this is a convenience thing
<thelema> expression inherits from type, but type is parameterized by expression... that doesn't seem very natural...
<palomer> I have many classes which share this term interface
ikaros has joined #ocaml
<thelema> err, term.
<palomer> I have nodes, and nodes can either have parents of the same type or of the superclass node
<thelema> so you want to use their types to differentiate terms?
<palomer> so term implements this interface
<thelema> you want to use the type of the specific term as a type parameter of term?
<thelema> how about something more like `expression term?
<palomer> that's what my term class looks like
<thelema> is this correct?
<thelema> #
<thelema> #
<thelema> | Some (Left i) -> Some (i:> node )
<thelema> #
<thelema> | Some (Right i) -> Some (i :> node )
<palomer> sure
<palomer> expression implements node
<palomer> (inherits, rather)
<thelema> so why bother storing X.t? why not cast to node before it gets stored?
<thelema> and drop the either.
<palomer> because I might want to use the fact that it's of type X.t
<palomer> (actually, I know I'll need this fact)
<thelema> once you've gotten it, you always have a node, and you can't upcast
<palomer> if I use this method
<palomer> this method is inherited from node, but the expression class itself will want to access the parent directly
<thelema> hmmm... sounds like you can't factor this chunk of functionality outside of expression.
<palomer> it isn't a big deal, I can simply copy pasta it every where I need it
<palomer> it's surprising it can't be done, though
<palomer> (seems like a relatively simple operation)
* thelema will try some things
<palomer> I'd ask the list, but I've been asking so much! and I don't know what exactly to ask (I always find "how do you do this" questions to be a little misleading since your intentions are never clearly stated)
<thelema> class ['a] holder = object val mutable x = (None : 'a option) end;;
<thelema> class expr = object (self : 'a) inherit ['a] holder end;;
<thelema> class ['a] holder : object val mutable x : 'a option end
<thelema> class expr : object ('a) val mutable x : 'a option end
<thelema> how's that for inheriting from a polymorphic class with type argument the class doing the inheriting?
<palomer> cool
<thelema> (first two lines code, last two their types)
<palomer> I don't have to write out their types, right?
<thelema> no, you don't need their types.
* thelema poorly simulated a toplevel session
<palomer> righto
<thelema> class expr = object (self : 'a) inherit ['a] holder method set_self = x <- Some self end;;
<palomer> class virtual a = object method a end class virtual b = object method b end class virtual c = object inherit a; inherit b end <---this would give me an override error
<thelema> ?? what's overridden in your example?
<palomer> wait, it doesn't
<palomer> one sec...
<palomer> what if I want to override it?
<palomer> I want c#a to give me 5
<palomer> and I don't want to specify that b inherits from a
<palomer> is this possible?
<thelema> # class a = object method a = 4 end;;
<thelema> class a : object method a : int end
<thelema> # class b = object method a = 5 end;;
<thelema> class b : object method a : int end
<thelema> # class c = object inherit a inherit b end;;
<thelema> class c : object method a : int end
<thelema> # (new c)#a
<thelema> ;;
<thelema> - : int = 5
<palomer> righto
<palomer> but the warning bothers me
* thelema gets no warning.
<thelema> I'm not using any virtual classes.
<thelema> # class d = object inherit b inherit a end;;
<thelema> class d : object method a : int end
<thelema> # (new d)#a;;
<thelema> - : int = 4
<palomer> ah, but I want to use virtual classes
<palomer> I have a bunch of classes that may or may not reimplement different aspects of each other
<thelema> then ignore the warnings.
<palomer> ok
<palomer> is it possible to add a method to an object
<palomer> like if I have an object a : <foo: int, bar: bool>, can I create an object b : <foo:int, bar:bool, baz:float> ?
<palomer> (like, the opposite of :>)
AxleLonghorn has joined #ocaml
<thelema> classes, yes. objects... I don't think so.
* thelema tries to think about delegate classes, but that won't automatically capture all existing methods.
<palomer> for classes it's done with inherit
<palomer> right?
<thelema> yup.
<palomer> h
<palomer> well, functors can help out here
<palomer> oh wait, it can't
ttamttam has joined #ocaml
ttamttam has left #ocaml []
hkBst has joined #ocaml
* palomer prays to the ocaml gods that ocaml will have better module/class recursion on the next release
<palomer> this is nuts!
<thelema> palomer: what you try to do seems nuts. don't push too far past the bounds of a language.
<palomer> it is a little nuts
<palomer> but it seems so natural!
<palomer> you should see what those haskell wonks are doing (stuff like type arithmetic)
<palomer> expandable datatypes
<thelema> someone implemented a 2-bit adder in ocaml's type system...
<palomer> uses phantom types?
Demitar has quit [Read error: 110 (Connection timed out)]
<thelema> yup.
* palomer didn't know ocaml had phantom types
<palomer> I actually did my masters thesis on phantom types
<palomer> my personal conclusion is that they're rather useless
<thelema> I think I've used them once.
<palomer> I don't think they justify the hollabaloo they've created
* thelema isn't familiar with any phantom type hullabbaloo
<palomer> there's been like a gazzillion papers published
<palomer> I've leafed through about 20
bongy has joined #ocaml
* palomer is getting deeper and deeper into object hell
<palomer> is there any way to fake inheritance with records?
<palomer> I'm sick of classes!
<thelema> palomer: nope, the only way I know involves delegation.
Yoric[DT] has joined #ocaml
brooksbp has left #ocaml []
bongy has quit ["Leaving"]
filp has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
filp has quit ["Bye"]
AxleLonghorn has left #ocaml []
evn_ has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
evn_ has quit []
ertai has quit [Read error: 104 (Connection reset by peer)]
Snark has joined #ocaml
ygrek has joined #ocaml
ertai has joined #ocaml
<rwmjones> excellent ...
<rwmjones> my bit splitting / matching extension is starting to work
<rwmjones> let bits = Bitmatch.make_bitstring 24 '\x5a' (* makes the string 0x5a5a5a *)
<rwmjones> let () =
<rwmjones> bitmatch bits with
<rwmjones> | b0 : 1; b1 : 1; b2 : 1; b3 : 1; b4 : 1; b5 : 1; b6 : 1; b7 : 1;
<rwmjones> b8 : 1; b9 : 1; b10 : 1; b11 : 1; b12 : 1; b13 : 1; b14 : 1; b15 : 1;
<rwmjones> b16 : 1; b17 : 1; b18 : 1; b19 : 1; b20 : 1; b21 : 1; b22 : 1; b23 : 1;
<rwmjones> rest : -1 : bitstring ->
<rwmjones> assert (not b0 && b1 && not b2 && b3 && (* 0x5 *)
<rwmjones> b4 && not b5 && b6 && not b7); (* 0xA *)
<rwmjones> assert (not b8 && b9 && not b10 && b11 && (* 0x5 *)
<rwmjones> b12 && not b13 && b14 && not b15); (* 0xA *)
<rwmjones> assert (not b16 && b17 && not b18 && b19 && (* 0x5 *)
<rwmjones> b20 && not b21 && b22 && not b23); (* 0xA *)
<rwmjones> let _, off, len = rest in
<rwmjones> assert (off = 24 && len = 0) (* no further data *)
<rwmjones> | _ ->
<rwmjones> failwith "error: did not match\n"
<rwmjones> ^^ actually compiles and runs correctly now
<mwc> now is this real code, or are you just trying to choke the parser
<mwc> or make my head explode?
<rwmjones> well, it's camlp4-preprocessed code
<rwmjones> the idea is to emulate bitstrings in erlang
<mwc> ah, nifty
<rwmjones> another example is:
<rwmjones> ...
<rwmjones> let bits = Bitmatch.make_bitstring 16 '\xcf' (* makes the string 0xcfcf *)
<rwmjones> let () =
<rwmjones> bitmatch bits with
<rwmjones> | n0 : 4; n1 : 4; n2 : 4; n3 : 4;
<rwmjones> rest : -1 : bitstring ->
<rwmjones> assert (n0 = 0xc);
<rwmjones> assert (n1 = 0xf);
<rwmjones> assert (n2 = 0xc);
<rwmjones> assert (n3 = 0xf);
<rwmjones> let _, off, len = rest in
<rwmjones> assert (off = 16 && len = 0) (* no further data *)
<rwmjones> | _ ->
<rwmjones> failwith "error: did not match\n"
OChameau has joined #ocaml
mwc has quit ["Leaving"]
goalieca has quit ["omgponies!"]
middayc_ has quit []
ikaros has quit [Remote closed the connection]
Tetsuo has joined #ocaml
ygrek has quit [Remote closed the connection]
ita has joined #ocaml
seafood_ has joined #ocaml
r0bby has quit [Remote closed the connection]
r0bby has joined #ocaml
ygrek has joined #ocaml
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
coucou747 has joined #ocaml
hsuh has joined #ocaml
Snark has quit ["Ex-Chat"]
<flux> interesting, a join-calculus-based concurrency (like jocaml!) library for c++: http://channel.sourceforge.net/boost_join/libs/join/doc/boost_join_design.html
nimred has joined #ocaml
petchema has quit [Remote closed the connection]
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
petchema has joined #ocaml
Mr_Awesome has joined #ocaml
hsuh has quit ["off to work!"]
ygrek has quit [Remote closed the connection]
nimred has quit [Connection timed out]
schme has joined #ocaml
seafood_ has quit []
rwmjones is now known as rjones_lunch
rjones_lunch is now known as rwmjones
ygrek has joined #ocaml
Tetsuo has quit [Remote closed the connection]
Tetsuo has joined #ocaml
jonathanv has joined #ocaml
TheLittlePrince has joined #ocaml
RobertFischer has joined #ocaml
FZ has joined #ocaml
olleolleolle has joined #ocaml
jonafan has quit [Read error: 110 (Connection timed out)]
evn_ has joined #ocaml
schme has quit [Read error: 110 (Connection timed out)]
ygrek has quit [Remote closed the connection]
<RobertFischer> Does anyone know anyone looking for an Ocaml contractor, or even just a contractor who happens to be a fan of Ocaml?
<Smerdyakov> Does anyone know an economy that's gone down the tubes? ;-)
<Smerdyakov> The most contractor-like positions where anything related to functional programming is a plus are at universities, and most of those go to PhDs.
AxleLonghorn has joined #ocaml
ertai has quit ["Lost terminal"]
<RobertFischer> Smerdyakov: Actually, the contractor world ain't too bad. IT doesn't seem to be dying the same way the rest of the economy is.
<RobertFischer> Smerdyakov: I'm just trying to be picky. :)
<Smerdyakov> OK, but I think my second statement is probably true anyway.
<RobertFischer> Oh, you're probably right.
<RobertFischer> But it's worth fishing.
<RobertFischer> The #1 rule I've discovered as a contractor is that the jobs aren't where you think they are.
<Smerdyakov> Why don't you do a start-up? Next Y Combinator deadline is tomorrow.
<ita> RobertFischer: is the economy that bad in the us ?
ertai has joined #ocaml
<RobertFischer> That's not a bad plan. I've got a couple good ideas -- one particularly good idea -- that it should work out.
<RobertFischer> ita: The economy isn't terribly hot, mainly due to credit being hard to get, so big capital purchases aren't really happening the way they should be. And it doesn't help that gas has had a 300% increase in the last decade, and that corn and soybean prices have gone through the roof as demand for ethanol has increased.
<RobertFischer> ita: Although it's funny, because (like I said) IT seems relatively unscathed.
<RobertFischer> And if I get the OSP and a Y Combinator gig, that'd be pretty sweet. :)
<ita> i guess
<Smerdyakov> RobertFischer, I don't think you could do both.
<Smerdyakov> RobertFischer, OSP requires weekly in-person meetings, and Y Combinator requires physical presence in Cambridge, MA.
<RobertFischer> Smerdyakov: Oh. Then Y Combinator isn't the one I was thinking of. There's an incubator here in the Twin Cities.
<Smerdyakov> LOL
<RobertFischer> Smerdyakov: And it has some kind of funny vaguely functional-sounding name, too.
<Smerdyakov> I have this weird feeling that it's not worth getting involved with something like that.
<RobertFischer> Smerdyakov: With an incubator?
<Smerdyakov> No, with one in the Twin Cities
jlouis has joined #ocaml
<RobertFischer> Smerdyakov: Any particular reason, or just a general disdain for the midwest's ability to innovate?
<Smerdyakov> RobertFischer, Paul Graham says approximately nothing worthwhile happens in the tech start-up scene outside of Silicon Valley and the Boston area.
ita has quit [Remote closed the connection]
<Smerdyakov> RobertFischer, and his position seems credible to me.
olleolleolle has left #ocaml []
<RobertFischer> Smerdyakov: Got cite?
<Smerdyakov> I guess you don't subscribe to Paul's essay RSS feed. It's probably mentioned multiple times in his essays, but I don't remember which, offhand.
<RobertFischer> I do now.
<Smerdyakov> It's probably in the essay where he describes the genesis of Y Combinator.
<RobertFischer> That would make sense. I'll take a look.
<RobertFischer> I'm not sure my start-up would qualify as a "tech start-up" anyway...at least, not in the sense that I'd be innovating new technologies. All my ideas are business process related: tools that I wish existed, but don't. More 37Signals than Bell Labs.
<Smerdyakov> That's how most Y Combinator start-ups are, I think.
<RobertFischer> More money there. :)
<jlouis> If you have programming skills, brains and a good idea, you have a chance indeed.
<Smerdyakov> I disagree. I think there's more money in game-changing technology ideas, but it's concentrated in just a few opportunities.
<RobertFischer> jlouis: And the ability to sell. Lots of good tools die for lack of a marketting plan.
<RobertFischer> There was an interesting start-up here in the Twin Cities that is suffering for lack of a good business model, too: www.carol.com
<Smerdyakov> From my perspective, it suffers from a web front page that is an empty square.
pango_ has quit [Remote closed the connection]
jlouis_ has joined #ocaml
<RobertFischer> Smerdyakov: No kidding. I've got a story about the UI which requires beer and about an hour to tell.
pango_ has joined #ocaml
cbrannon has quit ["leaving"]
^authentic has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
ertai has quit [Read error: 110 (Connection timed out)]
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
schme has joined #ocaml
bongy has joined #ocaml
evn_ has quit []
AxleLonghorn has left #ocaml []
jlouis__ has joined #ocaml
Linktim has joined #ocaml
jlouis_ has quit [Read error: 110 (Connection timed out)]
OChameau has quit ["Leaving"]
jonathanv is now known as jonafan
jonafan has quit ["Leaving"]
|Catch22| has joined #ocaml
Linktim has quit [Remote closed the connection]
jonafan has joined #ocaml
ertai has joined #ocaml
ikaros has joined #ocaml
Yoric[DT] has joined #ocaml
olleolleolle has joined #ocaml
ttamttam has joined #ocaml
ertai_ has joined #ocaml
ygrek has joined #ocaml
marmottine has joined #ocaml
ertai has quit [Read error: 110 (Connection timed out)]
TheLittlePrince has quit [Client Quit]
FZ_ has joined #ocaml
olleolleolle has left #ocaml []
FZ has quit [brown.freenode.net irc.freenode.net]
coucou747 has quit [brown.freenode.net irc.freenode.net]
kelaouchi has quit [brown.freenode.net irc.freenode.net]
vincenz has quit [brown.freenode.net irc.freenode.net]
FZ has joined #ocaml
coucou747 has joined #ocaml
kelaouchi has joined #ocaml
vincenz has joined #ocaml
kelaouchi has quit [Read error: 104 (Connection reset by peer)]
kelaouchi has joined #ocaml
bongy has quit ["Leaving"]
olleolleolle has joined #ocaml
FZ has quit [Connection timed out]
evn_ has joined #ocaml
pmdboi has quit ["This computer has gone to sleep"]
goalieca has joined #ocaml
olleolleolle has quit [Read error: 104 (Connection reset by peer)]
olleolleolle has joined #ocaml
olleolleolle has quit [Read error: 104 (Connection reset by peer)]
olleolleolle has joined #ocaml
pmdboi has joined #ocaml
ttamttam has left #ocaml []
middayc has joined #ocaml
postalchris has joined #ocaml
<flux> cool, ocsigen 1.0
<flux> perhaps it's worth taking a new look at it :)
<Smerdyakov> Just wait for the next release of Laconic/Web... http://laconic.sf.net/ :-)
<flux> how well does it integrate ocaml libraries?-)
olleolleolle has quit [Read error: 110 (Connection timed out)]
<Smerdyakov> I don't have any plans for OCaml integration.
<Smerdyakov> The next version is going to be oriented mainly at interfacing with C libraries, I think.
<flux> I've wondered why efficiently typed (hmm..) languages don't attempt to interoperate more.. after all, the types of the interfaces should enable practically automatic, type safe, interfacing
<flux> but it's difficult for a "third party" to do the same level of foreign language support as what for example ocaml has for c; you would likely need to go through C
<Smerdyakov> MLton changes data representation based on whole-program context.
<flux> well, can you call MLton functions from C?
<Smerdyakov> Yes, but you need to mark them specially, and they can't use most datatypes.
<Smerdyakov> That is, the types of exportable functions are very limited.
<flux> I would say MLton is in a special position then
<Smerdyakov> Maybe, but then that's just because other languages are behind the times.
<flux> it just means the problem is more difficult to solve with MLton; it could be solved less efficiently by copying data, perhaps
<flux> another problem is the GC, so there might need to be a lot of copying in any case
evn_ has quit []
<flux> and if it so happens that the library uses physical equality, just copying could break things
<Smerdyakov> I think Laconic isn't going to use garbage collection, which would make it even more interesting there.
<flux> so how does laconic get rid of garbage?
<Smerdyakov> Same way you do in C
<Smerdyakov> I think everything can be stack allocated very easily, with libpq doing any more dynamic stuff.
<flux> how general-purpose language laconic is? (from the view point that php is generic-purpose, sort of)
<Smerdyakov> I don't really have a position on that now. I just know what I want to do next.
pants1 has quit [Read error: 110 (Connection timed out)]
pants1 has joined #ocaml
<palomer> how do I pass a method as a function?
<Smerdyakov> palomer, I'm assuming that you know how to do this, but are just asking for the most concise way. Am I right?
Linktim has joined #ocaml
* palomer does a quick google search so as to not lose face
<flux> I suppose an alternative, more to-the-point answer would be: you can't, you need to work around it
<palomer> phew
<palomer> I thought I was stupid there for a moment
<palomer> so you would do let foo () = self#bar in ...
<flux> for example, or if the sole reason for foo is to pass it as an argument, perhaps (fun () -> self#bar)
<palomer> gotcha
FZ_ has quit ["ChatZilla 0.9.81 [Firefox 2.0.0.13/2008031114]"]
thermoplyae has joined #ocaml
ertai has joined #ocaml
ertai_ has quit [Read error: 110 (Connection timed out)]
olleolleolle has joined #ocaml
goalieca has quit [Remote closed the connection]
RobertFischer has left #ocaml []
olleolleolle has quit [Read error: 104 (Connection reset by peer)]
Demitar has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
Axioplase has joined #ocaml
ertai has quit [Read error: 110 (Connection timed out)]
pmdboi has quit ["This computer has gone to sleep"]
olleolleolle has joined #ocaml
ita has joined #ocaml
<palomer> https://stage.maemo.org/svn/maemo/projects/haf/trunk/gtk+/gdk/gdkkeysyms.h <--anyone know if ocaml has these values predefined?
<Smerdyakov> I couldn't find them. You're probably asking about Lablgtk, not OCaml.
Anarchos has joined #ocaml
<thelema> palomer: GdkKeysyms
<palomer> yeah, it's in lablgtk
bongy has joined #ocaml
<palomer> thelema, that's a module?
<thelema> yes, GdkKeysyms._BackSpace
thermoplyae has quit ["daddy's in space"]
<thelema> I guess it doesn't have any documentation.
<palomer> hrmph
<palomer> how do I find out if keysym is a single displayable character?
olleolleolle_ has joined #ocaml
<palomer> (regardless of what that character is)
<thelema> yup, no docs. just a lot of let _VoidSymbol : keysym = 0xFFFFFF
olleolleolle has quit [Read error: 104 (Connection reset by peer)]
olleolleolle_ has quit [Client Quit]
Ramzi389 has joined #ocaml
<thelema> palomer: got me. I don't know if GTK even provides such.
marmottine has quit [Remote closed the connection]
middayc_ has joined #ocaml
<thelema> palomer: the mozilla source tree has: // Anything above 0xf000 is considered a non-printable
<palomer> and below 0xf000 is printable?
<thelema> with an exception for the numeric keypad
<palomer> how do I convert the keyval to a character?
<thelema> well, a keysym is an int
<palomer> characters are ints?
<thelema> Depends. Unicode?
<palomer> yeah
<palomer> I'm probably going about this the wrong way
<palomer> I have a text entry
<palomer> but I want to capture enter/left/right/down/up
<palomer> I should probably just capture those and let the entry deal with the rest
<thelema> then capture those, and return false in your handler to let the event bubble up.
<palomer> yeah
<palomer> much better idea
<palomer> got a link to the GdkKeysym file?
<palomer> (for lablgtk)
<thelema> not the current version, but should have the keysyms you want.
middayc has quit [Read error: 110 (Connection timed out)]
<palomer> thx!
ygrek has quit [Remote closed the connection]
schme has quit [Remote closed the connection]
bongy has quit ["Leaving"]
Morphous has joined #ocaml
Morphous_ has quit [Read error: 110 (Connection timed out)]
gene9 has joined #ocaml
ikaros has quit ["segfault"]
gene9 has quit [Client Quit]
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
thermoplyae has joined #ocaml
<palomer> thelema, do you know if it's possible to run some code after an event has been propagated?
<thelema> ?? I use idle tasks for that kind of thing.
<palomer> how does that work?
<palomer> I want an event to happen every time text has been inserted into an entry box
<thelema> Idle.add ~prio:priority_value (fun () -> do stuff; if run_again then true else false)
<thelema> let singleton_task prio f =
<thelema> let tid = ref None in
<thelema> let task () = tid := None; f (); false in
<thelema> fun () -> if !tid = None then tid := Some (Idle.add ~prio:prio task)
<Ramzi389> Hello. Can somebody help me learn OCaml basics?
<thelema> I use this code to schedule an event in the future (and ignore any re-schedulings of it until it's run)
<thelema> Ramzi389: ocaml-tutorial.org
<thelema> Ramzi389: if you have specific questions, go ahead and ask.
<Ramzi389> I already read "the basics" and "structure of" on that page. I feel that jumping into programming is different, and I'm not sure what the errors mean. Maybe I should just be specific.
<palomer> thelema, so that runs every time the system idles?
<Ramzi389> Alright. Something simple. Suppose it's the case that I want to have a function that takes in a list, sums all the ints in it.
<Ramzi389> Uh, and returns 0 if it's empty. To make things nice.
<palomer> let rec sum_of_int_list x = match x with [] -> 0 | (x::xs) -> x + (sum_of_int_list xs)
<palomer> you can also do it with foldl
<Smerdyakov> palomer, wow. That was a reaaaally rude thing to do.
<Ramzi389> I'm sorry. Why was that rude?
<thelema> palomer: if it returns true, it runs every time the system idles
<Smerdyakov> Ramzi389, when someone is trying to figure out how to do something to learn a programming language, you don't just post a solution.
<Ramzi389> Alright. When I wrote my code, I wrote exactly that. But I got "unbound value of l."
<Ramzi389> I actually wrote a function to find the product of a list. Here's what I wrote.
<thelema> Ramzi389: first thing to understand: a list contains only one kind of thing - you can't have a list with strings, ints and floats all together (without tagging them)
<Smerdyakov> thelema, do you have any reason to believe that is related to a problem he is having?
<palomer> however, whats this [> `changed] business?
<thelema> palomer: ah yes, events.
<Ramzi389> let rec prod l = match l with [] -> 1 | (h::t) -> h * prod t ;;
<palomer> I don't know what to do with these values
<thelema> Smerdyakov: it's related to his initial question "sum all the ints in it"
<Smerdyakov> thelema, my guess is that he know he's only working with lists of all ints.
<palomer> Smerdyakov, why is it rude?
<thelema> Smerdyakov: yes, but many beginners think they can have a list of more than just ints. I was making that clear.
<palomer> Smerdyakov, oh, sorry
<Ramzi389> I am aware that lists contain only one type.
* palomer makes a mental note for the future
<Smerdyakov> palomer, because it's not the destination that matters, but the journey.
<thelema> Ramzi389: "unbound value xxx" means that xxx hasn't been defined yet.
<Ramzi389> isn't my l defined in the ... definition?
<Smerdyakov> Ramzi389, are you saying the compiler doesn't accept the code you just pasted?
hkBst has quit ["Konversation terminated!"]
<Ramzi389> right
<thelema> Ramzi389: looks good to me.
<Smerdyakov> Ramzi389, I don't believe you.
<Ramzi389> let me take a screenshot.
<thelema> Ramzi389: when I paste that code in to the toplevel, it works fine for me.
<Smerdyakov> Ramzi389, it works fine for me, pasted right into 'ocaml'.
<thelema> # let rec prod l = match l with [] -> 1 | (h::t) -> h * prod t ;;
<thelema> val prod : int list -> int = <fun>
<thelema> you typed "let rec prod 1" (see the 1, not the l?)
<palomer> 1 != l
<Ramzi389> oh my goodness.
<Smerdyakov> In other words, the code you pasted is different than the code you're showing the error for.
<palomer> l isn't a very good variable name
<Ramzi389> I am so sorry you guys.
<palomer> lst is better
<Ramzi389> That is so dumb of me.
<palomer> no problem! anytime
<thelema> palomer: I have no problems with l as a variable name.
<thelema> I just make sure I use a font which distinguishes the two easily.
<palomer> now, getting back to this changed signal business
<palomer> thelema: any idea how to use it?
<palomer> ahh, got it
<palomer> wrong module
<thelema> palomer: almost, you're getting closer.
<thelema> entry#connect#changed
<thelema> my_entry_widget#connect#changed
<palomer> This expression has type GObj.event_signals
<palomer> It has no method changed
<thelema> entry#connect gives you an entry_signals, which inherits from editable_signals
<palomer> ass
<palomer> ahhh
<palomer> (ignore ass, s is beside h)
<thelema> lol
<thelema> there's three keys between them on my keyboard.
jlouis__ has quit [Remote closed the connection]
<Ramzi389> This one is tricky, for me anyway. Let me get your opinion. I have two ideas.
<Ramzi389> If you have a list, and you want to find the location of a parameter.
<Ramzi389> For example, if the list was [4;3;6;5;1] and the second parameter was 6, the return would be 2.
<Ramzi389> Because of 0 indexing.
<Ramzi389> Either I need to turn the second parameter into a tuple, to store the position variable.
<Ramzi389> Or I need to have some helper expression, outside of the function, to store the position information.
<Ramzi389> Which do you feel is more elegant?
<thelema> you can put the helper expression inside the function.
<Ramzi389> Hmm, I now consider my first idea to not be possible.
<Ramzi389> Alright, thelema, let me try to work with that idea for a few minutes and see what I arrive at.
l_a_m_ has joined #ocaml
l_a_m has quit [Read error: 104 (Connection reset by peer)]
<Ramzi389> i'm having a lot of difficulty with this.
<Ramzi389> i think my nested helped should read something like...
<Ramzi389> let position = position ;;
<Ramzi389> no, that's terrible.
<Ramzi389> let inc_pos pos = pos + 1;;
<thelema> you're at least a little comfortable with recursion, what about writing a helper function that takes an int (how many list items already checked) and a list, checks the head of the list, and if it's a match, returns the int, otherwise runs itself with pos+1, tail
<Ramzi389> hmm, I don't think i'm uncomfortable with recursion. Maybe I should think in C first and then try to convert to OCaml.
<thelema> Ramzi389: will produce very non-camlish code.
<Ramzi389> When you said, "(how many list items already checked)", don't you need to start this counter at 0
<thelema> yes
<thelema> this is a helper function
<Ramzi389> and if so, wouldn't on every level of recursion the counter get reset back to 0?
<thelema> no, when it calls itself, it uses the current value + 1
<Ramzi389> and it's nested?
<thelema> and the first time it's called, it's called with 0 as argument.
<thelema> this is what I mean by nested:
<thelema> let nth l n =
<thelema> if n < 0 then invalid_arg "List.nth" else
<thelema> let rec nth_aux n = function
<thelema> | [] -> failwith "nth"
<thelema> | a::t -> if n = 0 then a else nth_aux (n-1) t
<thelema> in nth_aux n l
<thelema> nth_aux is nested inside nth
<Ramzi389> can you explain the |?
<thelema> pattern matching - nth_aux takes two arguments, n and a list.
<thelema> the list gets matched against [], and if that matches, it fails.
<Ramzi389> so everytime you use a |, it's a different case.
<thelema> if the list matches a::t, then it checks n, etc.
<thelema> yes, | separates cases in a match
<Ramzi389> alright, well, you write if n < 0. There's no guarentee here that the types are ints.
<thelema> [function] is a shortcut for [fun x -> match x with]
<thelema> n is an int.
<thelema> this function returns the nth element of a list.
<Ramzi389> I see. Let me stare at it some more.
<thelema> It's a dual to what you're trying to do.
sporkmonger has joined #ocaml
<Ramzi389> can you explain the "t in nth_aux n l" part
<Ramzi389> i think you switched the order of the parameters
<Ramzi389> but i don't know since i'm so new
<Ramzi389> hmm, nevermind that. but i still don't understand the "t in nth_aux n l"
<sporkmonger> i'm trying to read in from stdin, one byte at a time (well, more accurately, one bit at a time, but that's more an issue of bit shifting) and i'm not really seeing an obvious way to do that
<palomer> is there something similar to "all" ( the deal of exists ) in ExtString?
<palomer> can't find it (wondering if its there)
<palomer> s/deal/dual
<sporkmonger> nm, found the input_byte function
<palomer> I guess I'll use fun x -> List.all (explode x)
thelema has quit [Read error: 104 (Connection reset by peer)]
Tetsuo has quit [Remote closed the connection]
Yoric[DT] has quit ["Ex-Chat"]
coucou747 has quit ["bye ca veut dire tchao en anglais"]
thelema has joined #ocaml
<thelema> Ramzi389: figured it out yet?
l_a_m_ has quit [Read error: 145 (Connection timed out)]
<Ramzi389> thelema: No. But I took a break to eat.
seafood_ has joined #ocaml
Axioplase has quit ["(map reverse "emehcs" "lleksah" "lmaco") ;; or something like that"]
* thelema took a break to break his internet connection
<Ramzi389> If I extended the problem to return the last location...
<Ramzi389> For example, [5;4;3;4;1;2] and i'm looking for 4
<Ramzi389> then i should return 3.
<thelema> that'd be harder because you'd have to scan the whole list instead of stopping as soon as you find a match
<Ramzi389> If I have a function called nth, which gives me the nth element in the list, I can't return as soon as I have a math.
<Ramzi389> *match
<Ramzi389> yes.
<Ramzi389> so I'm thinking I need to have another expression called highest
<thelema> do you have any questions about how nth works?
<Ramzi389> I think I understood that. You used a lot of things I wasn't familiar with, but I think I got the jist so that I was able to write the code in a manner which I understood.
mfp_ has joined #ocaml
<thelema> I didn't write that code - it's from the stdlib
<Ramzi389> Oh. What's the function?
<Ramzi389> nvm
<Ramzi389> lol
<thelema> :)
<Ramzi389> Do I have to include anything to use it? Or can I just use it already?
<thelema> List.nth
<Ramzi389> So I put #use List.nth at the top?
<thelema> no, just refer to it as List.nth
mfp has quit [Read error: 110 (Connection timed out)]
<Ramzi389> I see.
<Ramzi389> So then, highest. Good idea, yeah?
<thelema> Ramzi389: I'd recommend writing a function to find the first occurrence
<thelema> once you can do that, then write one for the last occurrence
<Ramzi389> Hmm... It's really a different mentality in this language.
<Ramzi389> It's almost like, I can't think *that small.*
<thelema> yes it is. It's definitely a challenge changing how you think
<thelema> maybe just browsing through the List library will help.
<thelema> Immerse yourself in many examples of how to program well in ocaml.
<Ramzi389> So you can do l.nth, if l is a list?
<Ramzi389> Or is that too object oriented thinking
<Ramzi389> I need to do List.nth l n
<Ramzi389> What if the element isn't in the list?
<Ramzi389> I can't keep recursing on n+1 forever.
<Ramzi389> hmm, eventually the tail will be []
<thelema> yes, you can't do l.nth - have to List.nth l n
* Smerdyakov thinks it's a mistake to be using standard library functions without knowing how to implement them, and (as a prerequisite) realizing that they're functions like any others.
<Ramzi389> Can I, at any time in the function, refer to the tail of a list.
<Ramzi389> Or only after a match statement.
<Smerdyakov> Ramzi389, OCaml has no statements. Write "match expression" instead.
<Smerdyakov> Ramzi389, and "inside a match expression" would be more accurate than "after.
<Ramzi389> I see. Then am I to consider the | as a replacement for if, else, sometimes?
<Smerdyakov> I don't know what that means.
<Ramzi389> Really, it feels like division of cases, which, often times, gets expressed with ifs and elses.
<Smerdyakov> If you need to think like C, think of it like 'switch' statements.
<thelema> Ramzi389: I don't think so. It's much more powerful than any if - it can decompose its argument.