sponge45 changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
swater_ has quit [Client Quit]
Nutssh has joined #ocaml
bluestorm has quit ["Konversation terminated!"]
pango_ has joined #ocaml
dark_light has quit [Read error: 104 (Connection reset by peer)]
Leonidas has quit ["An ideal world is left as an exercise to the reader"]
dark_light has joined #ocaml
johnnowak has joined #ocaml
ikaros has quit ["Leaving"]
johnnowak has quit [Client Quit]
pango has quit [Remote closed the connection]
Smirno1 has joined #ocaml
<Smirno1> is ocaml optimized for continuation passing style?
<malc_> no
<Smirno1> no better than plain tail rec then?
Smirno1 is now known as Smirnov
<malc_> no idea
<pango_> probably worse, as it uses heap allocation
<Smirnov> i'm not talking about callcc, just plain cps
<pango_> yes
<Smirnov> oh wow
<Smirnov> sounds nasty
<Smirnov> why isn't ref on the list of keywords in the manual
<Smirnov> im having a really hard time finding how to use it properly
<pango_> because it's not a keyword
<pango_> there's a ref type and a ref function
<Smirnov> the only thing i found was a "let j = ref i" where i is the counter in a for loop
<pango_> type 'a ref = { mutable contents : 'a } let ref x = { contents = x } let ( := ) x v = x.contents <- v let ( ! ) x = x.contents
<pango_> done, you redefined references
<pango_> that's why you get
<pango_> # ref 3 ;;
<pango_> - : int ref = {contents = 3}
<Smirnov> that doesnt make it an infix operator does it
<Smirnov> := and ! i mean
<Smirnov> interesting... thats exactly what a regular ref 3 returns
<pango_> they're infix because operators that start with : and ! must be infix in the language...
Foxyloxy has joined #ocaml
fozzold has joined #ocaml
fozzold has left #ocaml []
<Smirnov> cool
<pango_> mmh actually ! is prefix
<Smirnov> so when you do ref something, it puts a copy of something into the mutable contents?
fozzold has joined #ocaml
<pango_> yes, a record of a single mutable field
<Smirnov> and you said there was a type ref, did you mean the keyword mutable?
<pango_> type 'a ref = { mutable contents : 'a } ... it's a parametrized type
<Smirnov> you just made a new type there though, didnt you
<Smirnov> oh wait, thats the built in type yes
<Smirnov> or part of stdlib?
<Smirnov> either way, mutable is core im assuming
<pango_> I think it used to be defined in Pervasives, but it's no longer there
<Smirnov> found ref in pervasives actually
<Smirnov> as well as (!), (:=), incr, and decr
<pango_> maybe it's not needed somewhere earlier
<pango_> s/not/now/
<Smirnov> just got a homework assignment and we're supposed to use references and cps to make an interpreter, but i never used references in ocaml before :)
<pango_> my mistake, it's still there... I must be thinking of type 'a option
<Smirnov> silly references and side effects...bwahaha
<Smirnov> ocaml has callcc right?
<malc_> no
<Smirnov> oh am i thinking of ml?
<pango_> indeed the need for <- and :=, etc puzzled me until I learned how references are implemented
<malc_> Smirnov: you are thinking of sml
<Smirnov> oh ok
<Smirnov> any reason why theres isnt a callcc?
<malc_> hard to implement efficently
<malc_> cost/benefit ratio is low
<Smirnov> its cool thougg
<malc_> erm... yeah.. that's the first thing language implementors consider.. the coolness factor
<Smirnov> yeah
<Smirnov> cps makes kiddies go wtf?
<Smirnov> job security good yes? :)
<malc_> heh
<Smirnov> code all your programs like that and they'll never fire you
* pango_ used cps style in logo ;)
<delamarche> Smirnov: But they will start looking through your desk drawers for LSD
<Smirnov> lol
<Smirnov> so continuations not very useful outside of compilers then ?
<pango_> they're nice to implement backtracking, among things
<Smerdyakov> Continuations are low on uses, even in compilers.
<Smirnov> my teacher said continuations are very useful for compilers
<Smerdyakov> In theory you can compile uses of continuations efficiently, but in practice they pollute your whole language implementation and make everything slower.
<Smerdyakov> Now let's try to guess who the teacher is. Rosu?
<Smirnov> no
<pango_> goto is dead, long lives cps! :)
<Smirnov> we only had 2 lectures on continuations
<Smirnov> seems a lot like fancy tail rec to me :)
<Smerdyakov> So maybe the teacher is Gunter!
<Smirnov> haha... how did you know
<Smirnov> did you take that class or something?
<Smerdyakov> Well, I looked at the schedule online, and it's not so surprising that he would ask you to write an ML program for an assignment.
<Smirnov> its gunter's wife that teaches that course
<Smirnov> which didnt answer my question ;)
<Smerdyakov> I guess I should read initials more carefully.
stevan_ has joined #ocaml
stevan has quit [Read error: 110 (Connection timed out)]
fozzold has quit [Read error: 104 (Connection reset by peer)]
jfh has joined #ocaml
Nutssh has quit ["Client exiting"]
jfh has quit []
fozz has joined #ocaml
<Smirnov> hmm.. continuations seems so easy, am I doing it wrong?
<malc_> sure
joshcryer has quit [Read error: 104 (Connection reset by peer)]
malc_ has quit ["leaving"]
fozz has left #ocaml []
fik has quit [Remote closed the connection]
<Smirnov> well i finished my hw.... it was actually super easy, we just took an interpreter we wrote last week and converted it to use cps instead of plain recursion
johnnowak has joined #ocaml
stevan__ has joined #ocaml
stevan_ has quit [Read error: 110 (Connection timed out)]
johnnowak has quit []
cmeme has quit [Excess Flood]
cmeme has joined #ocaml
cmeme has quit [Excess Flood]
Smerdyakov has quit ["Leaving"]
cmeme has joined #ocaml
johnnowak has joined #ocaml
Smirnov has quit [Read error: 145 (Connection timed out)]
slipstream has joined #ocaml
slipstream-- has quit [Read error: 110 (Connection timed out)]
fozz_ has joined #ocaml
fozz_ has left #ocaml []
pango_ is now known as pangoafk
_JusSx_ has joined #ocaml
pangoafk is now known as pango
bluestorm has joined #ocaml
love-pingoo has joined #ocaml
shawn has quit [Read error: 145 (Connection timed out)]
Skal has joined #ocaml
shawn has joined #ocaml
swater has joined #ocaml
Yorick has joined #ocaml
Leonidas has joined #ocaml
Leonidas has quit [Read error: 54 (Connection reset by peer)]
ikaros has joined #ocaml
johnnowak has quit []
ikaros has quit [Remote closed the connection]
jajs has joined #ocaml
ikaros has joined #ocaml
Leonidas has joined #ocaml
fasta has joined #ocaml
<fasta> When I test this in the ocaml interpreter: type tree = Item of item|Section of tree list;; I get that item is unbound. This is copied straight from an article in The Journal Of Functional Programming.
<fasta> I would assume that something that gets published should work.
fik has joined #ocaml
<pango> you haven't defined the `item' type, I suppose
<fasta> pango: Ocaml does have parametrized data types, right?
<pango> yes
<fasta> Imho, the author of that paper made a mistake. He claims he's using Ocaml and then defines some code that is not an element of the Ocaml language.
<pango> maybe that item type is defined somewhere above, or the article forgot that definition...
<fasta> pango: Well, he says it's an unspecified type. I don't see why he didn't parametrized the type, though.
<pango> if it was supposed to be defined later, a parametrized version of your example would be type 'item tree = Item of 'item | Section of 'item tree list, something like that
<fasta> pango: ok, thanks
<fasta> pango: what exactly does the syntax 'item tree list mean?
jajs has quit [Remote closed the connection]
<fasta> pango: apply the type constructor tree to list?
<pango> type variables start with a quote, and types are written "in reverse order"... So it means a list of tree of 'item
<pango> s/tree/trees/
<pango> (making that whole parametrized type definition recursive, btw)
<pango> since 'item tree is the type currently being defined
<pango> http://www.ocaml-tutorial.org/data_types_and_matching, specially starting from the "recursive variants" chapter
<fasta> Is there some reason for the "reverse order"?
<pango> not really... the "revised syntax" uses the other order, so there's no deep reason for that, I guess
<fasta> "revised syntax"? Is that in a new version of Ocaml?
<pango> it's an alternative syntax, implemented using OCaml's camlp4 preprocessor
<fasta> But that already works _now_ in the interpreter I am running (which is recent)?
<pango> it's been there for years, so I guess it does
<pango> just #load "camlp4r.cma" ;; and you should be there
<pango> # #load "camlp4r.cma" ;;
<pango> # type t = list int ;
<pango> type t = list int
<fasta> This didn't work: type z 'a = A of a;;
<fasta> Heh, I was already at that page.
<pango> revised syntax wants [] around definition, like type z 'a = [ A of 'a ] ;
<fasta> Yes, I figured that out 10 seconds ago.
<fasta> Thanks, though :)
<pango> don't know why... it's supposed to be cleaner than traditional syntax, but such differences raise new questions...
<pango> that's probably why revised syntax doesn't have a huge following...
<Yorick> pango: I agree - I find it mostly an improvement, but some ugly spots remain. The brackets around data types is one such
Yorick has quit ["Leaving"]
<pango> I guess the point is to make all end of expressions unambiguous
jajs has joined #ocaml
<fasta> The same reverse order holds for tuples? I.e. foo * bar is really <bar, foo> in mathematical notation?
<love-pingoo> I doubt that
<pango> no, no, just parametrization
<love-pingoo> the point is not to reverse everything, just to put the argument after the function (list is a sort of type -> type function
<bluestorm> hum
<fasta> postfix notation, thus?
<bluestorm> but the reverse order of parametrization seems sooo logical
<pango> somehow, I never had a problem with the type of lists of ints being int list, etc.
<bluestorm> i understand why the revised syntax changed it, but it makes me sad ^^
<bluestorm> pango: it's because it fits very well with the natural language way
<pango> well, with natural english, at least ;)
<bluestorm> and german
<pango> but in french it'd be "liste d'entiers", so the order is reversed
<fasta> Isn't that order exactly the same?
<bluestorm> yes but you have the "d'" for "of"
<bluestorm> so it's like "Int of int"
<bluestorm> and pango, how could you think french when reading an english error message ? ^^
<pango> bluestorm: well, when reading some OCaml's error messages, you can :)
stevan_ has joined #ocaml
<pango> some say the compiler's messages are not very idiomatic
<pango> (often citing the "type mismatches" error messages, iirc)
stevan__ has quit [Read error: 110 (Connection timed out)]
smimou has joined #ocaml
_JusSx__ has joined #ocaml
<pango> probably like "not the usual way you talk about type mismatches in the street" ;)
_JusSx_ has quit [Read error: 113 (No route to host)]
fik has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
pango has joined #ocaml
Smerdyakov has joined #ocaml
stevan_ is now known as stevan
pauld has joined #ocaml
<pauld> Can i partially match a association list?
<Smerdyakov> Meaning what?
<pauld> like let alist = [1, 2; 2, 4] and then match alist (1, 1 *) -> true;
<Smerdyakov> There is no such star operator in OCaml.
<pauld> yes i know that. I put it there meaning "rest of the thing"
<mellum> match alist with [a, b; _] ->
<mellum> well, except that this only works for two elements.
<pango> or (a, b) :: _
<pauld> yes! thanks
<bluestorm> a::b::_ doesn't work ?
<stevan> (a, b) is a tuple
<stevan> not a list
<pango> bluestorm: association lists are ('a * 'b) list
<bluestorm> aah
<bluestorm> ok
<bluestorm> i missed the "association" part ^^
<stevan> does anyone know of a good resource for advanced usages of Modules, Classes and Functors? beyond the small part in the user manual?
pango_ has joined #ocaml
<trurl_> stevan: look for Rémy - Using, Understanding, and Unraveling The OCaml Language
<stevan> trurl_: thanks :)
<Smerdyakov> trurl_, heeey, have you been here much before?
<trurl_> no
<stevan> excellent! these are great
<Smerdyakov> Oh, I thought you were another ML user who uses the same nickname, but I see from your info that you're not. :)
shawn has quit [SendQ exceeded]
fasta has left #ocaml []
ikaros has quit ["Leaving"]
ikaros has joined #ocaml
mindCrime_ has quit [Connection timed out]
ikaros has quit ["Leaving"]
ikaros has joined #ocaml
ikaros has quit [Client Quit]
ikaros has joined #ocaml
ikaros has quit [Remote closed the connection]
ikaros has joined #ocaml
fik has joined #ocaml
swater has quit ["Quat"]
malc_ has joined #ocaml
stevan has quit [Read error: 104 (Connection reset by peer)]
stevan has joined #ocaml
jajs has quit [Remote closed the connection]
jajs has joined #ocaml
<dark_light> i implemented a database using a hashtable and i control that db with a thread that listen for events of a type like.. Db_add_data of id * data | Db_del_data of id, etc.. but when i have to query if a data exits, per example, i use: Db_data_exists of id * bool Event.channel, but it's just like passing a pointer to a function to read the answer.. is there any better approach to handle this?
<dark_light> i have a Db_data_read of id * data option Event.channel, and the interface of this is just insane.. because i pass a channel and receive in that channel Some data if there is a data, or None .. the code for just ask for a data is just ugly
<Roughest> is there a tutorial somewhere on how to use exceptions?
<Roughest> google is proving useless :(
<Roughest> argh how do i define an exception inside a class definition?
<bluestorm> you cannot
<bluestorm> exceptions are high-level things
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
johnnowak has joined #ocaml
twobitsprite has joined #ocaml
<dark_light> no ideas about "how to communicate in a better bidirectional way instead of unidirectional events"?
<twobitsprite> dark_light: care to explain the question?
<dark_light> twobitsprite, read above
<dark_light> ah
<dark_light> ok, i will repaste
jajs has quit ["Quitte"]
<dark_light> :P
<twobitsprite> dark_light: sorry, I have no idea
<dark_light> i think if there is any problem in creating a new channel every time i send a message
sponge45 has joined #ocaml
<twobitsprite> dark_light: sorry... I haven't programmed in ocaml in a long time
<dark_light> no problem :)
<dark_light> do you want to see the code?
<dark_light> it's here, http://200.165.98.9/~dark/codigo/ocaml/hydra/current/data.ml (the entire tree is here: http://200.165.98.9/~dark/codigo/ocaml/hydra/current ), but it's just a prototype
<dark_light> i wrote a "send a string to a socket": http://nopaste.tshw.de/11651848499e10b/ , is it robust? (i don't know which problems can occur while sending a string)
<pango_> I seem to remember reading that the point of events is that they're composable... Maybe reading some papers on Concurrent ML (where events idea came from) would help (http://citeseer.ist.psu.edu/reppy93concurrent.html ?)
<dark_light> composable?
<dark_light> my problem is: how create a consistent bidirectional communication between threads? i am thinking of pipes like Unix.mkfifo().. o.o
<pango_> event channels ?
<dark_light> the problem with event channels is that all communication are unidirectional
<dark_light> i have to pass a channel to the other thread, or the thread will not be able to reply
<pango_> what about reading the paper above ?
<dark_light> trying :)
<malc_> dark_light: events will do, if you are okay with blocking behaviour
_JusSx__ has quit [Client Quit]
_fab has joined #ocaml
<dark_light> actually events is a bit weird for me. seemed a great idea when i first saw, but i had to create another API just for really understand my code
<dark_light> like let evread channel = Event.sync (Event.receive channel) ..
rillig has joined #ocaml
pango has quit [Nick collision from services.]
twobitsprite has quit []
delamarche has quit []
johnnowak has quit []
bluestorm has quit ["Konversation terminated!"]
ChoJin has joined #ocaml
<ChoJin> hello