<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
<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
<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"
<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
<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?
<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)