mfp changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.11.2 released | Inscription for OCaml Meeting 2010 is opened http://wiki.cocan.org/events/europe/ocamlmeetingparis2010
<det> uppercase B was a typo
<det> but I was reponding to mrvn's question from 2 hours ago
<det> about why you must define a record's type separate, instead of inline in a constructor
<det> and an even harder example:
<det> type b = B of {a: int; b: string;}
<det> let f (B b) = b
<det> type b = B of {a: char; b: string;}
<det> what is the type of f now
<Alpounet> oh ok
<det> actually, I think Ocaml will reject my second example due to duplicate constructors
<det> I mean, fields
<det> (ignoring that fact that it is a syntax error the record in B)
<mrvn> det: that f is an error. B... is a tagged record. There would be no difference between B b and b.
<det> typo
<det> I meant:
<mrvn> Alpounet: type x = A { x: int; } | B { y: float } ...
<mrvn> Alpounet: to get a more usefull example.
<det> type b = B of {a: int; b: string;}
<det> let f (B x) = x
<det> what is the type of f ?
<mrvn> det: b -> b
<orbitz> no
<det> it's not b though
<orbitz> he doesn't return B x
<orbitz> he returns x
<mrvn> Which would be equivalent.
<det> nope
<orbitz> Nope
<det> type a = A of int
<det> a and int are distinct
<mrvn> det: you are mising the point. I want them to be equivalent.
<det> what about
<orbitz> mrvn: you want phantom types?
<mrvn> No. the block for the {} should be tagged.
<det> type b = A of {a: int} | B of {b: string;}
<det> let f x =
<det> match x with
<det> | A x -> x
<det> | B x -> x
<det> I should have named the second x something else, it shadows the first
<mrvn> det: that code makes no sense in this context
<det> but it is valid code
<det> if you could inline record definitions
<mrvn> det: That depends on the implementation.
<det> your example does this even
<mrvn> For the code to be valid A x and x must be synonym and f is then b -> b.
<det> that is impossible
<det> I hope my shadowing of x isnt confusing you
<det> type b = A of {a: int} | B of {b: string;}
<det> let f x =
<det> match x with
<det> | A blah -> blah
<det> | B foo -> foo
<det> there
<mrvn> What else could it be? A x -> x is either b -> b or b -> int and B x -> x is b -> b or b -> string. Only the b -> b would make it valid.
<det> the type would have to be something that references the namespace and at least 1 field
<det> and to be as least confusing as possible, the type would need to be the module + full record type
<mrvn> det: referencing either the constructor (A) or a field (a) would allow the type to be infered.
<det> but what would the type look like ?
<det> sorry
<det> you are right
<mrvn> type b = A of {a: int} | B of {b: string;}
<det> I can come up with a well typed example though
<mrvn> or type b = A of a:int * b:float | B of c:char
<mrvn> The important part would be that the fields are labeled and possibly mutable.
<mrvn> det: But you are right match b with A x -> (fun x -> x.a) x
<mrvn> What type has the closure?
<mrvn> Would ahve to be something like type b.A or so
<det> type b = A of {a: int} | B of {b: string;}
<det> let f x c1 c2 =
<det> match x with
<det> | A blah -> c1 blah
<det> | B foo -> c2 foo
<mrvn> det: give me an example with type b = A of {a: int; b: int} | B of {c: string; d: string}
<det> the example above works, just substitute my b for yours
<mrvn> det: no, the constructor expects 2 arguments and you only have one.
<det> oh right, ocaml constructors have arity
<det> when you consider that they have arity, I guess you have a good point
<det> they could be labeled
<mrvn> But I think A blah and blah shouldn't be equivalent. That doesn't match with type b' = A of int
<mrvn> you convinced me.
<det> You could label the fields of constructor, but you'd have to use them when matching too
<det> I often think of ocaml constructors taking 1 argument, which might be a tuple
<det> I forget that this isnt true
<mrvn> saves memory and indirections
<det> yeah, if your tuples and constructors are both boxed
<mrvn> I just hate to have type t = A of a * b * c * d * e * f * g * h * i * j. Nobody can remeber what each field is for then. With a record you can put some meaning into the lables and easily access them individually.
<mrvn> and A of a_record is wastefull.
<det> I understand now
<det> I guess Ocaml could be extended to have something like this:
<det> type b = A of ~a : int * ~b : string | B of ~c : char * ~d : bool
<det> let f x =
<det> match x with
<det> | A(~a=a, ~b=b) -> ...
<det> | B(~c=c, ~d=d) -> ...
<mrvn> That is half of it. mutable is the other half.
<mrvn> The ~a you could do with camlp4 I guess.
<det> I thought you were talking about extra syntax
<det> not indirections
<mrvn> It would be extra syntax to denote that you don't have an idirection here but lables.
<mrvn> {..} was just an idea.
<mrvn> ~label might be less confusing.
<mrvn> So back to my other question:
<det> having uboxed tuples could also work :-)
<mrvn> How safe is this? type b = B of int * int type b_rec = { x: int; mutable y : int; } let set_y (b : b) y = ((Obj.magic b) : b_rec).y <- y let t = B (1,2) let _ = set_y t 3 let t = t;;
<det> have you tested it?
<det> to see if it works at all
<det> I wouldnt think b and b_rec would have the same implementation
<mrvn> works so far
<det> maybe it will break with more constructors
<mrvn> b is a tuple and b_rec a record. same memory layour.
<det> b has a tag too
<mrvn> But in the tag field of the block.
<det> I see
<mrvn> `B of int * int would be { hash: value; x: int; y: int } but that is different
<mrvn> The important part is that b-rec must be private and never constructed. Otherwise the block is missing the tag.
<mrvn> Or put differently you can't cast a b_rec to b. Only a b to b_rec (and then back)
<mrvn> And all this is for the normal ocaml. Other compiler could have different memory layout.
<det> I cant think of any good solution, if you must mutate the insides of constructors
<det> Obj.magic is scary
<mrvn> yeah. Messed it up and got segfaults on the first try too.
<det> I think of this as more of a problem of lacking unboxed tuples
<mrvn> You get some surprising results with prefix typing and Obj.magic too:
<mrvn> type a = { a : int; } type b = { b : int; c : int; } let as_a (x : b) = ((Obj.magic x) : a) let a = { a = 1; } let b = { b = 1; c = 1; } let t = a = (as_a b);;
<mrvn> Without trying what is t?
<det> you also cant represent an array of tuples without the extra indirection
<det> with unboxed tuples (and records) you could also eliminate the arity on constructors
<mrvn> det: If you have an array of tuples without indirection then any reference to one tuple would hold the complete array.
<mrvn> And you would need a proxy object or the GC crashes.
<det> it would just hold all elements of the tuple
<mrvn> det: no. the full block.
<det> you dont need to GC unboxed things
<mrvn> You can never ever just hold parts of a block or even a pointer into the middle of a block or the GC explodes.
<det> you wouldnt have no pointer
<mrvn> every non primitive type is a pointer
<det> assuming: let a = [|1,true;2, false; 3,true|]
<det> a.(0) would load both 1 and true
<mrvn> let f ((a, b) as t) = x := t; a f a.(0)
<mrvn> What would that do?
<det> where do you define x
<mrvn> globally
<det> you formatting confuses me
<det> so many spaces after ; a
<mrvn> let f ((a, b) as t) = x := t; a;;
<mrvn> f a.(0)
<mrvn> Does x then point into the array or does a.(0) allocate a freh touple and copy 1,true into it?
<det> that would pass 2 values to f (as a tuple, no pointer)
<det> fresh copy
<det> but on the stack
<mrvn> Ok, that would work.
<det> not heap
<mrvn> must be heap.
<mrvn> x can't point to the stack
<det> it would copy again into x :-)
<mrvn> That would change the semantic.
<det> I dont think so
<mrvn> hmm, tuples are purely functional so copying them doesn't hurt. you are right.
<mrvn> Do the same with mutable records and it changes things.
<mrvn> det: figured out yet what t will be in the above?
<det> sorry
<det> forgot about it
<det> first let me format it sanely :-)
<mrvn> We need an irssi plugin that formats ocaml code. :)
<det> t is bool ?
<det> I am guessing not
<det> and this is the surprise ?
<mrvn> It is bool. But what value?
<det> oh
<mrvn> # a;;
<mrvn> - : a = {a = 1}
<mrvn> # as_a b;;
<mrvn> - : a = {a = 1}
<mrvn> val t : bool = false
<det> I dont know how ocaml represents these things
<mrvn> Both as a block with tag 0.
<mrvn> The problem is that the ( = ) is polymorphic and compares the raw blocks. And then (as_a b) is still a block of size 2 while a is size 1.
<mrvn> I was expecting the compiler to generate code that actualy compares two 'a' but it just calls the polymorphic one.
<det> Ocaml doesnt do anything that fancy :-)
<mrvn> yeah.
<det> re: formatting
<det> I prefer to just paste small examples or use a pastebin for larger
<det> than format on 1 line
<det> and I am a big fan of forced indentation/style
<det> Pythonish syntax
<orbitz> det: i like haskell's layouts
<mrvn> I'm just happy indent is 2 spaces
<det> I prefer tab
<det> and set it however you like
<mrvn> I think somewhere in my code I had an indentation level of 15.
<det> orbitz, I find it wierd
<mrvn> So 120 spaces indent with tabs. *shiver*
<det> you mean because they default 8 ?
<mrvn> det: yes
<det> just about any editor lets you define what tab is
<det> this is why I prefer it
<mrvn> xemacs has the stupid idea to replace 8 spaces with one tab when indenting in tuareg mode.
<mrvn> So you get 2,4,6 spaces, 1 tab, 1 tab 2 spaces, ....
<det> yes
<det> emacs has terrible defaults
<mrvn> I think that is the worst
<det> I used emacs for a long time
<det> now I just use gedit
<mrvn> speaking of it where do I change that?
<det> who knows
<det> emacs has like 5 settings for tab
<det> and you must get the right combination
yakischloba has joined #ocaml
<mrvn> det: When your type is longer than 80 chars beware.
<det> I dont understand
<mrvn> something like Entry.Leaf.Free.leaf option Iterator.Double.t data Entry.Node.t option list
<det> you mean in tuareg ?
<mrvn> I mean in general.
<det> What is the problem ?
<mrvn> If you have a -> b -> c you can line break on ->. But how do you line break such a single tpye?
<det> oh
<mrvn> Or do you leave an overlong line?
<det> you mean in an indentation language ?
<mrvn> no, just in general
<det> in Ocaml, I guess you can define synonyms
<mrvn> yeah. Been doing that too. And used the type in the ml file to get the infered types to use the alias.
<det> simple function from Haskell example page:
<det> getDigits n = let s = (show n)
<det> in map digitToInt s
<det> such big indentation for 1 indent!
<mrvn> det: the "in" is indented to the matching "let"
<det> also
<det> any other lets are aligned with the s
<det> all dependent on the length of the function name
<mrvn> would be on "t s = ..." here
<det> def getDigits n:
<det> val s: show n
<det> map digitToInt s
<det> this is so much better IMO
<mrvn> I always line break on the first = or not at all.
<mrvn> so the s is valid for the rest of the same indentation?
<det> yes
<det> after : comes block
<det> which is like a series of lets
<det> and last line is the return
<mrvn> no, python blocks are indentation only
<det> in my imaginary syntax, I mean
<det> half imaginary
<det> I have parser for it
<det> it works
<mrvn> and val (): is implicit if left out except for the last line?
<det> yes
<mrvn> could work
<mrvn> I would use let x = or val x = instead of :
<det> I am unsure of that
<det> that would be the only special case
<det> after : always comes code block
<det> which can be simple expression on same line
<det> or indent block dedent
<mrvn> while x < 1
<mrvn> foo
<mrvn> bar
<mrvn> ++x
<mrvn> Why : at all?
<det> couple reasons
<det> in some forms it is neccesary delimter
<mrvn> (x < 1)
<det> such as "def f x y: x + y"
<det> in other forms it improves readability
<mrvn> (verry_long_function
<mrvn> that returns bool)
<det> also
<det> while form would be:
<det> while:
<det> do:
<det> after each colon is code block
<mrvn> Where does the conditional go?
<det> after colon of while
<det> while: true
<det> do: print "AAAAAHHHH"
<det> if/then/else similar
<det> if: ...
<det> then: ...
<det> else: ...
<det> match would be this
<det> match: ...
<det> with ...: ...
<det> with ...: ...
<det> try/with is this
<det> try: ...
<det> with ...:...
<det> with ...:...
boscop has quit [Quit: Gxis revido!]
<det> and after colon you can newline/indent and do entire block
yakischloba has quit [Quit: Leaving.]
<det> this is universal in syntax
<det> invoke function used in shootout, in original and pythonic syntax
Drk-Sd has joined #ocaml
<mrvn> Sleepless in Tuebingen watches Sleepless in Seatle.
enthymene is now known as Pyro`
Pyro` is now known as ThePyro
ThePyro is now known as enthymene
catofzen has left #ocaml []
enthymene has quit [Quit: </Ahnuld>]
sepp2k1 has quit [Quit: Leaving.]
Mr_Awesome has joined #ocaml
Drk-Sd has quit [Quit: dodo]
travisbrady has quit [Quit: travisbrady]
rwmjones has quit [Ping timeout: 256 seconds]
valross has joined #ocaml
walrus__ has joined #ocaml
walrus__ has quit [Remote host closed the connection]
_unK has quit [Remote host closed the connection]
enthymene has joined #ocaml
yakischloba has joined #ocaml
yakischloba1 has joined #ocaml
yakischloba has quit [Read error: Connection reset by peer]
ramenboy has joined #ocaml
brooksbp has quit [Remote host closed the connection]
yakischloba1 has quit [Quit: Leaving.]
yakischloba has joined #ocaml
Submarine has joined #ocaml
avsm1 has joined #ocaml
avsm has quit [Ping timeout: 258 seconds]
enthymene is now known as enth|amble
ulfdoz has joined #ocaml
enth|amble is now known as enthymene
avsm has joined #ocaml
avsm1 has quit [Ping timeout: 276 seconds]
ttamttam has joined #ocaml
ulfdoz has quit [Ping timeout: 276 seconds]
Submarine has quit [Read error: Connection reset by peer]
ttamttam has quit [Quit: Leaving.]
avsm has quit [Quit: Leaving.]
joewilliams is now known as joewilliams_away
tmaedaZ has quit [Ping timeout: 246 seconds]
tmaedaZ has joined #ocaml
yakischloba has quit [Quit: Leaving.]
_zack has joined #ocaml
Submarine has joined #ocaml
Yoric has joined #ocaml
ygrek has joined #ocaml
enthymene has quit [Quit: rcirc on GNU Emacs 23.1.1]
spearalot has joined #ocaml
albacker has joined #ocaml
ttamttam has joined #ocaml
_zack has quit [Quit: Leaving.]
f[x] has joined #ocaml
_zack has joined #ocaml
Yoric has quit [Ping timeout: 268 seconds]
_zack has quit [Client Quit]
filz has joined #ocaml
Submarine has quit [Quit: Leaving]
<flux> mrvn, regarding ``I can do "type a = A of int * int"..'' -> I think the reason is that you can express type int * int inline in ocaml (let a : int * int = 42, 4), but you cannot express record types inline. therefore in expression B x the type of x would not be expressible in ocaml, because it would not have a name either.
<flux> oh, apparently it was discussed further already, but perhaps this was still a useful POV
_zack has joined #ocaml
<flux> also I don't see how type a = A of a' and a = { .. } is wasteful. memory-wise? too much to type? too many types?
ygrek has quit [Ping timeout: 245 seconds]
oc13 has joined #ocaml
boscop has joined #ocaml
CcSsNET has joined #ocaml
jcaose has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
Yoric has joined #ocaml
Yoric has quit [Client Quit]
jao has quit [Ping timeout: 265 seconds]
pimmhogeling has joined #ocaml
th5 has joined #ocaml
ikaros has joined #ocaml
ygrek has joined #ocaml
munga has joined #ocaml
sepp2k has joined #ocaml
rwmjones has joined #ocaml
_unK has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
valross has quit [Quit: Ex-Chat]
tmaedaZ has quit [Quit: Quit Nadoka 0.7.1-trunk (rev: 187) - http://www.atdot.net/nadoka/]
tmaedaZ has joined #ocaml
Snark has joined #ocaml
lifecoder has joined #ocaml
munga has quit [Ping timeout: 265 seconds]
sepp2k has quit [Quit: Leaving.]
slash_ has joined #ocaml
_zack has quit [Quit: Leaving.]
boscop_ has joined #ocaml
boscop has quit [Ping timeout: 246 seconds]
CcSsNET has quit [Quit: User disconnected]
Alpounet has quit [Ping timeout: 260 seconds]
Drk-Sd has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
ygrek has joined #ocaml
Alpounet has joined #ocaml
mbishop_ has joined #ocaml
hcarty has quit [Remote host closed the connection]
mbishop has quit [Ping timeout: 256 seconds]
Alpounet has quit [Ping timeout: 260 seconds]
ccasin has joined #ocaml
Alpounet has joined #ocaml
_andre has joined #ocaml
spearalot has quit [Quit: Computer has gone to sleep]
Alpounet has quit [Ping timeout: 258 seconds]
spearalot has joined #ocaml
spearalot has quit [Client Quit]
f[x] has quit [Ping timeout: 240 seconds]
f[x] has joined #ocaml
brooksbp has joined #ocaml
avsm has joined #ocaml
Alpounet has joined #ocaml
_unK has quit [Remote host closed the connection]
_zack has joined #ocaml
filz has quit [Quit: Leaving]
derdon has joined #ocaml
joewilliams_away is now known as joewilliams
{newbie} has joined #ocaml
f[x] has quit [Ping timeout: 260 seconds]
f[x] has joined #ocaml
pimmhogeling has quit [Ping timeout: 265 seconds]
Submarine has quit [Ping timeout: 260 seconds]
f[x] has quit [Ping timeout: 268 seconds]
jcaose has quit [Ping timeout: 256 seconds]
f[x] has joined #ocaml
tmaedaZ has quit [Ping timeout: 260 seconds]
tmaedaZ has joined #ocaml
f[x] has quit [Ping timeout: 240 seconds]
jao has joined #ocaml
{newbie} has quit [Remote host closed the connection]
{newbie} has joined #ocaml
th5 has quit [Quit: th5]
{newbie} has quit [Ping timeout: 268 seconds]
jonafan has joined #ocaml
avsm has quit [Quit: Leaving.]
_zack has quit [Quit: Leaving.]
lifecoder has quit [Quit: lifecoder]
jao has quit [Ping timeout: 276 seconds]
Submarine has joined #ocaml
tmaedaZ has quit [Ping timeout: 245 seconds]
{newbie} has joined #ocaml
tmaedaZ has joined #ocaml
ttamttam has quit [Quit: Leaving.]
lifecoder has joined #ocaml
lifecoder has quit [Client Quit]
Drk-Sd has quit [Ping timeout: 240 seconds]
_andre has quit [Quit: *puff*]
sshc has quit [Ping timeout: 248 seconds]
sshc has joined #ocaml
_unK has joined #ocaml
sshc_ has joined #ocaml
enthymene has joined #ocaml
travisbrady has joined #ocaml
slash_ has quit [Quit: leaving]
sshc has quit [Ping timeout: 264 seconds]
ztfw has joined #ocaml
<flux> does anyone know if the ocaml toplevel in emacs can be made to save its history, and load it on startup?
Snark has quit [Quit: Ex-Chat]
sshc_ is now known as sshc
f[x] has joined #ocaml
{newbie} has quit [Quit: {newbie}]
jao has joined #ocaml
f[x] has quit [Ping timeout: 260 seconds]
ttamttam has joined #ocaml
yakischloba has joined #ocaml
f[x] has joined #ocaml
f[x] has quit [Ping timeout: 256 seconds]
smimou has quit [Quit: bli]
jcaose has joined #ocaml
yakischloba has quit [Quit: Leaving.]
ulfdoz has joined #ocaml
<ccasin> flux: I usually run it inside "rlwrap", which can do that for you (and often handles input more smoothly than the ocaml toplevel itself)
<ccasin> it's pretty much transparent and has a few nice features
<jonafan> alias oc='rlwrap -r -c -D 2 ocaml'
<jonafan> from my bashrc
<flux> ccasin, yes, but I mean when running from within emacs
<ccasin> I used to do that too, so it's possible, but it's been a while
<flux> for the convenience of sending buffers and code fragments to it from the code
jao has left #ocaml []
<flux> you used to save the history of an ocaml-session when running it from emacs?
<ccasin> If I remember correctly, I changed the ocaml emacs mode stuff to go through rlwrap
<ccasin> I don't think it was hard, but the files are long gone
jcaose has quit [Read error: Connection reset by peer]
ccasin has quit [Quit: Leaving]
<derdon> jonafan: what do these options cause?
<jonafan> r remembers your history
<jonafan> c completes file names
<derdon> ah, nice
<jonafan> D 2 removes excessive duplicates from history (more than 2)
<jonafan> maybe it's 2 or more
<derdon> ok, will ad the options c and d to my alias
sshc_ has joined #ocaml
avsm has joined #ocaml
avsm has left #ocaml []
sshc has quit [Ping timeout: 245 seconds]
sfuentes has quit [Ping timeout: 252 seconds]
matthieu has joined #ocaml
sshc_ is now known as sshc
smimou has joined #ocaml
yakischloba has joined #ocaml
ttamttam has quit [Quit: Leaving.]
{newbie} has joined #ocaml
rwmjones has quit [Ping timeout: 256 seconds]
enthymene has quit [Quit: rcirc on GNU Emacs 23.1.1]
yakischloba has quit [Read error: Connection reset by peer]
yakischloba has joined #ocaml
enthymene has joined #ocaml
ramenboy has quit [Remote host closed the connection]
ice_four_phone has joined #ocaml
mbishop_ is now known as mbishop
rwmjones has joined #ocaml
avsm has joined #ocaml
Associat0r has joined #ocaml
Associat0r has quit [Client Quit]
ice_four_phone has quit [Quit: ice_four_phone]
jeddhaberstro has joined #ocaml
oc13 has left #ocaml []
ygrek has quit [Ping timeout: 245 seconds]
ice_four_phone has joined #ocaml
derdon has quit [Quit: derdon]
yakischloba has quit [Quit: Leaving.]
ReachingFarr1 has joined #ocaml
ReachingFarr1 has quit [Client Quit]
ReachingFarr has joined #ocaml
<ReachingFarr> Anyone here use Menhir?
Submarine has quit [Quit: Leaving]
tmaedaZ has quit [Quit: Quit Nadoka 0.7.1-trunk (rev: 187) - http://www.atdot.net/nadoka/]
tmaedaZ has joined #ocaml
yakischloba has joined #ocaml
roconnor has joined #ocaml
<roconnor> # set_print_depth 300;;
<roconnor> Error: Unbound value set_print_depth
<roconnor> where do I find set_print_depth?
<roconnor> or otherwise stop ocaml top level from truncating my output prematurely
jao has joined #ocaml
<ReachingFarr> No Menhir users here?
jao has left #ocaml []
albacker has quit [Ping timeout: 276 seconds]
bzzbzz has joined #ocaml
_zack has joined #ocaml
yakischloba has quit [Ping timeout: 248 seconds]
avsm has quit [Quit: Leaving.]
xcthulhu has joined #ocaml
<Camarade_Tux> roconnor: set_print_depth? never heard about that function or anything like that, and I don't think you have anything like that
<Camarade_Tux> roconnor: however, using a custom printer should work, but I've never done it
<Camarade_Tux> ReachingFarr: don't ask to ask but ask
ulfdoz has quit [Ping timeout: 265 seconds]
rhar has joined #ocaml
roconnor has quit [Remote host closed the connection]
_zack has quit [Ping timeout: 265 seconds]
mbishop has quit [Ping timeout: 265 seconds]
yakischloba has joined #ocaml
mbishop has joined #ocaml
dark has joined #ocaml
ramenboy has joined #ocaml
brooksbp has quit [Quit: Leaving...]
avsm has joined #ocaml
<ReachingFarr> Wasn't asking to ask, was asking if there was even a point to me asking. If no one knows about Meinher there really isn't any point in me waiting around to see if anyone answers.
sepp2k has joined #ocaml
Amorphous has quit [Read error: Operation timed out]
enthymene has quit [Quit: rcirc on GNU Emacs 23.1.1]
avsm has quit [Quit: Leaving.]
yakischloba has quit [Quit: Leaving.]
boscop_ has quit [Ping timeout: 265 seconds]
Amorphous has joined #ocaml