Alpounet changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.1 out now! Get yours from http://caml.inria.fr/ocaml/release.html
Yoric has quit []
tmaedaZ0 has joined #ocaml
thrasibule has quit [Read error: 110 (Connection timed out)]
tmaedaZ has quit [Read error: 110 (Connection timed out)]
<ski_> mrvn : the cbv CPS translation translates `x' to `fun k -> k x'
ski_ has quit ["Lost terminal"]
ski_ has joined #ocaml
<palomer> knew it!
<palomer> I have been vidicated
jlouis has quit ["leaving"]
jlouis has joined #ocaml
Kirill has joined #ocaml
<Kirill> hi! can someone explain this syntax: "datatype X = e | s of X | m of X * X"?
<Kirill> namely, what is the difference between e, s, m, and why are different letters used?
Submarine has quit [Read error: 110 (Connection timed out)]
Associat0r has quit []
<palomer> Kirill, do you know what a C++ enumeration is?
<palomer> or a java enumeration, for that matter
<Kirill> palomer: actually, I figured out out by googling because I'm impatient. sorry, and thanks anyway =)
Kirill has left #ocaml []
<palomer> I wonder what language that is
<palomer> probably miranda or something
<ski_> looks like SML
det has joined #ocaml
middayc has quit ["ChatZilla 0.9.86 [Firefox 3.5.6/20091201220228]"]
tmaedaZ0 is now known as tmaedaZ
tmaedaZ is now known as tmaedaZ0
munga has joined #ocaml
nvictor has joined #ocaml
<nvictor> hello channel
<nvictor> i need your help
<nvictor> i found a section in the book developing apps with ocaml that is about writing a BASIC interpreter
<nvictor> i'm new to the whole thing
<nvictor> so i'm confused about these lines
<nvictor> just after let pp_expression
<nvictor> can someone explain it to me?
<nvictor> anybody online?
<palomer> one sec
<palomer> ppl is a function which takes two arguments
<nvictor> palomer: thanks a lot in advance :)
<nvictor> yes
<nvictor> palomer: if you want i can send you a link to the book so you can easily follow along
<palomer> that's ok, just ask me some specific questions and ill answer as best I can
<nvictor> palomer: thanks
<nvictor> palomer: also, you speak french by any chance?
<palomer> yup
<nvictor> cool
<nvictor> if i get stuck i will ask in french :)
<palomer> k
<nvictor> so how do you know ppl takes two arguments?
<nvictor> we have
<nvictor> let rec ppl pr = function
<nvictor> this means, match patterns with values right?
<nvictor> and the rec, means, this will be a recursive function
<palomer> let rec ppl pr = function ... is equivalent to {let rec ppl pr y = match y with ...}
<nvictor> right right
<palomer> let rec ppl pr = t means that ppl will be visible in t, otherwise it won't
<palomer> so let ppl () = ppl () flags an error
<palomer> let rec ppl () = ppl () doesn't
<palomer> you can also have recursive non functions
<nvictor> wait, this is getting complicated :)
<nvictor> so the rec
<nvictor> means, what follows rec will be visible in what follows =
<nvictor> ok
<palomer> right
<palomer> the following is legal though: let a = 5 in let a = a + a in a <---returns 10
<palomer> while let a = 5 in let rec a = a + a <---is illegal because of some rather obscure constraints, but otherwise would loop
<nvictor> palomer: so what is the in ppl 0 ;; doing in my case?
<nvictor> the very last line?
<palomer> ppl 0 is a function
<nvictor> a function?
<nvictor> i thought ppl was
<palomer> right
<nvictor> and that ppl accepted two parameters
<palomer> so ppl is a function which takes two arguments
<nvictor> yes
<palomer> so ppl 0 is a function which accepts 1 argument
<palomer> and ppl is not a function
<palomer> err
<palomer> ppl 0 (ExpInt 5) is not a function
<palomer> consider: let a b c d e f g = 5
<palomer> is {a} a function?
<nvictor> i dont know :)
<nvictor> palomer: tell me
<nvictor> does the let operator allow multiple assignment?
<nvictor> i mean will a = b = c = ... = 5?
<palomer> yes, but we'll go over this later
<nvictor> ok
<palomer> err, not like that
<palomer> let plus a b = a + b
<palomer> is plus a function?
<palomer> or, rather, is {plus} a function?
<nvictor> yes
<nvictor> no?
<nvictor> :)
<palomer> yes, it is
<palomer> is {plus 5} a function?
<nvictor> palomer: why do you put it in { } ?
<palomer> so you won't get confused
<nvictor> ah ok
<nvictor> :)
<palomer> is (plus 5) a function?
<nvictor> i think so
<nvictor> with the first argument set
<palomer> right
<palomer> is (plus 5 6) a function?
<nvictor> no it is not
<palomer> right
<nvictor> (plus 5 6) a is an error
<palomer> {plus 5 6} is an integer
<nvictor> yes
<nvictor> i see
<nvictor> i understand
<nvictor> so {in ppl 0} is the context in which the first argument is set to 0
<palomer> right
<palomer> so {ppl 0} is the same as writing {let foo x = ppl 0 x in foo}
<nvictor> hmm
<nvictor> i'm confused
<nvictor> palomer: why is it in foo?
<palomer> let BLAH = t in BLAH means bind t to BLAH and return it
<palomer> so {let foo x = ppl 0 x in foo} means bind ppl 0 to foo and return it
<palomer> I think the best way to approach this is through types
<palomer> let plus a b = a + b
<palomer> plus has type int -> (int -> int)
<palomer> so plus 5 has type int -> int
<nvictor> yes
<palomer> so plus 5 6 has type int
<palomer> in this case ppl has type int -> expression -> string
<palomer> so ppl 0 has type expression -> string
<nvictor> :(
<nvictor> i must be bothering you
<nvictor> i guess i'm so used to imperative programming
<palomer> I think you got it
<nvictor> why have plus the type int -> (int -> int)
<nvictor> not really
<palomer> right
<nvictor> plus is given two arguments
<palomer> so int -> int is a function which takes an int and returns an int
<palomer> and int -> (int -> int) is a function which takes an int and returns a function
<nvictor> yes
<palomer> but that's exactly what plus is
<nvictor> ohhh
<nvictor> i get it
<nvictor> so the way you think about it is
<nvictor> you take the first int
<nvictor> apply a function to it
<nvictor> which in turn takes the result
<palomer> right
<nvictor> and returns a final int
<nvictor> i see
<nvictor> ok let me consider the code again
<nvictor> let rec ppl pr = function ... in ppl 0;;
<nvictor> ppl has type int -> (expression -> string)
<palomer> right
<nvictor> and ppl 0 set the first int to 0
<palomer> something like that
<nvictor> ok now for the matching part
<nvictor> why ExpInt n -> (string_of_int n) ?
<palomer> that says: if the second argument of ppl is ExpInt n then return (string_of_int n)
<nvictor> i somewhat got it that way
<palomer> string_of_int has type int -> string
<nvictor> yes i got that
<nvictor> i mean, why ExpInt n
<nvictor> and not ExpInt only?
<nvictor> i thinkg ExpInt is defined type ExpInt of int; or something
<palomer> ExpInt takes an argument
<nvictor> is it like function?
<palomer> it's a constructor
<nvictor> it is declared type expression = ExpInt of int | ...
<palomer> match (ExpInt 5) with ExpInt 5 -> 5 would return 5
<palomer> right
<palomer> so ExpInt is a constructor which takes an int
<palomer> a constructor is kind of like a function
<palomer> except the only thing you can do with them is match
<nvictor> i see
<nvictor> ohh it makes sense
<palomer> and they have to be applied completely
<palomer> on that note, I must be off
<nvictor> oh no :(
<palomer> this channel is rather helpful
<palomer> stick around
<nvictor> thanks a lot for you help :)
<palomer> np
munga has quit [Read error: 113 (No route to host)]
<nvictor> anyone online?
zhijie has joined #ocaml
<nvictor> hi zhijie :)
<zhijie> hi nvictor :)
<nvictor> zhijie: can you help :)
<nvictor> if you have some free time
<zhijie> i'd glad to but i'm a newbie...
<zhijie> hardly know anything :( :P
<nvictor> don't worry i just started today :)
<nvictor> you know about matching expression?
sgnb has quit [farmer.freenode.net irc.freenode.net]
<zhijie> yep
<nvictor> cool :)
<nvictor> _ -> ... means match anything?
<zhijie> yeah~
<nvictor> ok
sgnb has joined #ocaml
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
<nvictor> zhijie: you there?
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
_unK has quit [Remote closed the connection]
<nvictor> anybody online?
<orbitz> nope
quotemstr has joined #ocaml
<quotemstr> How big are compiled OCaml binaries compared to the same program coded in C?
<nvictor> orbitz: can you help?
<orbitz> quotemstr: That question is painfully vague
<orbitz> nvictor: Help wiht what?
<nvictor> orbitz: thanks in advance :) i'm following the basic interpreter tutorial in the book developing apps with ocaml
<orbitz> ok
<nvictor> i'm totally new to the language
<nvictor> i'm more interested in the basic interpreter
<nvictor> so
<nvictor> what does
<nvictor> let pp_command = function
<nvictor> noo
<nvictor> ok let me paste
<orbitz> use a pastebin
<quotemstr> orbitz: Fair enough. I suppose my real question is whether compiled binaries need to tote around a large runtime library, or whether they're pretty much self-contained.
<orbitz> quotemstr: pretty much self contained IIRC
<orbitz> quotemstr: which is why they are so large
<quotemstr> Ah, I see.
<quotemstr> Also, how's the FFI?
<orbitz> I'm not sure, i believ eit's not horrible
<nvictor> what does that work?
<orbitz> nvictor: let f = function ... is equivalent to let f y = match y with ...
<nvictor> orbitz: these are how Rem, etc are defined
<nvictor> ok
<nvictor> so the first is
<nvictor> let pp_command y = match y with Rem s -> "REM " ^ s ?
<orbitz> no
<nvictor> :(
<orbitz> ther eis no _ there
<orbitz> command is a parameter
<orbitz> let pp command y = match y with ...
<nvictor> my bad
<nvictor> it should be pp_command
<nvictor> for "pretty print command"
<orbitz> ok
<nvictor> pp_expression for "pretty print expression"
<nvictor> let me fix that
<nvictor> orbitz: fixed
<nvictor> :)
<nvictor> so the first is
<nvictor> let pp_command y = match y with Rem s -> "REM " ^ s ?
<orbitz> those are equivaletn, yes
<nvictor> what is the role of s
<nvictor> i don't get it
<orbitz> pattern matching
<nvictor> why does the matching work?
<orbitz> if y is Rem 4
<orbitz> s will be 4
<nvictor> ooohhhh
<nvictor> :D
<nvictor> so y is the whole thing that is passed
<nvictor> no?
<orbitz> yes
<nvictor> cook
<nvictor> cool :)
<nvictor> sorry
<nvictor> so what about the last two?
<nvictor> y is If (e,n) too?
<orbitz> if y is If (4, 5) e will be 4, n will be 5
<nvictor> ok
<nvictor> if the letter appears on the other side, it's a variable?
<orbitz> i do not understand
<nvictor> if the pattern appears on the right side
<nvictor> it is "what changes"
<orbitz> you should read up on patternmatching
<orbitz> it's fairly simple
<nvictor> like 4, 5
<nvictor> it's not :)
<nvictor> that's why i'm here :(
<orbitz> nvictor: do you understand th ebasics? Rem is a constructor
<nvictor> yes i get that much :)
<orbitz> Do you understand what algebraic data types are?
<nvictor> no
<orbitz> command is an algebraic data type
<nvictor> i see
<nvictor> something of the form
<nvictor> type name = pattern of type | pattern2 of type;;
<orbitz> yes
<nvictor> so how does it work in the case of pp_command?
<nvictor> what does Rem s means?
<orbitz> it means match the value fo y agains tthe patterm Rem s.
<orbitz> things that start with a lower case cahracter are variables
<orbitz> so give the value to s
<nvictor> ooh i see
<nvictor> orbitz: so the algebraic thing is not doing anything?
<nvictor> what can be its purpose?
<orbitz> what?
<orbitz> nvictor: you match against several cases
<orbitz> each being part of the ADT
<nvictor> hmm
<nvictor> orbitz: and what is the role of the ADT?
<nvictor> i understand the matching part
<orbitz> match is pretty useless with an ADT
<nvictor> ok, so you think one of the definitions is useless?
<orbitz> what?
<orbitz> I don't believe i eve rimplied that
<nvictor> :)
<nvictor> i'm confused
<nvictor> match is useless with an ADT?
<orbitz> oh im' sorry
<orbitz> match is prett useless without an ADT
<nvictor> oh ok
<nvictor> ok i see
<nvictor> so match needs an ADT
<orbitz> no
<orbitz> it's just the most powerful usage
<nvictor> i see
<nvictor> now in the case of these definitions: http://paste.pocoo.org/show/157778/
<nvictor> how will pp_command will use each entry in the ADT?
<orbitz> ...the match...
<nvictor> orbitz: so y = Rem 4 won't be matched? because 4 is not a string?
<orbitz> that won't compile
<orbitz> i just used it as a trivial example
<nvictor> i understand that much
<nvictor> i'm just saying in the case y is Rem 4
<nvictor> nothing with be matched right?
<nvictor> will
<orbitz> It won't compile
<orbitz> if Rem were defiend as
<orbitz> Rem of int
<orbitz> then Rem 4 would match
<orbitz> s would be 4
<nvictor> ok i get it
<nvictor> thanks
<nvictor> orbitz: i don't have a compiler ;)
<orbitz> then you should get one
<nvictor> i mean
<nvictor> i am more interested in the basic interpreter than the language
<nvictor> so i'm trying to understand the language so i can understand how the interpreter is written
<EliasAmaral> maybe a better way would be to write real programs
<nvictor> EliasAmaral: the basic interpreter is a real program :)
<EliasAmaral> or at least try to solve a programming problem in ocaml
<EliasAmaral> nvictor, you want to write a ocaml interpreter?
<nvictor> no no
<nvictor> i mean, there is a chapter applications in the book
<nvictor> and the BASIC interpreter is one of those apps described
<EliasAmaral> the basic semantics of the language will be much clearer if you write some programs
<EliasAmaral> hmm
<orbitz> nvictor: palying ith the code is the only wya you'll leanr
<orbitz> just suck it up
<nvictor> i tried but it's complicated
<nvictor> so i'm just reading the code for the BASIC interpreter
<nvictor> then going back to previous chapter
<nvictor> and read about the constructs
<EliasAmaral> ah. yeah. ocaml is a great tool to write interpreters and compilers. but i don't actually see many real interpreters and compilers written in ocaml, maybe because ocaml isn't very portable. it's more often to see them written in c
<orbitz> sounds like a failure n teh making
<nvictor> orbitz: no no it does work
<nvictor> i just start a couple of hours ago
<orbitz> riiiight
<nvictor> i tried to read cover to cover
<EliasAmaral> nvictor, it's complicated only if you don't start from the small programs, and then progress from there. but reading some code is always good:)
<nvictor> but i'm getting lots of complicated stuffs i won't even need for the BASIC interpreter
<nvictor> anyways
<nvictor> thanks for your help
<nvictor> :)
<nvictor> weird construct in visu :)
<nvictor> cl.current <- cl.current+1
<nvictor> just scanned the first chapters of the book no mention of it
<nvictor> what does that do?
<nvictor> i mean, there is something
<nvictor> but it seems to be working with arrays
<nvictor> ohh
<nvictor> and mutable fields of records
<nvictor> nvm
<nvictor> brb
nvictor has left #ocaml []
ulfdoz has joined #ocaml
quotemstr has left #ocaml []
<palomer> :o
nvictor has joined #ocaml
<nvictor> orbitz: you there :) ?
<palomer> im here
<nvictor> palomer :)
<nvictor> i'm confused with something
<palomer> shoot
<palomer> a word of advice: make your questions short, clear and self contained
<nvictor> line : 12
<nvictor> string : (char > bool)
<nvictor> question : why ? :)
<palomer> extract?
<nvictor> yes
<palomer> it takes two arguments, yes?
<nvictor> i get it that (char > bool) is the pred
<nvictor> yes
<palomer> and returns a string, right?
<nvictor> yes
<nvictor> it does
<palomer> so what's the problem??!
<nvictor> (char -> bool)
<palomer> right, so it takes a function as an argument
<nvictor> yes, first argument
<palomer> what, exactly, is your question?
<nvictor> palomer: i think i don't get the notation
<nvictor> you said arg1 -> arg2 -> return value right?
pad has quit [Remote closed the connection]
<palomer> watch out, functions are considered values
<nvictor> ok
<palomer> but yeah, something like that
<palomer> so the "return value" has type string
<nvictor> how does ocaml work with it?
<nvictor> does it takes the whole definition of extract
<palomer> oh, I see the problem
<nvictor> then apply arg1
<palomer> (char -> bool) -> string_lexer -> string means (char -> bool) -> (string_lexer -> string)
<nvictor> then takes the resulting value
<palomer> the parenthesis are omitted
<palomer> -> is left associative
<nvictor> so it's really like i was saying?
<palomer> (char -> bool) -> (string_lexer -> string)
<palomer> so it takes a function
<palomer> and returns a function
<palomer> an expression {extract f} will have type string_lexer -> string
<nvictor> oh okay :)
<nvictor> yes
<palomer> it's the same thing as before
<nvictor> makes senses
<nvictor> thanks
<nvictor> palomer: the whole thing is here, just in case you are also interested
<palomer> so {a -> b -> c -> d} means {a -> (b -> (c -> d))}
<nvictor> yes
<palomer> they oreilly book!
<palomer> that was my first book too
<palomer> though it only lasted a week or so
<palomer> before I went back to ruby
<nvictor> palomer: you program in ruby?
<palomer> not anymore
<nvictor> ok
<nvictor> i do python
<palomer> I've been stuck on this stuff for too long to go back
<nvictor> actually my idea was to write a basic interpreter in python
<nvictor> i searched for a bnf language for BASIC
<palomer> runtime type errors were a huge bummer:/
<palomer> well, annoying
<nvictor> the only thing relevant was this book
<palomer> ocaml is good for this kind of stuff
<palomer> really good
<nvictor> i see
<palomer> this is what it does best, actually
<nvictor> hehe :)
<palomer> it's a hard problem, though
<nvictor> but it is compiled right?
<palomer> it's compiled
<palomer> and pretty fast
<nvictor> so might be faster than python
<palomer> it probably is
<palomer> i remember noticing a huge difference between ruby and ocaml
<palomer> this is quite a challenge you have here
<palomer> best way to learn is to set a challenge
<palomer> unless you get discouraged
<nvictor> i won't
<nvictor> :)
<nvictor> i already wrote a BASIC interpreter
<nvictor> i'm just taking a new approach
<nvictor> and functional programming is quite interesting
<nvictor> then i will apply this to python and see how it turns out
<nvictor> by the way
<nvictor> is ruby really that good :)
<nvictor> ruby programmers are like our rivals
<palomer> python, ruby, same difference
<nvictor> :)
valross has quit ["Ex-Chat"]
<palomer> I was into ruby before it got popular
<nvictor> i see
<nvictor> i might try it some day
<palomer> I don't know if it's worth it
<palomer> haskell is good to try
<nvictor> ok i note that
<nvictor> palomer: can we go back and clarify a point on constructors?
<palomer> it's ocaml, but trickier
<nvictor> trickier you say?
<palomer> ok, constructors then i'm off to bed
<nvictor> then i won't try
<nvictor> ocaml is very tricky :D
<palomer> at first
<palomer> but then it becomes natural
<nvictor> ok
<palomer> the trickiest part of starting ocaml is the type errors
<nvictor> what does that really mean? Lident (extract ident cl)
<palomer> it means apply the constructor Lident to (extract ident cl)
<nvictor> yes i got that much, but what does that mean?
<palomer> when you wrote your interpreter for basic, what language did you use?
<nvictor> python
<palomer> ah, so you created a parse tree
<palomer> each node subclassed a parent class, right?
<nvictor> no not really
<nvictor> hehe
<palomer> did you have any kind of tree structures?
<nvictor> i didn't know these
<nvictor> i just scanned the text
<nvictor> and used recursion
<palomer> ok, well often it's useful to store stuff in trees
<palomer> and then tag each node in the tree with an identifier
<palomer> yeah?
<nvictor> i think this is what is done here
<palomer> yes
<palomer> so this creates a node tagged with Lident
<palomer> and the contents of that node is (extract ident cl)
<palomer> you can compose trees, etc....
<nvictor> i see :)
<palomer> type bin_op = PLUS | MINUS | MULT | DIV | MOD
<palomer> | EQUAL | LESS | LESSEQ | GREAT | GREATEQ | DIFF
<palomer> | AND | OR ;;
<nvictor> palomer: so it isn't the same are saying the result of (extract_ident cl) has type Lident?
<palomer> that says that the binop "tree" will only have one node, and these are the possible tags of that node, and that the nodes do not contain information
spicey has joined #ocaml
<palomer> Lident is not a type
<palomer> it's a tag
<palomer> we call it a constructor
<palomer> type expression =
<palomer> ExpInt of int
<palomer> | ExpVar of string
<palomer> | ExpStr of string
<palomer> | ExpUnr of unr_op * expression
<palomer> | ExpBin of expression * bin_op * expression ;;
<palomer> that's a little more interested
<nvictor> ok
<nvictor> so expression is a tree
<palomer> that says that an expression "tree" (expression is a type) is a node which is either an ExpInt, an ExpVar, an ExpStr, an ExpUnr, ExpBin
<palomer> and the contents of ExpUnr is a pair
<palomer> whose second element is another expression tree!
<nvictor> oooohh
<nvictor> i see what it means now
<palomer> so let's say you have a "tree" (we call it a value) of type expression
<nvictor> so a lexeme is just a tree node?
<nvictor> and possible tags are Lident
<nvictor> Lint
<nvictor> Lstring, etc...
<palomer> right, the lexeme type describes a tree with a single node
ski_ has quit ["Lost terminal"]
<nvictor> and we construct nodes with Lint value
<palomer> right
<nvictor> got it
<palomer> Lint 4 is a value of type lexeme
<nvictor> thanks a lot, it makes perfect sense
<nvictor> palomer: you should have written the book instead ;)
<palomer> so, say we have an expression value
<spicey> struggling to write a clean ocaml function to delete an entry from a binary tree, I failed even to find a good one, as everybody seem to ignore this problem, but there definitely should be some implementation somewhere - any ideas?
<palomer> spicey, checked out AVL trees?
<EliasAmaral> spicey, it's a functional binary tree, right?
<palomer> nvictor, so, say you have a value of type lexeme
<nvictor> yes
<palomer> call this value x
<palomer> we know that x is one of Lint, Lident, Lsymbol, Lstring, Lend
<EliasAmaral> there is no such a thing as deleting from a functional tree. your function should just rebuild the tree without the value (it's a classic recursive function)
<nvictor> palomer: yes
<palomer> so we do match x with Lint y -> .. | Lident y -> ... | Lsymbol y -> ... | Lstring y -> ... | Lend -> ...
<palomer> match checks every possibility for the value
<palomer> and runs the appropriate block of code
<palomer> in this case I bind y to the contents
<spicey> EliasAmaral, yes, I see now, that makes sense
<EliasAmaral> spicey, but if you want to just use them maybe the module Set will do the job (it have the same semantics of the interface of a search binary tree, i don't know how it is implemented)
<EliasAmaral> spicey, you maybe should read the code of Set
<palomer> Set is a red black tree, yes?
<EliasAmaral> i don't know, it makes sense, but it might be avl too
<nvictor> palomer: got it, thanks :)
<palomer> so {match (Lint 4) with Lint y -> y} evaluates to 4
<nvictor> yes
<palomer> you can also build infinite trees and stuff
<palomer> which is mildly cool
<palomer> anyways, I'm off to bed
<palomer> night!
<EliasAmaral> bye palomer
<nvictor> gnite
palomer has quit ["Leaving"]
joewilliams has quit [Remote closed the connection]
ulfdoz has quit [Read error: 110 (Connection timed out)]
ttamttam has joined #ocaml
<spicey> Why wouldn't List.filter (fun x -> x != "a") ["a";"b";"c"] work, but it would work with <> ?
nvictor has quit [Read error: 110 (Connection timed out)]
ttamttam has quit ["Leaving."]
nvitto has joined #ocaml
<nvitto> EliasAmaral: you there?
<flux> spicey, == and != are physical equalities, = and <> are structural
<flux> spicey, "a" and "a" may not be the same particular instance of the string, thus "a" != "a"
<EliasAmaral> yes
<spicey> flux, aha, thanks
<nvitto> EliasAmaral: can you help me understand this? :)
<nvitto> there is that new when
<nvitto> and also they are using a list
<nvitto> oh wait, my nickname changed!
nvitto is now known as nvictor
<nvictor> better
<nvictor> EliasAmaral: what is the goal of the when keyword?
<EliasAmaral> to specify a match to a particular value?
<EliasAmaral> nvictor, i am not the ocaml expert here :)
<nvictor> i see
<nvictor> flux: any idea?
<EliasAmaral> nvictor, match x with None -> .. | Some a when a = 1 -> ... | Some a -> ...
<EliasAmaral> then you code has three paths: one for None, other for Some 1, other for Some 2, Some 3, ..
<nvictor> is it matching with None?
<EliasAmaral> i don't have ocaml installed right now to give you a working example, After this operation, 95.8MB of additional disk space will be used. < @_@', hmm
<nvictor> :)
<EliasAmaral> but say let f = function None -> print_endline "none" | Some a when a = 1 -> print_endline "1" | Some a -> print_endline "something else"
<EliasAmaral> then f (None) will print none, f (Some 1) will print 1, f (Some a) will print something else
<nvictor> oohh
<nvictor> i see
<EliasAmaral> this is a standard type: type 'a option = None | Some of 'a
<nvictor> no no i was concerned with the "when" part of the statement
<EliasAmaral> yes
<nvictor> EliasAmaral: what does "(Texp e) :: (Tunr op) :: st" mean :) ?
<EliasAmaral> it's a list concatenation
<nvictor> i see
<EliasAmaral> a :: b means a list that the first element is a, then followed by the elements of the list b
<EliasAmaral> a :: b :: c is a :: (b :: c)
<nvictor> i see
<nvictor> EliasAmaral: can you take a look at the code again? http://paste.pocoo.org/show/157795/
<nvictor> if a in a :: b :: c is the first element
fx___ has joined #ocaml
<nvictor> then in (Texp e1)::(Tbin op)::(Texp e2)::st, (Texp e1) is the first?
<EliasAmaral> hmm
Yoric has joined #ocaml
<EliasAmaral> yes, if the first value of the list pr is Texp <something> then it matches
<EliasAmaral> and return what is after the ->
<nvictor> that's confusing
<EliasAmaral> but if it's something else, or the list have less than 3 members, or the second member is not Tbin something, or if the third member is not Texp something, the match fails
<nvictor> the way it is written it reads as if (Texp e2) would be the first element
<EliasAmaral> and you will have to go to the other match
<nvictor> ohh wait
<EliasAmaral> nope
<nvictor> i see what they mean
<EliasAmaral> :)
<nvictor> the elements are stack as they read input
<EliasAmaral> (Texp e)::(Tunr op)::st when (priority_uop op) >= pr, in pattern matching, means
<EliasAmaral> "if it can be written as (Texp e)::(Tunr op)::st, and if (priority_uop op) >= pr, it matches"
<EliasAmaral> if it matches, it will return (Texp (ExpUnr (op,e)))::st
<EliasAmaral> if it doesn't match, it will continue with the next test
<nvictor> yes i got that much :)
<EliasAmaral> (Texp e1)::(Tbin op)::(Texp e2)::st when (priority_binop op) >= pr
<EliasAmaral> _ always match, it's a wildcard, like * in files
<nvictor> yes
<EliasAmaral> matching against Some _ and Some a is the same thing, but in the latter you can refer the a
Yoric has quit []
jonafan_ has joined #ocaml
jonafan has quit [Read error: 60 (Operation timed out)]
ygrek has joined #ocaml
<nvictor> let l = (p:=cl.current ; lexer cl)
<nvictor> what kind of data type is l ?
<EliasAmaral> nvictor, it depends on the return value of lexer
<mrvn> whatever lexer cl returns
<EliasAmaral> nvictor, it does not depend on the return value of p:=cl.current (that is unit), this code executes p:=cl.current then returns lexer cl
<nvictor> ohh
<nvictor> so it's just two statements on a single line
<EliasAmaral> yes
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
ttamttam has joined #ocaml
ikaros has joined #ocaml
ygrek has quit [Remote closed the connection]
<nvictor> all gnite ll
<nvictor> all
nvictor has quit []
nvictor has joined #ocaml
<nvictor> ok
<nvictor> back :)
<nvictor> what is this doing? match ignore (lexer cl) ; lexer cl
<nvictor> the ignore part
<EliasAmaral> let ignore _ = ()
<EliasAmaral> it's implemented that way
<EliasAmaral> because ocaml uses eager evaluation, it will evaluate lexer cl twice
<EliasAmaral> in the first time it will discard the value (the ignore part)
<nvictor> oh ok ok
<nvictor> thanks :)
<nvictor> see you
nvictor has left #ocaml []
ygrek has joined #ocaml
<flux> that kind of code looks a big pervert to me, though :)
<flux> sprinkling side effects all around :)
<flux> but perhaps it makes the code more succinct
<EliasAmaral> this pattern matching seems error-prone
<EliasAmaral> i don't like matching against a :: b :: c
<EliasAmaral> ok it's at least ugly for me
<flux> what's error-prone about it?
<flux> usually exhaustiveness checks help, but of course not in this case when you just raise an error
ygrek has quit [Remote closed the connection]
<flux> at times it's possible to express the others-condition more accurately, but I suppose not in this case
ygrek has joined #ocaml
<flux> hmm, reduce looks like a function that should call itself, but perhaps not?
<EliasAmaral> usually my matches are the simplest possible ones. if your data can't be matched easily maybe you designed them bad (or you need to convert them)
<EliasAmaral> hmm, yeah, i was to say "my recursive functions are the simplest i can think" but this function isn't recursive
<EliasAmaral> maybe that's because he is just learning :)
<EliasAmaral> or, no, this code is from someone else, he was not understanding it
ikaros has quit ["Leave the magic to Houdini"]
zhijie1 has joined #ocaml
zhijie has quit [Read error: 104 (Connection reset by peer)]
zhijie has joined #ocaml
zhijie1 has quit [Read error: 104 (Connection reset by peer)]
flux has quit ["leaving"]
flux has joined #ocaml
flux has quit ["ja taas"]
flux has joined #ocaml
nvictor has joined #ocaml
<nvictor> hello people :)
<nvictor> me again
<nvictor> how ocaml differenciate between a list and an array?
<flux> what do you mean differentiate?
<nvictor> i mean
<nvictor> is there a difference?
<EliasAmaral> they are different data types
<flux> there is a big difference
<nvictor> how come?
<flux> arrays are not lists :)
<flux> nor vice versa
<nvictor> ok
<nvictor> so what's the difference?
<nvictor> or some of them?
<EliasAmaral> Hmm.. arrays are mutable.. must be created with Array.create and the contents may change
<EliasAmaral> the contents of a list never change (you need to build another list)
<nvictor> ooohhh
<nvictor> so we python programmers have been doing it wrong :)
<EliasAmaral> hmmm.. no, efficiency is no concern for python programmers
<flux> well, there can be different lists. the fundamental difference between lists and arrays (in any language) is that you can insert elements into a list at any location where you have acccess and it's constant time
<flux> of course, you cannot insert anything to ocaml lists as they are immutable ;)
<EliasAmaral> you can't partition a array in head :: tail (in a match or when building it etc) because building sub-arrays or joining a tail array with a head is not a cheap operation. to do so you need create a new array with Array.create (or just use lists)
<flux> but you can create new lists in constant time that have their remaining elements from another lists, and that happens in constant time
<EliasAmaral> and you access an array element with array.(index), this is not possible with lists because accessing a element that is not the first is not cheap (hmm, actually you can use List.nth)
<nvictor> EliasAmaral, flux: i see
<EliasAmaral> arrays are used mainly when you know in advance the size of your data
<flux> nvictor, lists are a fundamental data structure in functional programming, due to their properties
<nvictor> so ocaml does not truly abstract the implementation from the user :D
<nvictor> essentially arrays are lists
<flux> well, code written for lists but used with arrays would likely suffer extreme performance problems
<nvictor> but different implementations
<flux> and vice versa
<EliasAmaral> it does, but it will not if the semantics can't be built in a efficient way
<flux> essentially both are representations of sequences
<EliasAmaral> because some ocaml apps must run fast
<nvictor> yes
<nvictor> ocaml is compiled
<EliasAmaral> it's also interpreted
<nvictor> it is?
<nvictor> that's cool
<EliasAmaral> install ocaml. there is a toplevel interpreter just like python (the ocaml command)
<nvictor> ok another one :)
<nvictor> int -> 'a
jonafan has joined #ocaml
<EliasAmaral> nvictor, there is another reason for lists not being arrays: they have fundamentally different semantics. i think that only in academia you will hear of the concepts of "linked list" and "sequential list", but by reading wikipedia you might understand
<nvictor> i have heard of linked list yes
<nvictor> but not sequential
<EliasAmaral> sequential would be an array
<nvictor> what is the purpose of ' in 'a ?
<EliasAmaral> 'a is "alpha"
<EliasAmaral> a type, hmm.. variable
<nvictor> val runerr : int -> 'a = <fun>
<EliasAmaral> 'a stands for "any type"
<EliasAmaral> int -> 'a usually means that this function returns "anything" because, in fact, it will never return
<EliasAmaral> (or maybe it returns a marshalled value, i am not sure)
<nvictor> it's an exception so i think i understand
<nvictor> it will never return
<nvictor> thanks EliasAmaral, flux
<EliasAmaral> (it's not an exception in ocaml sense. exceptions are not values. it's a function)
<nvictor> :) ok
<flux> surely exceptions are values? let a = Failure "aeae"
<EliasAmaral> ok, you are right, sorry
<EliasAmaral> i was following a discussion here.. ah
<EliasAmaral> they were saying that a _exception type_ wasn't really a type
<flux> yeah, it's a special dynamic type/unitype in ocaml
<nvictor> ok
<nvictor> so the "with" statement that follows a "try" statement is the one that catches exception right?
<nvictor> please look at line 11
<nvictor> i'm not sure to understand :)
<EliasAmaral> yes..
<nvictor> when the comparison fails
<EliasAmaral> it's like a match, but for exceptions
<nvictor> an exception is raised, right?
<nvictor> line 8
<nvictor> ooh
<nvictor> nvm :)
<nvictor> i see what's going on there
<nvictor> the requested number can't be less than 0
<flux> I personally would just write an explicit iteration with recursion there instead of using exceptions for returning a value, but perhaps the author is more at home with loops
<EliasAmaral> i really think this style is ugly. he is trying maybe to write a break?
<EliasAmaral> i don't know if there is a break in ocaml, but i iterate over arrays with a recursive function and this is just fine
<EliasAmaral> i personally don't like arrays too much either
<nvictor> :)
<EliasAmaral> nvictor, btw this a copy and paste from the ocaml toplevel. those # are prompts and ;; is the way you terminate statements on toplevel
<olegfink> well, exceptions seem like an option if you iterate with something like iter/fold_*
<EliasAmaral> I never did this, but, yes
jonafan_ has quit [Read error: 110 (Connection timed out)]
<nvictor> EliasAmaral: yes i can see that
<nvictor> has anyone done a little bit of python too?
<nvictor> no? :) i was wondering what would be the closest to ocaml pattern matchings
<nvictor> i think i'm starting to like it :)
_zack has joined #ocaml
<nvictor> one question
<nvictor> in tprog.(i) <- { tprog.(i) with cmd = If (c,index) }
<nvictor> here they use { } instead of ( )
<nvictor> why?
<EliasAmaral> it's a record
<olegfink> well python seems to have them at least for lists (or whatever)
<EliasAmaral> { a with b } is the record a with the change b
<EliasAmaral> records are like c structs
<nvictor> oh i see
tmaedaZ0 is now known as tmaedaZ
<EliasAmaral> a.b is a reference to the field b in record a, let a = { b = 1 } would create a record where a.b equals 1
<olegfink> hm, maybe it'd be nicer to declare cmd as mutable and say [tprog.(i).cmd <- If (c,index)]?
<EliasAmaral> good point :) but he is reading code from someone else olegfink
<EliasAmaral> why []?
_zack has quit [Client Quit]
<nvictor> olegfink: i saw that before too
<olegfink> metasyntactic notation, ocaml is somewhat easy to mix with plain english
<EliasAmaral> but then it looks like a list
<olegfink> there are just so many ascii symbols.
<EliasAmaral> but this is a list with.. unit, i think
Associat0r has joined #ocaml
<EliasAmaral> anyway i really love this functional approach to structs and to objects too
<nvictor> ok thanks a lot for your support :D
<nvictor> i really appreciate
<nvictor> see you all
nvictor has left #ocaml []
_zack has joined #ocaml
nvictor has joined #ocaml
<nvictor> me again :)
Amorphous has quit [Read error: 60 (Operation timed out)]
<nvictor> ExpBin of expression * bin_op * expression
<EliasAmaral> ExpBin(a, b, c)
<nvictor> ok i see :)
<EliasAmaral> (you could just be here in the channel, no need to leave)
<nvictor> :)
<nvictor> EliasAmaral: if i understand correctly
<nvictor> expression is using some kind of polymorphism ?
Pimm has joined #ocaml
<nvictor> because it allows many constructors?
<EliasAmaral> it's a recursive type
<nvictor> right?
<EliasAmaral> no, it's not polymorphic i... think
<nvictor> a recursive type
<nvictor> hmm
<nvictor> EliasAmaral: how could it be done in another language?
<nvictor> (like python :) )
<EliasAmaral> it is a recursive type and indeed you can have a circular value with it, like a = ExpBin(a, .., a)
<EliasAmaral> dunno
<EliasAmaral> if you have a bin_op you could create a circular value with let make_it b = let rec value = ExpBin(value, b, value) in value
<EliasAmaral> nvictor, a polymorphic type is a type with variables ('a, 'b..)
<nvictor> oh i see
Amorphous has joined #ocaml
munga has joined #ocaml
Alpounet has quit ["``Do what you think you can't do.'' -- E. Roosevelt"]
_andre has joined #ocaml
zhijie has quit ["Leaving."]
nvictor has quit [Read error: 110 (Connection timed out)]
EliasAmaral has quit [Read error: 110 (Connection timed out)]
munga has quit [Read error: 113 (No route to host)]
EliasAmaral has joined #ocaml
tty56 has joined #ocaml
EliasAmaral has quit ["Leaving"]
EliasAmaral has joined #ocaml
EliasAmaral has quit [Client Quit]
EliasAmaral has joined #ocaml
zhijie has joined #ocaml
tty56 has quit []
wm_eddie has left #ocaml []
ikaros has joined #ocaml
ttamttam has quit ["Leaving."]
ttamttam has joined #ocaml
ttamttam has quit [Client Quit]
ttamttam has joined #ocaml
ttamttam has quit [Client Quit]
aklt has quit ["leaving"]
ViciousPlant has joined #ocaml
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
ViciousPlant has quit []
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
tmaedaZ is now known as tmaedaZ0
ttamttam has joined #ocaml
tmaedaZ0 is now known as tmaedaZ
tmaedaZ is now known as tmaedaZ0
_zack has quit ["Leaving."]
_unK has joined #ocaml
spicey has quit ["Leaving"]
lutter has quit ["Leaving."]
joewilliams has joined #ocaml
palomer has joined #ocaml
<palomer> we have liftoff!
<orbitz> where are we going?
<mrvn> Are we there yet? Are we there yet? Are we there yet?
_zack has joined #ocaml
<palomer> :P
tmaedaZ0 is now known as tmaedaZ
ikaros has quit ["Leave the magic to Houdini"]
ofaurax has joined #ocaml
tmaedaZ is now known as tmaedaZ0
fx___ has quit [Read error: 110 (Connection timed out)]
Submarine has joined #ocaml
lutter has joined #ocaml
srcerer has quit [Remote closed the connection]
munga has joined #ocaml
srcerer has joined #ocaml
srcerer has quit [Client Quit]
srcerer has joined #ocaml
ikaros has joined #ocaml
hyperbor1ean has quit ["leaving"]
hyperboreean has joined #ocaml
Deformative is now known as undesktop
undesktop is now known as Deformative
srcerer has quit [Client Quit]
srcerer has joined #ocaml
thelema_ has quit [Remote closed the connection]
thelema has joined #ocaml
srcerer has quit [Client Quit]
srcerer has joined #ocaml
ygrek has quit ["Leaving"]
ygrek has joined #ocaml
EliasAmaral has quit [Read error: 110 (Connection timed out)]
_zack has quit ["Leaving."]
_andre has quit ["leaving"]
_zack has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
sgnb has quit [farmer.freenode.net irc.freenode.net]
sgnb has joined #ocaml
pad has joined #ocaml
rjack has joined #ocaml
rjack has quit [Client Quit]
mehdid_ has joined #ocaml
mehdid_ is now known as darkwise
_zack has quit ["Leaving."]
<darkwise> wc
darkwise has left #ocaml []
lutter has quit ["Leaving."]
<flux> go ahead, you are dismissed.
munga has quit [Read error: 113 (No route to host)]
ttamttam has quit ["Leaving."]
rjack has joined #ocaml
rjack has quit [Client Quit]
Pimm has quit [Read error: 110 (Connection timed out)]
lutter has joined #ocaml
ulfdoz has joined #ocaml
<palomer> seriously, I don't get why classes and types can't be mutually recursive
<palomer> forces me to use polymorphic variants
<palomer> classes + polymorphic variants = 1000 line long error messages
<palomer> http://pastebin.org/66495 <-- I'm trying to generate a record pattern
<palomer> anyone have a clue?
<palomer> the camlp4 reference isn't very helpful
<palomer> http://pastebin.org/66498 <--simpler example
<palomer> (4 lines!)
<palomer> actually, those are two different porblems.hrmph
<palomer> where's flux when you need'em
slash_ has joined #ocaml
<palomer> how do I do <:patt< foo = bar >> ?
ikaros_ has joined #ocaml
BiDOrD has joined #ocaml
<palomer> well, figured out
<palomer> pattern quotations suck:O
<palomer> actually, I take that back
ikaros has quit [Read error: 110 (Connection timed out)]
Alpounet has joined #ocaml
BiDOrD has quit [Remote closed the connection]
lanaer_ has joined #ocaml
Pepe__ has joined #ocaml
__mattam__ has joined #ocaml
r0bby_ has joined #ocaml
thieusoa1 has joined #ocaml
WuJiang_ has joined #ocaml
acatout_ has joined #ocaml
hugin_ has joined #ocaml
patronus has quit [farmer.freenode.net irc.freenode.net]
bzzbzz has quit [farmer.freenode.net irc.freenode.net]
r0bby has quit [farmer.freenode.net irc.freenode.net]
gildor has quit [farmer.freenode.net irc.freenode.net]
Pepe_ has quit [farmer.freenode.net irc.freenode.net]
my007ms has quit [farmer.freenode.net irc.freenode.net]
jimmyb2187 has quit [farmer.freenode.net irc.freenode.net]
infoe_ has quit [farmer.freenode.net irc.freenode.net]
lanaer has quit [farmer.freenode.net irc.freenode.net]
mattam has quit [farmer.freenode.net irc.freenode.net]
mehdid has quit [farmer.freenode.net irc.freenode.net]
WuJiang has quit [farmer.freenode.net irc.freenode.net]
safire has quit [farmer.freenode.net irc.freenode.net]
hugin has quit [farmer.freenode.net irc.freenode.net]
Boney has quit [farmer.freenode.net irc.freenode.net]
thieusoai has quit [farmer.freenode.net irc.freenode.net]
Camarade_Tux has quit [farmer.freenode.net irc.freenode.net]
acatout has quit [farmer.freenode.net irc.freenode.net]
TaXules has quit [farmer.freenode.net irc.freenode.net]
deavid has quit [farmer.freenode.net irc.freenode.net]
olegfink has quit [farmer.freenode.net irc.freenode.net]
TaXules_ has joined #ocaml
safire_ has joined #ocaml
mehdid has joined #ocaml
bzzbzz has joined #ocaml
gildor has joined #ocaml
patronus has joined #ocaml
deavid has joined #ocaml
olegfink has joined #ocaml
jimmyb2187 has joined #ocaml
Boney has joined #ocaml
Camarade_Tux has joined #ocaml
jlouis has quit ["leaving"]
jlouis has joined #ocaml
ulfdoz has quit [Read error: 110 (Connection timed out)]
pad has quit [Remote closed the connection]
slash_ has quit [Client Quit]
ygrek has quit [Remote closed the connection]
acatout_ has quit [farmer.freenode.net irc.freenode.net]
acatout_ has joined #ocaml
acatout_ has quit [farmer.freenode.net irc.freenode.net]
acatout_ has joined #ocaml
acatout_ has quit [farmer.freenode.net irc.freenode.net]
BiDOrD has joined #ocaml
acatout_ has joined #ocaml
acatout_ has quit [farmer.freenode.net irc.freenode.net]
acatout_ has joined #ocaml
pad has joined #ocaml
lpjhjdh has joined #ocaml
my007ms has joined #ocaml
lpjhjdh has left #ocaml []
Pimm has joined #ocaml