rwmjones changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.1 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<nameless`> thanks
<nameless`> how can i disable the warning message "this pattern matching is not exhaustive exemple value not matched [] " ? because i treat the [] possible case with a failwith but it still warnings me
<Smerdyakov> nameless`, sounds suspicious. How do you treat that case with a failwith?
<nameless`> i'm just implementing the "first" function (returning the first element of a list)
<nameless`> like this :
<nameless`> let premier = function liste -> if est_liste_vide(liste) then failwith "liste vide" else match liste with head :: tail -> head;;
<mwc> Smerdyakov, possibly before he matched on the list
<mwc> nameless`, a cleaner method is to put the check in the match
<mwc> that way the compiler can check you're being exhaustive
<mwc> what exactly does est_liste_vide check besides that list isn't empty?
<nameless`> est_liste_vide return true if the list is empty
<nameless`> else it returns false
<mwc> that's it?
<nameless`> ho
<nameless`> i see
<nameless`> i have to make two match ?
<mwc> no, make two cases in the match
<mwc> match head :: tail -> head;
<mwc> and [] -> failwith "liste vide"
<nameless`> ok i try that
<mwc> that's not the ocaml syntax btw, that's camlgrish :)
<nameless`> huhu
<nameless`> does the keyword match needs to be followed by with ?
<nameless`> match list with
<mwc> Actually, function expects a pattern matching as well
<nameless`> else it returns false
<nameless`> oups
<nameless`> sorry
<nameless`> ok
<nameless`> thx
<mwc> so you could do: let premier = function [] -> failwith "liste vide" | head :: tail -> head;;
<nameless`> woo
<nameless`> i can do that :)
<nameless`> well, why match isn't necessary here ?
<mwc> nameless`, let premier = function liste -> match ...
<mwc> premier accepts an argument that it binds to liste...
<mwc> binding against a name is a pattern match that always succeeds
<mwc> then when it's bound the argument list to liste, it moves on to evaluate the match clause, which does the pattern matching on list
<mwc> *liste
<mwc> but function is happy to pattern match as well
<nameless`> ok, thanks a lot
<mwc> Two lines from the ocaml grammar
<mwc> expr ::= ...
<mwc> | match expr with pattern-matching
<mwc> | function pattern-matching
postalchris has quit ["Leaving."]
<mwc> so the only difference between match and function is that match evaluates an expression, then matches against it, and function expects to receive the value as a function argument
<nameless`> ok i see
<nameless`> well if i try to use premier without a list, it returns me a match failure
<mwc> you shouldn't able to use it period without a list
<mwc> since it won't typecheck
<nameless`> yes, that's true
<mwc> # let premier = function [] -> failwith "liste vide" | head :: _ -> head;;
<mwc> val premier : 'a list -> 'a = <fun>
<mwc> # premier [1; 2; 3];;
<mwc> - : int = 1
<mwc> # premier [];;
<mwc> Exception: Failure "liste vide".
<nameless`> _ is a mute variable like the prolog _ ?
<mwc> yeah, it's a pattern that always matches, but doesn't do any binding
<mwc> more like a wildcard
<mwc> I don't know enough about prolog to answer your question ;)
<thelema> nameless`: yes
<nameless`> ok
<nameless`> do you have a good documention or a good link about using sdl with prolog ?
<nameless`> hups ^^
<nameless`> sdl with ocaml
<nameless`> i ripped my word
<thelema> http://ocamlsdl.sourceforge.net/home.html <- first result in google "ocaml sdl"
<middayc> GLCaml and SDLCaml (the same package) are more uptodate I think
<middayc> I have some tutorial on my blog ( itmmetelko.com/blog )
<nameless`> ok, i will go take a look
<nameless`> thx a lot for all these informations
<nameless`> bye
nameless` has quit [Remote closed the connection]
mwc has quit ["Leaving"]
mbishop has quit ["brb"]
mbishop has joined #ocaml
mwc has joined #ocaml
hkBst has quit ["Konversation terminated!"]
easy4 has joined #ocaml
middayc has left #ocaml []
ita has quit [Read error: 110 (Connection timed out)]
Optikal__ has joined #ocaml
mwc has quit [Remote closed the connection]
netx has joined #ocaml
nasloc__ has quit [Remote closed the connection]
|Catch22| has quit []
NikkiA has left #ocaml []
Demitar has quit [calvino.freenode.net irc.freenode.net]
ozzloy has quit [calvino.freenode.net irc.freenode.net]
noj has quit [calvino.freenode.net irc.freenode.net]
ozzloy_ has joined #ocaml
noj has joined #ocaml
Demitar has joined #ocaml
Demitar has quit [calvino.freenode.net irc.freenode.net]
jonafan has quit [calvino.freenode.net irc.freenode.net]
gim has quit [calvino.freenode.net irc.freenode.net]
thelema has quit [calvino.freenode.net irc.freenode.net]
szell has quit [calvino.freenode.net irc.freenode.net]
dobblego has quit [calvino.freenode.net irc.freenode.net]
huh has quit [calvino.freenode.net irc.freenode.net]
ertai has quit [calvino.freenode.net irc.freenode.net]
l_a_m has quit [calvino.freenode.net irc.freenode.net]
qwr has quit [calvino.freenode.net irc.freenode.net]
flux has quit [calvino.freenode.net irc.freenode.net]
Hadaka has quit [calvino.freenode.net irc.freenode.net]
acatout has quit [calvino.freenode.net irc.freenode.net]
shortcircuit has quit [calvino.freenode.net irc.freenode.net]
Snrrrub__ has quit [calvino.freenode.net irc.freenode.net]
jdavis_ has quit [calvino.freenode.net irc.freenode.net]
ikatz has quit [calvino.freenode.net irc.freenode.net]
petchema has quit [calvino.freenode.net irc.freenode.net]
__suri has quit [calvino.freenode.net irc.freenode.net]
mattam has quit [calvino.freenode.net irc.freenode.net]
Smerdyakov has quit [calvino.freenode.net irc.freenode.net]
svenl has quit [calvino.freenode.net irc.freenode.net]
kig has quit [calvino.freenode.net irc.freenode.net]
jeremiah has quit [calvino.freenode.net irc.freenode.net]
unfo- has quit [calvino.freenode.net irc.freenode.net]
TaXules has quit [calvino.freenode.net irc.freenode.net]
gaja has quit [calvino.freenode.net irc.freenode.net]
pattern has quit [calvino.freenode.net irc.freenode.net]
noj has quit [calvino.freenode.net irc.freenode.net]
jlouis_ has quit [calvino.freenode.net irc.freenode.net]
seafood_ has quit [calvino.freenode.net irc.freenode.net]
bzzbzz has quit [calvino.freenode.net irc.freenode.net]
Oatschool has quit [calvino.freenode.net irc.freenode.net]
Mr_Awesome has quit [calvino.freenode.net irc.freenode.net]
mbishop has quit [calvino.freenode.net irc.freenode.net]
thermoplyae has quit [calvino.freenode.net irc.freenode.net]
mfp has quit [calvino.freenode.net irc.freenode.net]
cmeme has quit [calvino.freenode.net irc.freenode.net]
ozzloy_ has quit [calvino.freenode.net irc.freenode.net]
ahf has quit [calvino.freenode.net irc.freenode.net]
Morphous_ has quit [calvino.freenode.net irc.freenode.net]
zbrown has quit [calvino.freenode.net irc.freenode.net]
mrsolo has quit [calvino.freenode.net irc.freenode.net]
guyzmo has quit [calvino.freenode.net irc.freenode.net]
bla has quit [calvino.freenode.net irc.freenode.net]
hcarty has quit [calvino.freenode.net irc.freenode.net]
smimou has quit [calvino.freenode.net irc.freenode.net]
ppsmimou has quit [calvino.freenode.net irc.freenode.net]
easy4 has quit [calvino.freenode.net irc.freenode.net]
hsuh has quit [calvino.freenode.net irc.freenode.net]
letrec has quit [calvino.freenode.net irc.freenode.net]
ecc has quit [calvino.freenode.net irc.freenode.net]
bebui has quit [calvino.freenode.net irc.freenode.net]
zmdkrbou has quit [calvino.freenode.net irc.freenode.net]
Dazhbog has quit [calvino.freenode.net irc.freenode.net]
thelema has joined #ocaml
szell has joined #ocaml
dobblego has joined #ocaml
ertai has joined #ocaml
huh has joined #ocaml
noj has joined #ocaml
ozzloy_ has joined #ocaml
easy4 has joined #ocaml
mbishop has joined #ocaml
bla has joined #ocaml
jlouis_ has joined #ocaml
Snrrrub__ has joined #ocaml
seafood_ has joined #ocaml
hsuh has joined #ocaml
acatout has joined #ocaml
shortcircuit has joined #ocaml
unfo- has joined #ocaml
jdavis_ has joined #ocaml
Smerdyakov has joined #ocaml
jeremiah has joined #ocaml
ikatz has joined #ocaml
kig has joined #ocaml
gaja has joined #ocaml
TaXules has joined #ocaml
svenl has joined #ocaml
petchema has joined #ocaml
__suri has joined #ocaml
pattern has joined #ocaml
mattam has joined #ocaml
hcarty has joined #ocaml
thermoplyae has joined #ocaml
bzzbzz has joined #ocaml
ahf has joined #ocaml
Morphous_ has joined #ocaml
letrec has joined #ocaml
mfp has joined #ocaml
smimou has joined #ocaml
zbrown has joined #ocaml
ecc has joined #ocaml
mrsolo has joined #ocaml
Oatschool has joined #ocaml
Mr_Awesome has joined #ocaml
cmeme has joined #ocaml
guyzmo has joined #ocaml
bebui has joined #ocaml
ppsmimou has joined #ocaml
Dazhbog has joined #ocaml
zmdkrbou has joined #ocaml
Demitar has joined #ocaml
qwr has joined #ocaml
flux has joined #ocaml
Hadaka has joined #ocaml
l_a_m has joined #ocaml
l_a_m has left #ocaml []
l_a_m has joined #ocaml
jlouis_ has quit ["leaving"]
<seafood_> Does anyone know what a "delimited string" is for the Scanf library?
<seafood_> I'm trying to parse the string "hello:4" using "%s:%d" but that doesn't work.
easy4 has quit []
mwc has joined #ocaml
pattern has quit [Remote closed the connection]
hsuh has quit ["zzz"]
mwc has quit [Read error: 113 (No route to host)]
mwc has joined #ocaml
<bla> seafood_, try []
<seafood_> huh?
<bla> seafood_, [^:]%d for scanf
<seafood_> bla: The answer was actually "%s@:%d"
<seafood_> The @ introduces a scanning indicator
<bla> That approach should also do. (;
<bla> And would work with C.
mwc has quit [Remote closed the connection]
pattern has joined #ocaml
mwc has joined #ocaml
brian` has joined #ocaml
seafood_ has quit []
seafood_ has joined #ocaml
seafood__ has joined #ocaml
Snrrrub has joined #ocaml
pattern has quit [Remote closed the connection]
jonafan has joined #ocaml
seafood_ has quit [Read error: 110 (Connection timed out)]
gim has joined #ocaml
Snrrrub__ has quit [Read error: 110 (Connection timed out)]
seafood__ has quit []
Snrrrub has quit [Read error: 110 (Connection timed out)]
seafood_ has joined #ocaml
seafood__ has joined #ocaml
brian` has quit [Read error: 104 (Connection reset by peer)]
tsuyoshi has joined #ocaml
Robdor has joined #ocaml
seafood_ has quit [Read error: 110 (Connection timed out)]
Robdor has quit [Remote closed the connection]
seafood__ has quit [Read error: 110 (Connection timed out)]
ttamttam has joined #ocaml
Dazhbog has quit [Read error: 113 (No route to host)]
kig has quit [Read error: 101 (Network is unreachable)]
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
seafood_ has joined #ocaml
seafood_ has quit [Client Quit]
thermoplyae has quit ["daddy's in space"]
mrsolo has quit ["This computer has gone to sleep"]
filp has joined #ocaml
filp has quit ["Bye"]
kig has joined #ocaml
Tetsuo has joined #ocaml
Dazhbog has joined #ocaml
<mwc> Looks like all the European camlers are waking up
<mwc> .it, .fi, .ft
<mwc> s/ft/fr/
<mwc> Damn, I'm getting the stayed-up-all-night-doing-analysis-thumb-ache
acatout has quit ["leaving"]
acatout has joined #ocaml
OChameau has joined #ocaml
bongy has joined #ocaml
bongy has quit [Client Quit]
pattern has joined #ocaml
olleolleolle has joined #ocaml
rwmjones has joined #ocaml
__suri has quit [Read error: 104 (Connection reset by peer)]
__suri has joined #ocaml
mrsolo has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]> hi
<mwc> hello
acatout has quit [Remote closed the connection]
acatout has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
Snark has joined #ocaml
Yoric[DT] has joined #ocaml
netx has quit [Remote closed the connection]
netx has joined #ocaml
rwmjones has quit ["Closed connection"]
olleolleolle has quit []
hkBst has joined #ocaml
rwmjones has joined #ocaml
rwmjones has quit [Client Quit]
xavierbot has joined #ocaml
rwmjones has joined #ocaml
jderque has joined #ocaml
jderque has quit ["leaving"]
TheLittlePrince has joined #ocaml
filp has joined #ocaml
TheLittlePrince has quit [Remote closed the connection]
darkness3477 has joined #ocaml
darkness3477 has left #ocaml []
RobertFischer has joined #ocaml
petchema_ has joined #ocaml
petchema has quit [Read error: 113 (No route to host)]
Snrrrub has joined #ocaml
<Snrrrub> If I have a variant type: type foo = X of string | Y of string what's the right way of determining whether I have an X or Y from C code? It's not sequential from 0 since it has parameters and hash_variant("X") doesn't equal Field(myValue, 0)...
<Snrrrub> I can get at the string value with no problem via String_val(Field(myValue, 1)) as per the doc but I can't figure out the type
<rwmjones> Snrrrub, don't use hash_variant
<rwmjones> that's only for polymorphic `Variants
<rwmjones> X has a tag of 0, Y has a tag of 1
<Snrrrub> Oh, it's stored in the *tag* and not in Field(v, 0)?
<rwmjones> and there will be 1 field containing the string
<rwmjones> yes, for ordinary variants like this
<rwmjones> it's a bit complicated
<rwmjones> ordinary variants _without_ parameters are numbered from 0
<rwmjones> ordinary variants _with_ parameters are also numbered from 0
<rwmjones> so if you have something like type t = X of int | Y
<rwmjones> then they both have tag 0
* rwmjones thinks that's right
* rwmjones checks again
<Snrrrub> If I have a variant like type t = X | Y then I don't even have a block; the value itself is the ordinal, right?
<rwmjones> in that case you have what is basically an int, yes
<Snrrrub> Is there another doc for this other than the manual?
<rwmjones> ah yes, what I said above was slightly wrong
<rwmjones> ordinary variants _without_ parameters are represented as integers, counting from 0 (but <<1 | 1 as in all OCaml integers)
RobertFischer has left #ocaml []
<rwmjones> ordinary variants _with_ parameters are blocks of size 1 with tags counting from 0
<rwmjones> section 18.3.4
<Snrrrub> Ah, it's not in the "variant" section...
<rwmjones> no, that's for polymorphic variants
<Snrrrub> Thanks for the help!
<rwmjones> note also the implication that you can only have ~ 240 variants (for an ordinary variant, polymorphic ones are essentially unlimited)
<rwmjones> that's in a single type of course
<Snrrrub> Yup, presumably following from the fact that No_scan_tag-1 is ~240
<rwmjones> yup, not sure if that applies only to types where any variant has a parameter, or to all variant types
<Snrrrub> Hmm, good point. I'll TIAS :)
shortcircuit has quit ["Probably rebooting."]
shortcircuit has joined #ocaml
Morphous has joined #ocaml
filp has quit ["Bye"]
thelema has quit [Read error: 110 (Connection timed out)]
mrsolo has quit ["Leaving"]
Morphous_ has quit [Read error: 110 (Connection timed out)]
gaja has quit [Read error: 110 (Connection timed out)]
gaja has joined #ocaml
Snrrrub__ has joined #ocaml
marmottine has joined #ocaml
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
Snrrrub has quit [Read error: 110 (Connection timed out)]
ttamttam has left #ocaml []
Yoric[DT] has joined #ocaml
<Yoric[DT]> hi again
thelema has joined #ocaml
nameless` has joined #ocaml
<nameless`> hi
<nameless`> i'm here to know what difference there is betwen : let double x = x*2;; and let double = function x -> x*2;; ?
<nameless`> what is the semantic value of double without the keyword function and the semantic value of double with the keyword function
<Yoric[DT]> There's no semantic distinction.
<Yoric[DT]> The first is a shortened version of the second.
<nameless`> ok, i expected an explication related to the lambda-calculus or something like that :) thx
<Yoric[DT]> :)
<Yoric[DT]> Sometimes, the answer in OCaml is just "it looks nicer that way".
OChameau has quit ["Leaving"]
bluestorm has joined #ocaml
ita has joined #ocaml
mwc has quit [Remote closed the connection]
<nameless`> huhu
ozzloy_ is now known as ozzloy
rwmjones has quit [Remote closed the connection]
rwmjones has joined #ocaml
nameless1 has joined #ocaml
<nameless1> i don't understand this exemple from the core library :
<nameless1> #let current_rand = ref 0;;
<nameless1> val current_rand : int ref = {contents = 0}
<nameless1>
<nameless1> #let random () =
<nameless1> current_rand := !current_rand * 25713 + 1345;
<nameless1> !current_rand;;
<xavierbot> Characters 1-13:
<xavierbot> !current_rand;;
<xavierbot> ^^^^^^^^^^^^
<xavierbot> Unbound value current_rand
<nameless1> ow, funky
<nameless1> i don'"t understand why the return number of the random() function change each time
<bluestorm> because the current_rand reference is modified
<nameless1> oh
<bluestorm> however, it would make more sense to have current_rand local to the "random" function
<nameless1> ok
<nameless1> ah yes i understand
<nameless1> thx
<bluestorm> (but it's not trivial to do, so the global value is ok for now)
nameless` has quit [Connection timed out]
<Yoric[DT]> Just for information, it's not that hard either :)
<nameless1> i never expected that was hard, actually, i falling love with ocaml
<Yoric[DT]> Welcome to the club :)
nameless1 is now known as nameless`
thermoplyae has joined #ocaml
ttamttam has joined #ocaml
mwc has joined #ocaml
Snark has quit ["Ex-Chat"]
ttamttam has left #ocaml []
jlouis has joined #ocaml
marmottine has quit [Remote closed the connection]
thermoplyae has quit ["daddy's in space"]
ReachingFarr has joined #ocaml
smimou has quit ["bli"]
bluestorm has quit [Remote closed the connection]
smimou has joined #ocaml
onigiri has joined #ocaml
bzzbzz has quit ["leaving"]
rwmjones has quit ["Closed connection"]
madroach has joined #ocaml
<madroach> Hi! Is there a library that can output caml data as caml code like the toplevel does it? Would be nice. Otherwise I always have to write my custom print_array, print_list, print_listofpairs....
ita has quit [Remote closed the connection]
<Yoric[DT]> madroach: you can look at deriving.
<Yoric[DT]> It's a bit more complicated than the toplevel, but it's the only solution I know.
nameless` has quit ["Lost terminal"]
Jose_Balado has joined #ocaml
ReachingFarr has quit ["Leaving."]
thermoplyae has joined #ocaml
Tetsuo has quit ["Leaving"]
Tetsuo has joined #ocaml
Tetsuo has quit [Client Quit]
Jose_Balado has left #ocaml []
hkBst has quit ["Konversation terminated!"]