flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 4.01.0 http://bit.ly/1851A3R | http://www.ocaml.org | Public logs at http://tunes.org/~nef/logs/ocaml/
ollehar has quit [Ping timeout: 240 seconds]
ygrek has joined #ocaml
talzeus_ has joined #ocaml
mcclurmc has joined #ocaml
mcclurmc has quit [Remote host closed the connection]
jpdeplaix has quit [Ping timeout: 268 seconds]
jpdeplaix has joined #ocaml
csakatoku has quit [Remote host closed the connection]
ygrek has quit [Ping timeout: 268 seconds]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 252 seconds]
madroach has quit [Ping timeout: 264 seconds]
shinnya has quit [Ping timeout: 240 seconds]
madroach has joined #ocaml
yurivish has quit [Quit: Leaving...]
davidDenver has joined #ocaml
ygrek has joined #ocaml
<davidDenver> quick question. What does the 'in' mean when I see it at the end of a line like: "let dbh = PGOCaml.connect () in"
<davidDenver> I see it all over the place.
<Drup> it's just binding
<davidDenver> hi, me again
<Drup> "let foo = bar in stuff"
<davidDenver> that doesn't tell me when I should use it.
<davidDenver> I know what a database binding is.
<davidDenver> but I see the 'in' all over the place
<Drup> no, language binding :)
<Drup> not database
<davidDenver> ok so now I need to go look up language binding?
<Drup> I mean, it's just a variable declaration, nothing more
<davidDenver> as in 'int'?
<davidDenver> integer
<Drup> sort of, except you don't specify the type, and the scope of the variable is only for "stuff"
<davidDenver> so I could use: let dbh = PGOCaml.connect () out ...?
<davidDenver> or let dbh = PGOCaml.connect () xyz?
<Drup> ok, so there is two type of "let" in ocaml, it's a bit unfortunate but those are not exactly the same
<Drup> the first one is the one you find at the "root of a file, it's a global declaration
<Drup> and there is no "in" after
<Drup> and there is "let foo = bla in stuff", which is a local variable declaration, only for stuff
<Drup> and it's an expression, not a statement
<Drup> (and in this case, you can't use the let without the in
<davidDenver> ok and so if you don't have a 'stuff' the in just sits there at the end.
<Drup> there is always a stuff :p
<davidDenver> let dbh = PGOCaml.connect () in
<davidDenver> no stuff there
<Drup> it's because you quoted only a part of the expression
<davidDenver> let () =
<davidDenver> let dbh = PGOCaml.connect () in
<davidDenver> let insert name salary email =
<davidDenver> PGSQL(dbh) "insert into employees (name, salary, email) values ($name, $salary, $?email)"
<davidDenver> in
<davidDenver> insert "Ann" 10_000_l None;
<Drup> then "let insert .... in insert "Ann" 10_000_l None" is the stuff
<davidDenver> gives you the real syntax in a proper layout.
<Drup> the thing that probably confuse you, especially compared to C-like langauges, is that "let <id> = <expr> in <expr>" is itself an <expr>
<davidDenver> ok, I see that.
<Drup> (and btw, caml is completely whitespace insensitive, \n included)
<davidDenver> so I would find this in a section on expressions?
<davidDenver> on that ocaml pdf you sent me the link to?
<davidDenver> why no brackets so it it obvious?
<Drup> no idea, it's a very long time I didn't look that up
<davidDenver> like: let x = {y} in {z}
<Drup> no bracket
<Drup> (they serve other purposes)
<davidDenver> so where does the 'in' know when to stop?
<Drup> but you can use paranthesis or "begin <expr> end"
<Drup> it's the same, and both are expressions too
<Drup> davidDenver: a clever grammar ? :)
<davidDenver> like: let x = begin y end in begin z end
<davidDenver> seriously, how do I terminate the last exp?
<davidDenver> like in C with a ;
<Drup> you don't need to
<davidDenver> well then how does it know when to stop compiling the expression?
<davidDenver> it just keeps reading in statement after statement
<Drup> it's quite easy to parse actually
<davidDenver> well I'm going to go look up expressions
<davidDenver> thanks.
davidDenver has quit [Quit: ChatZilla 0.9.90.1 [Iceweasel 3.5.16/20121207230533]]
chrisdotcode has quit [Remote host closed the connection]
breakds has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest34591
csakatoku has joined #ocaml
Guest34591 has quit [Remote host closed the connection]
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 252 seconds]
davidDenver has joined #ocaml
<davidDenver> does anyone have any idea how to use top level to grab a mac address?
himh has joined #ocaml
<thizanne> davidDenver: the mac address of who ?
<davidDenver> of the computer that toplevel is running on
<thizanne> if you want your machine's one, ip a s should do it
<thizanne> on windows, ipconfig /all
<davidDenver> I know that, I mean in ocaml, compilable code
<davidDenver> like let mac = 'get mac address'
<thizanne> oh
<thizanne> no idea
nikki93 has joined #ocaml
<davidDenver> I need to be able to grab the mac address of the computer the code is running on, hash it and send it to a server.
<davidDenver> over the net that is.
<himh> Hey has anyone noticed that utop is very slow on osx when running the first few commands? osx snow leopard
<davidDenver> I'm looking at ocamlnet for the ip stuff
<davidDenver> don't use it
<davidDenver> have you macports installed?
<davidDenver> himh?
<himh> I installed it with opam
<himh> and I installed opam and ocaml with homebrew
<davidDenver> oracle? privilege manager?
<davidDenver> I'm not familiar with the ocaml package manager
<davidDenver> is utop like htop?
<himh> It's an odd behavior actually. If I start utop and just let sq x = x * x;; the delay is 2 to 3 seconds.
<davidDenver> or top?
<davidDenver> you mean toplevel?
<himh> davidDenver: It's a modified top level for ocaml, sort of like ipython
<Drup> davidDenver: it's a customize and very nice version of the toplevel of ocaml
<davidDenver> I use ledit ocaml
<Drup> utop's autocompletion is really nice
<davidDenver> is this a gui?
<Drup> curse-like "gui"
<himh> Drup: yea it's impressive
<davidDenver> I'll go look at it
<davidDenver> there's no wiki page on utop
<himh> davidDenver: There's not a lot of info on it anywhere, but it's discussed in the preface to Real World Ocaml
<davidDenver> I'm reading the page on opam right now
<Drup> davidDenver: the wiki is in a middle of reworking, so it may be not very uptodate/incomplete
<davidDenver> I can't use opam, no package for it in Debian squeeze
<Drup> you can still compile it.
<davidDenver> build errors all over the place
<davidDenver> because the ocaml package in squeeze is 3.11.2-2 instead of 3.12
himh has quit [Quit: ...]
<Drup> 3.11 X__x
<Drup> grap a newer version of the compiler, 3.11 is really old.
mcclurmc has joined #ocaml
<davidDenver> it's the package in squeeze. I never run anything that doesn't come with the apt-get
csakatoku has joined #ocaml
<davidDenver> I certainly know how to compile, but from a stability viewpoint, I don't need the hassles, this is a production box
<davidDenver> with my website on it, so I don't need any crashes.
<Drup> as you want, but be aware you are running with a 5 year old version of ocaml, that's all.
<davidDenver> that's pretty old.
<Drup> blame debian.
<davidDenver> yeah really
<davidDenver> why would they do that? probably because it's not very popular
<davidDenver> they are very conservative about their packages
<davidDenver> which is why updates don't crash the box.
<Drup> Don't ask me or I'm going to troll debian's packager quite heavily.
<Drup> packagers*
<davidDenver> where in the world are you?
<Drup> right now, sweden
<davidDenver> solna
<davidDenver> been there
<davidDenver> drup as in Drupal?
<Drup> drup as in "splash your head on the keyboard, and extract a pronounceable and short name".
<Drup> :D
<davidDenver> that's interesting, it could also be Dr. Up.
<davidDenver> ok back to work, ciao
davidDenver has quit [Quit: ChatZilla 0.9.90.1 [Iceweasel 3.5.16/20121207230533]]
platypine has quit [Ping timeout: 240 seconds]
cesar_ has joined #ocaml
cesar_ is now known as Guest72168
breakds has quit [Remote host closed the connection]
chrisdotcode has joined #ocaml
Guest72168 has quit [Remote host closed the connection]
mcclurmc has quit [Remote host closed the connection]
<maurer> Hey, do you know how to give ocamlopt another directory to search for C libraries when linking?
<maurer> -L does not seem to do the trick
<maurer> Oh, nvm
<maurer> Looks like I'm supposed to do -L into the -ccopt
<maurer> Now I need to figure out how to do the quoting to convince ocamlbuild to pass that in
salmander has joined #ocaml
ygrek has quit [Ping timeout: 244 seconds]
cesar_ has joined #ocaml
cesar_ is now known as Guest15959
wwilly has quit [Remote host closed the connection]
PM has quit [Ping timeout: 245 seconds]
gour has joined #ocaml
PM` has joined #ocaml
chrisdotcode is now known as chrisblake
ulfdoz has joined #ocaml
Guest15959 has quit [Remote host closed the connection]
ulfdoz has quit [Ping timeout: 268 seconds]
troydm has quit [Ping timeout: 264 seconds]
troydm has joined #ocaml
ollehar has joined #ocaml
contempt has quit [Ping timeout: 268 seconds]
Icarus_Wings has quit []
ygrek has joined #ocaml
<adrien> maurer: actually, -L into -cclib
<adrien> maurer: if you happen to use oasis, there's pkg-config support which is the best way to deal with C libs
<strobegen> good news in Caml-list 'World OCaml is finished' . - Oh, I got message from O'Reilly today about this book: …order has been cancelled.., doesn't ship to your country at this time :( But epub version still also good for reading :)
<strobegen>
ggole has joined #ocaml
derek_c has joined #ocaml
ttamttam has joined #ocaml
<maurer> adrien: I don't suppose you happen to know how to deal with "Failure: Pathname.normalize_list: .. is forbidden here.
<maurer> in ocamlbuild?
kizzx2 has joined #ocaml
<adrien> I don't know ocamlbuild well (but there are other here who do :P )
Neros has quit [Read error: Operation timed out]
Drup has quit [Ping timeout: 244 seconds]
jyeo has quit [Quit: Connection closed for inactivity]
ggole has quit [Read error: Connection timed out]
ggole has joined #ocaml
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
jonludlam has quit [Remote host closed the connection]
yacks has quit [Quit: Leaving]
nikki93 has quit [Remote host closed the connection]
Drup has joined #ocaml
robink has quit [Quit: No Ping reply in 180 seconds.]
robink has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest7745
Guest7745 has quit [Ping timeout: 268 seconds]
demonimin has quit [Quit: No Ping reply in 180 seconds.]
demonimin has joined #ocaml
contempt has joined #ocaml
ollehar has quit [Ping timeout: 240 seconds]
kizzx2 has quit [Read error: Connection reset by peer]
contempt has quit [Ping timeout: 252 seconds]
mika1 has joined #ocaml
kizzx2 has joined #ocaml
Simn has joined #ocaml
contempt has joined #ocaml
jonludlam has joined #ocaml
djcoin has joined #ocaml
darkf_ has joined #ocaml
jonludlam has quit [Ping timeout: 280 seconds]
darkf has quit [Disconnected by services]
darkf_ is now known as darkf
nikki93 has joined #ocaml
amiller has quit [Quit: ZNC - http://znc.sourceforge.net]
robink has quit [Quit: No Ping reply in 180 seconds.]
ski has quit [Ping timeout: 240 seconds]
robink has joined #ocaml
robink has quit [Changing host]
robink has joined #ocaml
ski has joined #ocaml
amiller_ has joined #ocaml
nikki93 has quit [Ping timeout: 260 seconds]
jonludlam has joined #ocaml
eikke has joined #ocaml
csakatoku has quit [Write error: Broken pipe]
<gasche> adrien: how is the pkg-config support implemented in OASIS?
csakatoku has joined #ocaml
<gasche> it would be nice to embed some support in ocamlbuild default rules if possible
<companion_cube> \o
Picolino has joined #ocaml
Picolino is now known as julien_t
julien_t is now known as Picolino
csakatoku has quit [Ping timeout: 240 seconds]
csakatoku has joined #ocaml
derek_c has quit [Quit: Lost terminal]
<adrien_oww> gasche: not sure; haven't checked recently and to be completely honest, I can't remember whether it's in oasis or is a common addition
BitPuffin has joined #ocaml
<adrien_oww> but more than 2 years ago, I only had minor issues making the one from Archimedes work on windows
thomasga has joined #ocaml
zpe has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest36294
Guest36294 has quit [Ping timeout: 244 seconds]
robink has quit [Quit: No Ping reply in 180 seconds.]
BitPuffin has quit [Ping timeout: 240 seconds]
contempt has quit [Ping timeout: 272 seconds]
contempt has joined #ocaml
_andre has joined #ocaml
djcoin has quit [Quit: WeeChat 0.4.1]
<gasche> adrien_oww: pfft provides tree-maps of code size
<gasche> and some tool by Fabrice and Thomas had ring-maps of live memory usage
<gasche> I'm not aware of any work on binary size, is that specifically what you care about?
<kerneis> bytecode or native binary?
<adrien_oww> pfft does it? oh, maybe, it's been some time I've last looked at it
<adrien_oww> I'm interested in size of native code
<adrien_oww> (on windows :D )
<gasche> (I'm not sure about the number of 'f' :-')
eikke has quit [Ping timeout: 240 seconds]
<companion_cube> pretty fast fourier transform?
<adrien_oww> (I started with 3)
<adrien_oww> companion_cube: pfffft
<adrien_oww> follow!
<companion_cube> pretty fast forward fourier transform
eikke has joined #ocaml
<adrien_oww> ah, pfff
<gasche> companion_cube: the program analysis framework that Yoann Palodieau (iirc) implemented at Facebook
<gasche> (away)
<adrien_oww> gasche: ah, pfff's metric is LOC, not binary size
<adrien_oww> which is what I need
<adrien_oww> and yes, Yoann
<adrien_oww> Padioleau
contempt has quit [Ping timeout: 272 seconds]
contempt has joined #ocaml
contempt has quit [Ping timeout: 246 seconds]
contempt has joined #ocaml
ygrek has quit [Ping timeout: 272 seconds]
contempt has quit [Ping timeout: 246 seconds]
contempt has joined #ocaml
testcocoon has quit [Quit: Coyote finally caught me]
contempt has quit [Ping timeout: 252 seconds]
testcocoon has joined #ocaml
contempt has joined #ocaml
platypine has joined #ocaml
Yoric has joined #ocaml
platypine has quit [Ping timeout: 245 seconds]
contempt has quit [Ping timeout: 245 seconds]
contempt has joined #ocaml
Kakadu has joined #ocaml
wolfnn has joined #ocaml
contempt has quit [Ping timeout: 245 seconds]
ygrek has joined #ocaml
sepp2k has joined #ocaml
contempt has joined #ocaml
Drup has quit [Ping timeout: 260 seconds]
contempt has quit [Ping timeout: 244 seconds]
contempt has joined #ocaml
talzeus_ has quit [Remote host closed the connection]
contempt has quit [Ping timeout: 244 seconds]
contempt has joined #ocaml
Kakadu has quit [Ping timeout: 250 seconds]
cesar_ has joined #ocaml
cesar_ is now known as Guest47622
Drup has joined #ocaml
Guest47622 has quit [Ping timeout: 264 seconds]
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 252 seconds]
BitPuffin has joined #ocaml
csakatoku has joined #ocaml
rand000 has joined #ocaml
Neros has joined #ocaml
Neros has quit [Ping timeout: 245 seconds]
pedagand has quit [Remote host closed the connection]
darkf has quit [Quit: Leaving]
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 240 seconds]
Neros has joined #ocaml
thomasga has quit [Quit: Leaving.]
Neros has quit [Ping timeout: 245 seconds]
thomasga has joined #ocaml
dsheets has quit [Quit: Leaving]
Drup1 has joined #ocaml
Drup has quit [Read error: Connection reset by peer]
Drup1 is now known as Drup
t0yv0 has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
yezariaely has joined #ocaml
talzeus_ has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest63128
yacks has joined #ocaml
Guest63128 has quit [Ping timeout: 240 seconds]
talzeus_ has quit [Remote host closed the connection]
talzeus_ has joined #ocaml
mcclurmc has joined #ocaml
tulloch has joined #ocaml
tulloch has quit [Client Quit]
tulloch has joined #ocaml
morolin has quit [Ping timeout: 248 seconds]
Neros has joined #ocaml
mika1 has quit [Quit: Leaving.]
dsheets has joined #ocaml
thomasga has quit [Quit: Leaving.]
morolin has joined #ocaml
Xenasis has joined #ocaml
mcclurmc has quit [Remote host closed the connection]
ok259 has joined #ocaml
csakatoku has joined #ocaml
mcclurmc has joined #ocaml
Neros has quit [Ping timeout: 245 seconds]
BitPuffin has quit [Quit: WeeChat 0.4.2]
BitPuffin has joined #ocaml
shinnya has joined #ocaml
mika1 has joined #ocaml
thomasga has joined #ocaml
Drup has quit [Ping timeout: 246 seconds]
NoNNaN has quit [Ping timeout: 240 seconds]
ygrek has joined #ocaml
saml has quit [Quit: Leaving]
<kerneis> “You all probably wonder what "the" 42,000th lambda-term is.”
* kerneis loves it
saml has joined #ocaml
mcclurmc has quit [Remote host closed the connection]
NoNNaN has joined #ocaml
nikki93 has joined #ocaml
<kerneis> it obviously needs a sexplib-like ppx to generate enumerations automatically for complex types (records, etc.)
nikki93 has quit [Ping timeout: 246 seconds]
csakatoku has quit [Ping timeout: 245 seconds]
csakatok_ has joined #ocaml
Yoric has quit [Ping timeout: 260 seconds]
BitPuffin has quit [Ping timeout: 252 seconds]
tobiasBora has joined #ocaml
<adrien_oww> ocaml-ty!
<jpdeplaix> \o/
<jpdeplaix> cc hnrgrgr :)
Yoric has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest20847
mcclurmc has joined #ocaml
tulloch has quit [Quit: leaving]
tulloch has joined #ocaml
tulloch has quit [Client Quit]
csakatok_ has quit [Remote host closed the connection]
tulloch has joined #ocaml
csakatoku has joined #ocaml
Guest20847 has quit [Ping timeout: 246 seconds]
csakatok_ has joined #ocaml
csakatoku has quit [Read error: No route to host]
<Xenasis> Was reading up on OCaml's lazy module -
<Xenasis> val from_fun : (unit -> 'a) -> 'a t
<Xenasis> from_fun f is the same as lazy (f ()) but slightly more efficient.
<Xenasis> Since 4.00.0
<Xenasis> Why is this not used for "lazy", then?
<Xenasis> It seems odd to keep a slower version as the one that's less awkward to use
<kerneis> Xenasis: "from_fun f" is a fast alternative to "lazy (f ())" does not mean that lazy can be implemented in terms of from_fun in general
<kerneis> how do you implement "lazy 3" with from_fun?
<kerneis> it's just a shortcut to avoid creating a closure which will immediatly evaluate "f()"
<Xenasis> Right, but wouldn't it be smart for the compiler to do anything with a function in it with the from_fun method?
<asmanur> kerneis: if the compiler knows about eta reduction then it should be equivalent no?
mcclurmc has quit [Remote host closed the connection]
<kerneis> my understanding (I have not checked how it behaves) is the following:
csakatok_ has quit [Remote host closed the connection]
<kerneis> lazy XXX creates fun () -> XXX, and wraps it (with memoization, etc.)
<kerneis> so lazy f () creates (fun () -> f ())
csakatoku has joined #ocaml
csakatoku has quit [Read error: Connection reset by peer]
<kerneis> indeed, eta-reduction would simplify it to f, but there is probably some tricks which make it hard
<kerneis> like the stage where lazy is expanded, the stage where eta-reduction is considered, etc.
thomasga has quit [Quit: Leaving.]
mcclurmc has joined #ocaml
gour has quit [Disconnected by services]
gour_ has joined #ocaml
t0yv0 has quit [Ping timeout: 250 seconds]
Yoric has quit [Ping timeout: 264 seconds]
shinnya has quit [Ping timeout: 252 seconds]
thomasga has joined #ocaml
PM` is now known as PM
mika1 has quit [Quit: Leaving.]
talzeus_ has quit [Read error: Connection reset by peer]
Neros has joined #ocaml
thomasga has quit [Quit: Leaving.]
rand000 has quit [Ping timeout: 246 seconds]
rand000 has joined #ocaml
cesar_ has joined #ocaml
cesar_ is now known as Guest13582
amiller_ is now known as amiller
amiller has quit [Changing host]
amiller has joined #ocaml
smondet has quit [Quit: leaving]
NoNNaN has quit [Remote host closed the connection]
jonludlam has quit [Remote host closed the connection]
osa1 has quit [Ping timeout: 260 seconds]
ttamttam has quit [Quit: ttamttam]
robink has joined #ocaml
thomasga has joined #ocaml
<kerneis> gasche: I wonder to what extent your library for generating random data structures could be implemented in terms of exenum
<kerneis> it looks similar
<kerneis> (with a "pay" function for recursivity)
<kerneis> life's too short to investigate though
mcclurmc has quit [Remote host closed the connection]
morolin has quit [Ping timeout: 245 seconds]
sepp2k has quit [Quit: Konversation terminated!]
jonludlam has joined #ocaml
technomancy has joined #ocaml
<technomancy> it looks like Core defines Sys.file_exists as something that doesn't return a boolean. How can I get at the original definition if I've opened Core.Std?
<companion_cube> does it return a Deferred.t?
<technomancy> no, it's [ `No | `Unknown | `Yes ]
<adrien> wtf
<technomancy> =\
morolin has joined #ocaml
<adrien> 'module OriginalSys = Sys' before opening?
<adrien> or maybe there's a way to access the original modules from inside Core too
<ggole> Not True | False | FileNotFound?
<technomancy> aha; I was trying let instead of module
<technomancy> thanks adrien
<adrien> let is for local definitions, not toplevel ones
<adrien> (for modules that is)
smondet has joined #ocaml
<technomancy> yeah, I'm still a bit fuzzy on the whole constructors not being first-class thing
osa1_ has joined #ocaml
<ggole> Well, modules aren't constructors
<ggole> They look similar lexically but they are in another namespace
<technomancy> ah right
<technomancy> I'm trying to list issues using the ocaml-github library, but the highlighted function here never runs: http://p.hagelb.org/edgestow.ml.html
<technomancy> I feel like it could be a library-specific issue, or it could just be me not understanding monads?
dsheets has quit [Ping timeout: 240 seconds]
<technomancy> ah, the first monadic bind is missing "run"
w0rm_x has joined #ocaml
Guest13582 has quit [Remote host closed the connection]
nikki93 has joined #ocaml
Drup has joined #ocaml
jonludlam has quit [Remote host closed the connection]
<dramas> am i not able to chain ternary in ocaml?
<dramas> such as um
<dramas> condition ? othercondition ? result : result2
<technomancy> so adding the run makes the request happen, but the callback still never fires
<kerneis> dramas: there is no ternary operator in ocaml
<asmanur> there is if/then/else instead
<kerneis> and your example is unbalanced
zpe has quit [Remote host closed the connection]
<kerneis> condition ? (othercondition ? result : result2) : result3
zpe has joined #ocaml
<kerneis> which would become "if condition then (if othercondition then result else result2) else result3"
zpe has quit [Read error: Connection reset by peer]
<technomancy> probably need to read up a bit on Lwt for this
<dramas> kerneis: um, i specifically looked for it and found a webpage
zpe has joined #ocaml
<dramas> let me see if i can find that, i may be mistaken
<dramas> but, apologies i'll use words
mcclurmc has joined #ocaml
<kerneis> dramas: the page you link to is about implementing a *new language* using OCaml
<kerneis> (a mini-calculator using reverse polish notation, aka RPN)
<kerneis> so the Naval Academy is teaching using OCaml
<kerneis> interesting :-)
ygrek has quit [Ping timeout: 244 seconds]
thomasga has quit [Read error: Connection reset by peer]
thomasga has joined #ocaml
adrien_oww has quit [Ping timeout: 272 seconds]
<technomancy> so are there any gotchas involved in nesting Lwt calls?
nikki93 has quit [Remote host closed the connection]
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
yezariaely has quit [Ping timeout: 246 seconds]
<flux> hmm, someone(TM) should implement regular expressions to ExEnum :)
zpe has quit [Ping timeout: 272 seconds]
ok259 has quit [Ping timeout: 245 seconds]
thomasga has quit [Ping timeout: 245 seconds]
tobiasBora has quit [Ping timeout: 252 seconds]
ok259 has joined #ocaml
<technomancy> I've got a project with a _tags file containing: true:package(core),package(lwt),package(github),thread,annot,debugging
klltkr has joined #ocaml
<technomancy> utop run from the project directory can see Lwt, but not the Github package
<technomancy> if I run #require "github";; in utop, I can tab-complete to the Github module
nikki93 has joined #ocaml
<technomancy> but when I try to M-x utop-eval-buffer on code that uses it, I get "Error: Unbound module Github"
* technomancy scratches head
<wmeyer> adrien: I am waiting for the patches, I will be going to review them, just send it to the caml-devel with the description, if these are bug fixes it has to be 100% clear of any bugs. If these are features, just make the patches against the cross compiler branch and send it to the mailing list. I will not have much time to be able rebase the branch though.
nikki93 has quit [Remote host closed the connection]
nikki93 has joined #ocaml
<dramas> sorry for the stupid question, again, i am struggling to find a 'range' operator of sorts
<dramas> like 1 .. 10
<dramas> i think i am just failing to find the documentation for builtin operators and im kind of waffling around using google
nikki93 has quit [Remote host closed the connection]
tianon has quit [Ping timeout: 244 seconds]
NoNNaN has joined #ocaml
avsm has joined #ocaml
nikki93 has joined #ocaml
klltkr has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
nikki93 has quit [Remote host closed the connection]
cesar_ has joined #ocaml
cesar_ is now known as Guest76526
nikki93 has joined #ocaml
_andre has quit [Quit: leaving]
Kakadu has joined #ocaml
tobiasBora has joined #ocaml
zpe has joined #ocaml
Guest76526 has quit [Ping timeout: 245 seconds]
BitPuffin has joined #ocaml
yezariaely has joined #ocaml
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
zpe has quit [Ping timeout: 246 seconds]
Anarchos has joined #ocaml
avsm has quit [Quit: Leaving.]
baz_ has joined #ocaml
baz_ has quit [Remote host closed the connection]
<technomancy> ok; I'm officially baffled by utop.
<technomancy> if I launch utop, run #require "github";;, then compile my code, everything is OK
<Anarchos> technomancy what is baffled ?
<technomancy> if I forget to require and compile first, it fails to compile; fine; that makes sense
<technomancy> but if I attempt to compile, then require, then attempt to compile again, it *still* fails
<technomancy> which is incredibly annoying
<technomancy> Anarchos: confused
Arsenik has joined #ocaml
<technomancy> I must be missing something. I'm already declaring a dependency on the github library in _tags. why do I have to manually require it?
<technomancy> and why does Lwt work fine without explicitly requiring it?
<yezariaely> Anarchos: astonished, confused,...
<Anarchos> ok
<technomancy> what do I have to do to get utop to require github for me?
baz_ has joined #ocaml
stevej has quit [Quit: ["Textual IRC Client: www.textualapp.com"]]
<technomancy> aha; it looks like I should put that in a project-specific .ocamlinit?
<technomancy> still confused why it's necessary for some libs and not others
<adrien> technomancy: only ocamlbuild reads the _tags file
<technomancy> adrien: so .ocamlinit is appropriate for toplevel stuff?
<adrien> yes
<technomancy> ok, cool
<technomancy> why is it some modules can't be used before they're required, but some work without it?
<ggole> Search paths, I think
<technomancy> so Lwt was packaged "properly" and just works, while the github lib left something out?
<ggole> I don't know. I guess that's possible.
nikki93 has quit [Remote host closed the connection]
<adrien> probably not "properly" or not
<adrien> but lwt might be special with utop
<adrien> iirc utop uses lwt
<companion_cube> yes it does
<technomancy> ah! well that makes sense then.
<technomancy> thanks
tane has joined #ocaml
ok259 has quit [Ping timeout: 245 seconds]
<ggole> Btw, one thing to look out for with .ocamlinit is that the local one takes precedence
<technomancy> yeah, that makes sense
<ggole> So you might have to copy some stuff from ~/.ocamlinit on occasion
<technomancy> now to figure out why this Lwt thread never gets run
<ggole> .ocamlinit is super handy though, for installing printers and the like
<technomancy> which should be a lot less painful with a working utop =)
Yoric has joined #ocaml
tianon has joined #ocaml
ok259 has joined #ocaml
baz_ has quit [Remote host closed the connection]
<bjorkintosh> why the hell does this AWFUL colour scheme exist at all? http://caml.inria.fr/pub/docs/manual-ocaml-4.01/manual001.html
<bjorkintosh> green ON white?!
<companion_cube> good question
<companion_cube> maybe someone could contribute a better CSS ^^
<bjorkintosh> someone :)
<bjorkintosh> why not just black on white?
<companion_cube> the default ocamldoc css is not very nice either
dsheets has joined #ocaml
<bjorkintosh> hmm.
<companion_cube> I think no one at Gallium got interested in CSS
<bjorkintosh> i just got a copy of 'functional approach to programmig', and was wondering if 'where' as in #x+1 where x = 2 ;; was still valid ocaml, or just valid caml?
<Kakadu> I have never noticed that CSS is very special until reading Contents in link above
ggole has quit []
<mrvn> bjorkintosh: why don't you try it?
<bjorkintosh> mrvn, of course i did.
<mrvn> Error: Unbound value x
<bjorkintosh> but it tells me the expression is not a function.
<adrien> bjorkintosh: no, it's not in OCaml
<Kakadu> bjorkintosh: where is part of revised syntax AFAIR
<adrien> was in Caml Light or something
<bjorkintosh> whereas let x = 2 in x + 1 ;; works just fine.
<mrvn> bjorkintosh: That syntax is horrible anyway. It destroys continuity
<bjorkintosh> ah alright.
<bjorkintosh> okay. i'll make a note of it.
baz_ has joined #ocaml
<bjorkintosh> also, can anyone tell me why ocaml uses ';;', as opposed to just ';'?
<adrien> ; is used for something else
<adrien> 1+1;
<adrien> this dumps the result of 1+1
<adrien> better: it computes but doesn't store the result
<bjorkintosh> hmm. i thought that was the whole point of fp: not storing results.
baz_ has quit [Remote host closed the connection]
<adrien> hmmm?
<adrien> in ocaml it is mostly used when result is of type 'unit'
<adrien> Printf.printf "foo\n";
<adrien> you could also:
<adrien> let () = Printf.printf "foo\n" in ...
<adrien> (but that's bad style)
dch has quit []
<bernardofpc> is "<expr>;" equivalent to "let () = <expr> in" ?
<companion_cube> but for parsing considerations, yes
osa1_ has quit []
zpe has joined #ocaml
<bernardofpc> meanin ?
<bernardofpc> *meaninG
<companion_cube> if a then b; c parses (if a then b); c
<companion_cube> but if a then let () = b in c doesn't
acieroid has joined #ocaml
<bernardofpc> oh
<bernardofpc> but here it is let () = if a then b in c, isn't it ?
<companion_cube> no
<companion_cube> let () = if a then b in c === (if a then b); c
zpe has quit [Ping timeout: 248 seconds]
<companion_cube> if a then let () = b in c === if a then (b ; c)
<bernardofpc> I mean, the ";" takes the current <expr>, terminates it, put let () = in front, and "in" at the back ?
<companion_cube> e1; e2 is like let () = e1 in e2, roughyl, yes
<bernardofpc> where "current" means "biggest" probably
<companion_cube> but with e1 as small as possible
<companion_cube> hmmm
<bernardofpc> (at least from your examples)
<companion_cube> anyway, the rules of the grammar are slightly ugly for the combination of if and ;
<bernardofpc> sadly
<companion_cube> it's to allow one to write if a then b;
<companion_cube> without having to write a branch for the else
a-tsioh has joined #ocaml
<bernardofpc> I guess that if you write if a then b else c ; d, this gets parsed as (if a then b else c); d
<companion_cube> I think so
<companion_cube> when in doubt, I add () or begin/end
<bernardofpc> which kind of follows the same greedy rule, the ; could take just c, or it could take the whole "if", and it took the if
<bernardofpc> is there any rationale as to prefer () over begin/end or vice-versa ?
<companion_cube> I think we can say that ';' has less binding power than if/then/else
<companion_cube> bernardofpc: my rule of thumb is () for small expressions (on the same line), and begin/end for bigger blocks
<companion_cube> so that it is clear how the code is structured
eikke has quit [Ping timeout: 244 seconds]
yezariaely has quit [Quit: Leaving.]
<bernardofpc> () also represents the constant of type unit and, as a pun, begin end is also allowed there -- but this last one is not specified in the manual, only consistently supported by the implementation. -> amazing
Kakadu has quit [Ping timeout: 245 seconds]
<a-tsioh> hi
<companion_cube> bernardofpc: like, begin end : unit ??
<bernardofpc> yes ! (however, on 3.12 one cannot match "begin end" , so "let begin end = begin end" does not work)
<companion_cube> lolilol
<bernardofpc> c'est ça
<a-tsioh> I feel a bit dumb, I can't manage to split signature and implementation of submodules
<companion_cube> a-tsioh: what do you want to do exactly?
<a-tsioh> I want to put the " module type SubModul = sig ... end " part in a .mli
<a-tsioh> and the related "struct ... end " in a .ml
<companion_cube> you don't want a module type then
<companion_cube> in the .mli: module Foo : sig ...... end
<a-tsioh> oh
<companion_cube> in the .ml: module Foo = struct .... end
<companion_cube> module type is for giving a name to an abstract signature
<companion_cube> whereas here you want to declare the presence of a module with a given signature
<a-tsioh> that's what I want !
<companion_cube> good :)
<a-tsioh> and it works !
cesar_ has joined #ocaml
<a-tsioh> subtle but totally making sense
Picolino has quit [Ping timeout: 260 seconds]
<a-tsioh> thanks !
cesar_ is now known as Guest5700
<companion_cube> a-tsioh: if you want to see cases where "module type" is useful, take a look at the standard lib' Set and Map modules
<companion_cube> there are module types Set.S and Map.S
<Anarchos> what is the best way to deal with free vars within terms ? Set, List, ... ?
<companion_cube> Anarchos: context?
passiveobserver has left #ocaml []
<a-tsioh> companion_cube: I saw some example somewhere in some doc about this, but nothing about my too simple case !
Guest5700 has quit [Ping timeout: 264 seconds]
<Anarchos> companion_cube lambda terms
<companion_cube> well, Set looks good then
<companion_cube> or just use De Bruijn indices
osa1 has joined #ocaml
<Anarchos> companion_cube yes but i need sets of free variables for alpha-substitution
tulloch has quit [Ping timeout: 244 seconds]
jonludlam has joined #ocaml
<companion_cube> Anarchos: do you know about De Bruijn indices?
<Anarchos> companion_cube yes
<companion_cube> well then, you don't need to deal with alpha renaming
<Anarchos> but i like to keep real names for the understanding of the terms
<companion_cube> then you can use a set
<Anarchos> companion_cube i need alpha renaming of bind variables
<companion_cube> then use a set
<companion_cube> what else can you do?
ok259 has quit [Ping timeout: 245 seconds]
<def-lkb> Anarchos: if you want a gensym mapping to real names, use a pair of a string and unique id
<Anarchos> def-lkb gensym ??
<def-lkb> Anarchos: a way to create fresh names
<Anarchos> def-lkb have you pointers to examples ?
<def-lkb> type ident = {name: string; id: int} let fresh = let k = ref 0 in fun name -> incr k; {name; id = !k}
tulloch has joined #ocaml
stevespiegel has joined #ocaml
<stevespiegel> I'm trying to interface with some C code and the linker can't resolve references to _caml_builtin_cprim and _caml_names_of_builtin_cprim. any ideas?
<bjorkintosh> hmm.
<bjorkintosh> does ocaml not use '|' ?
<companion_cube> "|" is used for pattern matching
<bernardofpc> true || false also
ok259 has joined #ocaml
<bjorkintosh> yeah i know what it's for.
<bjorkintosh> but i might be using it wrongly?
<bjorkintosh> n/m
<bjorkintosh> i found the reason why.
anderse has quit [Quit: anderse]
nikki93 has joined #ocaml
<tobiasBora> Hello !
Anarchos has quit [Quit: Vision[0.9.7-H-280704]: i've been blurred!]
<tobiasBora> I've a little question about performances. If my function is for example
<tobiasBora> let myfunc a b =
<tobiasBora> blabla
<tobiasBora> bloblo
<tobiasBora> and I want to reduce the size of myfunc by create an aux functin
<tobiasBora> let aux () =
<tobiasBora> blabla
<tobiasBora> bloblo
<tobiasBora> and after I use
<tobiasBora> let myfunc2 a b =
<tobiasBora> aux ()
klltkr has joined #ocaml
<tobiasBora> is it slower or not ? (My computes are really long, si even if the diferrence is little, it can be important)
<def-lkb> If this is in the same module and inlining is enabled, you won't see the difference
<def-lkb> If the function is short, it will get inlined, resulting in the same code being generated. If it is long, the overhead of the call will be negligible.
<technomancy> so the module Oldsys = Sys trick before opening Core.Std works... until you recompile the file
<technomancy> is there a way to make that reload-friendly?
Xenasis has quit [Remote host closed the connection]
<tobiasBora> def-lkb: And how could I enable inlining ?
<tobiasBora> And is it possible to inline only for this function ?
<technomancy> urgh; tuareg's function boundary search gets confused by internal open =(
<bernardofpc> tobiasBora: mind that probably you'll need to pass a and b to aux
<tobiasBora> bernardofpc: indeed, I forget it in my example but yes it's the case, and a and b are functions (not inline so it's quite long to give in parameter)
stevespiegel has left #ocaml []
<bernardofpc> are you calling myfunc lots of times, or is it that myfunc takes a lot of time ?
tulloch_ has joined #ocaml
<def-lkb> tobiasBora: there is nothing to specify, the compiler will do its best but you can tune it with the -inline command-line option
tulloch has quit [Ping timeout: 252 seconds]
<tobiasBora> def-lkb: Ok nice... And is there a way to see the code generated to see if the function is inlined or not ?
<tobiasBora> bernardofpc: Both... It's a recursive function (which is made in aux) so myfunc will call aux which will call myfunc, which will call aux and so one...
<def-lkb> tobiasBora: with the -S you can see the assembly generated
<def-lkb> tobiasBora: with the -dclambda, the compiler will dump its internal representation, after inlining
<def-lkb> flag*
<def-lkb> (this applies to ocamlopt compiler)
<gasche> you shouldn't need that
<companion_cube> -inline 10 is nice ^^
<gasche> if you need to know whether a change will make a difference in performances, do it and profile the result
<tobiasBora> Ok... So I need to understand assembly well ^^ I didn't undersand what does -dclambda
<gasche> you can't deduce much about actual performances by only looking at code
<bernardofpc> but you can deduce a lot about the (asm) code looking at actual performances ;-)
<bernardofpc> (but it takes time, and sometimes just the actual performance matters)
<tobiasBora> companion_cube: it will multiply the size of my exec file by 50 ? ^^
<bernardofpc> s/sometimes/oftimes/
<companion_cube> nahhh
Arsenik has quit [Remote host closed the connection]
<bernardofpc> depends how much aux is used
<tobiasBora> Yes I can try...
<tobiasBora> You mean ?
<bernardofpc> if only used once, having it inlined will probably not impact too much
<gasche> trying to micro-optimze stuff that doesn't matter is a classic beginners mistake
<companion_cube> right
<bernardofpc> I guess that if aux is locally declared and inlined, it takes less space than if it is declared and not inlined
<gasche> I'd bet 9 chances over ten you're wasting your time, tobiasBora
<gasche> write the code, and if you get a program that is too slow, profile to find the bottleneck
<bernardofpc> gasche: what good profilers are there for OCaml code ?
<tobiasBora> Yes, for this function, but if -inline 10 put all functions in one it can be huge no ?
<tobiasBora> bernardofpc: good question
<def-lkb> tobiasBora: depends on the number of codesite… if others symbols are not exported, then it can be the same size
<def-lkb> callsite*
darkf has joined #ocaml
<tobiasBora> gasche: It will run during maybe a week or more if I can, so that's why I try to optimize it... But if you think it's the same...
<gasche> bentnib: I've used gprof and perf
<bernardofpc> tobiasBora: simple solution: split that function to a separate file, use different flags, assemble it all
<gasche> tobiasBora: regarding your "let aux ()", yes, it's almost certainly the same
<gasche> but can't you have a test run that is shorter?
<bernardofpc> somethings in OCaml don't scale so well because you have to interact with GC
<companion_cube> looks like my binaries weight a few MB
<companion_cube> that's reasonable given the amount of code that goes in, even with -inline 10
<bernardofpc> probably that would be a problem in any language, but if we're talking weeks, there's probably a lot of memory and tuning the Gc might be much more relevant than inlining
<tobiasBora> bernardofpc: I don't understand what do you call "use different flags"
<companion_cube> I agree, the GC can have bigger an impact on performance
<tobiasBora> gasche: "let aux ()" is only an exemple, in reality it will be something like aux_count_general b n_max l_acc name_parent_node size ?fonc_add:(fonc_add = (fun b x -> set_board b x Occupied;true;)) ?release:(release = (fun b x -> set_board b x Accessible)) ?remove_neighbours:(remove_neighbours_in = remove_neighbours) ?must_copy:(must_copy=false) ?multicore_size:(multicore_size=(-1)) fonc_count fonc_add_neighbours
<gasche> so that's some kind of board game AI?
<tobiasBora> gasche: In a certain way... I'm counting polyominoes so I put these polyominoes in a board !
<NoNNaN> tobiasBora: what kind of computations do you have? tight numeric loops or symbolic ?
<tobiasBora> gasche: and yes I can try with smaller example, I'll try
<gasche> I thin it's essential that you try on, say, 3-minutes-long programs
<gasche> you can profile those, spot bottlenecks, tune GC parameters, etc.
<tobiasBora> bernardofpc: It's possible to interract with the GC ?
<companion_cube> you can tune the parameters
<companion_cube> using the Gc module
<companion_cube> bernardofpc: you're going to be an expert on OCaml, despite your initial reluctance :]
<tobiasBora> NoNNaN: It's numeric I think...
tulloch has joined #ocaml
tulloch_ has quit [Ping timeout: 246 seconds]
<tobiasBora> Thanks a lot !
<gasche> once you get run parameters that make your program run for a few minutes
<NoNNaN> what is the current maximum allocation rate / collection rate for ocaml in terms of memory speed?
<gasche> (enough to get reliable timings, but not too much to not get bored when repeating runs)
<gasche> you should try to compile it with ocamlopt -p and then use gprof to see which functions show highest in the profile
<bernardofpc> NoNNaN: I guess I have a stress-program that builds a list that's "just" too big to fit in the minor heap, and stresses this part
<gasche> if those are GC functions, you need to tune the GC, but generally it'll be some bottleneck in your code
<technomancy> I guess the answer is to just reload individual function definitions instead of the whole file, but tuareg's parser is broken for determining the start of a given function
* technomancy feels like he is stacking one workaround on another dangerously high
<bernardofpc> and I guess I could tune it to be "just the good size" and test minor heap allocs and collections that don't get promoted
Xenasis has joined #ocaml
<tobiasBora> NoNNaN: I don't have huge amoung of data in the memory, I have only a board of n*n, and the tail recursion of size n.
<companion_cube> GC: minor words 309531393; major_words: 6550062; max_heap: 3174400; minor collections 1180; major collections 14 ← in 4s
<companion_cube> on a program that allocates a lot
<companion_cube> so if the word size is 8bytes (64bits), looks like it allocated 2,4GB on the minor heap in 4s
<def-lkb> tobiasBora: the board is an array that you will mutate ?
<tobiasBora> Because the GC tuning is made only at the beginning of the program, and after ocaml does all the magic stuff ?
<bernardofpc> tobiasBora: you could even change Gc parameters on runtime (and dynamically)
<tobiasBora> def-lkb: Yes, a matrix : let board = Array.make_matrix n n 0...
<tobiasBora> bernardofpc: and that's the utility of Gc library ?
<bernardofpc> but you could start with gasche's suggestion to make a baby example, understand its performances and such before going full-throttle
<bernardofpc> (yes for utility)
<def-lkb> tobiasBora: if you only put integers in the array (no parametrized constructor), this shouldn't stress the GC at all
<bernardofpc> (you can also get statistics, if gprof/perf are not informative enough about what to do)
<bernardofpc> but this is rather arcane, I guess
<tobiasBora> gasche: and how could I know if there are "gc functions" ? The gc time is written ?
<bernardofpc> my viewpoint is : write your program, prove it correct, profile, test, optimize
<gasche> tobiasBora: by their name
<gasche> gprof tells you the function name, and GC functions have a name people on the chan will recognize
<companion_cube> :)
<tobiasBora> def-lkb: It's not really intergers, but the type is somethink like type case = Border | Occupied | Accessible | Free | Forbidden | Inside | Tmp | Debug
<gasche> (among others, caml_oldify_* is a usual culprit)
<companion_cube> tobiasBora: those are integers in practice, so that's good
<companion_cube> gasche: caml_gc_minor, too, right?
<def-lkb> tobiasBora: also, by making sure that accesses to the array are monomorphic (case array or case array array, not 'a array), you can gain a few more perf.
<tobiasBora> bernardofpc: I'will try. Is there a way to compile with -p with ocamlfind ?
<gasche> minor_words: 2700000114
<gasche> if I count right (2700000114. *. (float Sys.word_size) /. (2. ** 30.)), that's 80Gio of memory allocated in 3 secondes
<tobiasBora> def-lkb: Really ? I didn't know, they are 'a array... To make them minimorphic I must put (c : case) in the declaration ?
<gasche> hm
<gasche> no, I need to divie by 8 to get bytes instead of bits
<gasche> still makes 10Gio
<companion_cube> gasche: are you trying to reach the maximum rate of allocation?
* adrien hands gasche a web browser
<def-lkb> tobiasBora: code path for monomorphic array access is simpler, that can make a difference
avsm has joined #ocaml
ok259 has quit [Ping timeout: 245 seconds]
tulloch_ has joined #ocaml
tulloch has quit [Ping timeout: 240 seconds]
cesar_ has joined #ocaml
cesar_ is now known as Guest55661
platypine has joined #ocaml
strobegen has quit [Quit: Leaving.]
Guest55661 has quit [Ping timeout: 264 seconds]
<tobiasBora> I ran a first test on a non network version but somethink is strange...
<tobiasBora> When I do
<tobiasBora> print_d "%s" (string_of_board b)
<tobiasBora> with let print_d x = Printf.ksprintf (fun s -> if !debug_mode then print_endline s else ()) x
<tobiasBora> string_of_board is evaluated before the test I beleave ?
<companion_cube> I think so, arguments are evaluated before the call
<tobiasBora> Yes it is... Amazing...
<tobiasBora> I saw in the profiling that this function used many and many memory, and indeed I removed it and my code goes from 11 s to 0.2 ^^ Profiling is really usefull ^^
<companion_cube> you may wish to use %a rather than %s
rand000 has quit [Quit: leaving]
<def-lkb> print_d "%a" (fun () -> string_of_board) b
<def-lkb> or print_d "%t" (fun () -> string_of_board b)
<companion_cube> wow, what does %t do?
<def-lkb> companion_cube: expect an argument of type "unit -> string"
<def-lkb> (for sprintf)
<def-lkb> or more generally, of type ('a -> 'b) for a (_,'a,'b,'c) format4
<dramas> hi, could someone give me a tiny bit of help with a homework assignment?
<dramas> i don't want, like, the whole answer
nikki93 has quit [Remote host closed the connection]
<dramas> it's a sieve of eratosthenes, but i am getting a syntax error without additional details
<dramas> it just complains at a ';;' after the last line of that paste
<tobiasBora> Oh thanks a lot ! However I tried and the time is still huge, as before...
<companion_cube> def-lkb: ah, interesting
<tobiasBora> In fact it works only with %a
<companion_cube> dramas: you cannot finish an expression with ;
<tobiasBora> Well... In fact no it doesn't work with %a too
<companion_cube> it needs somethings afterward
<companion_cube> or just remove the ;
<dramas> companion_cube: sorry, which line?
<dramas> at the don's?
<dramas> done's?
<companion_cube> the last line
<dramas> im not sure what you mean by expression. :/
<companion_cube> tobiasBora: I meant that %a is a different way of printing
<companion_cube> printf "%a" print_foo foo;;
<def-lkb> tobiasBora: it depends on the function you are using to execute the format (sprintf, printf, …)
<companion_cube> where print_foo : out_channel -> foo -> unit
<companion_cube> dramas: in ocaml, many things are expressions, and ";" is used to separate two expressions
<dramas> hm, ok
<companion_cube> here, you have a suffixing ";" that isn't followed by anything, so that is a syntax error
<dramas> ok.
<tobiasBora> companion_cube: but I though that here the arguments would not be evaluated before, but it seems to be the case... (at least the time is the same as with %s)
<tobiasBora> dramas: in the first line let ... = ... ; ---> let ... = ... in
<dramas> sure, that one is troubling
<dramas> wait, you mean the very first line?
<companion_cube> dramas: no no, the very last
<dramas> companion_cube: i was referring to what tobiasBora said
<dramas> there are several lets
<dramas> i don't think i understand how let becomes let .. in
<tobiasBora> dramas: no the 3rd sorry
<tobiasBora> *one
<tobiasBora> *the third one
<dramas> right let foo upper true in?
<dramas> line six?
<companion_cube> dramas: oh, sorry
* dramas furrows her brow
Drup has quit [Ping timeout: 245 seconds]
<dramas> some of the syntax is kind of confusing. :/
<dramas> for one, what is the signifigance of the double vs single semicolon?
<companion_cube> ";" is used as a sequence operator: a; b means "evaluate a, discard its result, then evaluate b"
<companion_cube> ";;" is optional, and marks the end of a declaration
<companion_cube> let foo = ....... ;; ← here ";;" forces the definition of foo to stop
<companion_cube> it's especially useful in the toplevel
<dramas> :/
tane has quit [Quit: Verlassend]
<companion_cube> did I confuse you? :(
<dramas> well, i think i arrived pre-confused
<dramas> i've been working on this stuff the better part of two days
<dramas> not this one in particular
<companion_cube> do you know the toplevel?
<dramas> it's just a huge shift from what i normally write as software -- perl, shell, sql, python, ruby
<dramas> i do not know what you mean by the toplevel :(
<tobiasBora> dramas: No I'm talking about the line 3 ^^ Sorry
<companion_cube> don't worry, you'll get used to the change
<companion_cube> dramas: when you type "ocaml" in the terminal
<dramas> believe me i am way more used to it than i was this morning
<dramas> companion_cube: yes, i have been testing code against that as i edit in vim
<companion_cube> the read-eval-loop, if you prefer
<dramas> yeps
<companion_cube> like ipython/bpython
<companion_cube> so, this is called "toplevel"
<dramas> (and node, and rhino, and...)
<dramas> okay
<whitequark> read-eval-print loop usually it is
<whitequark> "REPL"
<companion_cube> if you're learning ocaml, you might look at http://ocaml.org/tutorials/index.html
<companion_cube> whitequark: +1
Drup has joined #ocaml
Yoric has quit [Ping timeout: 245 seconds]
<whitequark> talking companion cube!
<dramas> companion_cube: i have been looking at that as well as a few others
<whitequark> no, that can't be.
<companion_cube> whitequark: it's only in your mind :p
<whitequark> companion_cube: I guess that's technically true
<dramas> they seem to both give very basic examples and also assume i understand what they mean from a functional programming standpoint
<dramas> like, i don't think i've seen any examples with nested for loops
<dramas> or anything that explained when i need to use bang in assignment
<dramas> that is, foo := !foo + 1
<companion_cube> that's because ! is just an operator
<companion_cube> hmmm, right, you're probably not familiar with the distinction between variables and references in OCaml
<dramas> i have references in perl and use a $ to dereference
<companion_cube> foo := !foo + 1 works on references
<dramas> er, an extra sigil
<companion_cube> that is, mutable boxes that contain a value
<companion_cube> right, must be similar
<dramas> so @$foo is a dereferenced list etc
<companion_cube> here, foo is a int ref
<companion_cube> !foo is an int
<dramas> but at what point must i dereference it
<dramas> i see
<companion_cube> and (:=) : 'a ref -> 'a -> unit
<companion_cube> puts an 'a into a 'a ref
<dramas> an what is with the tick-a stuff
<dramas> 'a and so on
<companion_cube> it's a type variable
<companion_cube> it stands for any type
<companion_cube> for instance, here: (:=) : int ref -> int -> unit
<companion_cube> (puts an int into a int ref)
<companion_cube> but it also works for a float ref
esden has joined #ocaml
<companion_cube> or a bool list ref
<dramas> wow, you entirely lost me on that line
<dramas> starting with (:=)
<companion_cube> sorry
<companion_cube> (:=) is notation for the operator :=
<companion_cube> (+) is notation for the operator +
<companion_cube> and so on
<dramas> oh, alright.
<dramas> that much i understand. ok.
<companion_cube> when I write foo : bar it means "foo has type bar"
<dramas> okay
<companion_cube> so, (:=) : 'a ref -> 'a -> unit means "the operator := has the type of a function that takes a 'a ref, and 'a, and returns unit"
<companion_cube> (for any type 'a)
<dramas> okay.
<companion_cube> so, in foo := !foo + 1 we have foo : int ref
<companion_cube> (!foo + 1) : int
<dramas> yep.
<companion_cube> so (:=) foo (!foo + 1) : unit
<companion_cube> (:=) foo bar is the same as foo := bar
<dramas> i think i have that.
<dramas> heh.
<companion_cube> you could write (+) 1 2 rather than 1 + 2 also
<dramas> okay.
<dramas> may i ask why?
<dramas> is that endemic to some thing ocaml has or?
<Drup> yes, it's just the notation "turn this operator into a function"
<companion_cube> right
<dramas> ok.
<dramas> interesting.
<companion_cube> let (+++) a b = a + b;;
<companion_cube> ↑ defines a new operator
<dramas> that just adds.
<companion_cube> then you can write 1 +++ 2
<dramas> correct?
<companion_cube> yes, but it could be more complicated
<dramas> yeah.
<companion_cube> it's just a notation anyway
<dramas> so in fact if i were a real jerk i could make my own ternary operator
Ptival is now known as ahamsandwich
<companion_cube> operators that can be written in an infix way are composed of non-alphabetic chars
<companion_cube> dramas: I fear it only works for unary and binary operators...
<dramas> oh.
<dramas> well, the world is safe, then.
<companion_cube> yes, sorry
<companion_cube> :)
<dramas> so how does let become let/in?
<companion_cube> ah.
<companion_cube> let is a very important piece of the syntax, because it lets you (...) bind variables
<dramas> er, the laptop is squealing, i'll be right back with a teat
<companion_cube> let x = a in b binds the variable "x" to the expression "a", and then evaluates "b" in the scope where "x" is defined
<Drup> We should put an exhaustive explanation on let on the wiki at some point
* dramas reads
<Drup> because it's such an important piece of syntax quite poorly explained by the manual
<dramas> okay, i have that
<dramas> Drup: no offense to anyone really intended, but i find the documentation to be kind of lacking
<dramas> it reminds me a lot of the java documentation that's autogenerated and not very engaging
<dramas> and there aren't, that i can tell, examples
<dramas> so i'm given a prototype, but not really an explanation. :/
<companion_cube> dramas: then, let x = foo ;; is a top declaration, so it binds x to foo in the global scope
<companion_cube> (x can be a function)
<dramas> Drup: i assume by 'the manual' you mean this: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Pervasives.html
<dramas> companion_cube: okay.
<companion_cube> dramas: ocaml.org should be more readable/easier than the manual you just linked
<Drup> dramas: actually, the documentation is a very good *documentation*, it's not a *tutorial*
<companion_cube> http://ocaml.org/tutorials/99problems.html dramas, maybe you should look at this: 99 simple examples
<companion_cube> you can try to solve the examples in the REPL (toplevel), and compare to what the solutions are on the website
<dramas> Drup: if i say 'perldoc -f let' i get whatever let does and a description.
<dramas> but let us not quibble, i'm trying to just pick it up the way it is intended to be used.
<dramas> companion_cube: looking
<dramas> oh
<dramas> the reason i have specifically *not* been looking at that is i do not want to inadvertently cheat
<dramas> and not understand an idiom i used
<dramas> and subsequently be asked why i did something and have no good answer.
<companion_cube> what do you mean by cheating?
<dramas> there are of course several variants of the sieve of eratosthenes in ocaml on the internet. i am specifically writing my own.
<companion_cube> well, don't read the erathostene part, then
<dramas> i mean i could copy code from that 99 problems page and suddenly have an It Works! moment and not undersatnd why.
<companion_cube> but many small examples should help you understand the basic constructions
<companion_cube> hmmmm
<companion_cube> read and try to understand, don't copy? :/
<dramas> which is why i am not saying "can you fix this", i'm saying "can you help me understand how xyz works"
<companion_cube> indeed.
<dramas> and yeah. i am trying to understand. i wrote my first words of ocaml i guess 8 or so hours ago
<dramas> so in the case where i am saying let sub_iterator = iterator ** iterator
<dramas> the toplevel thing complains about the subsequent line, which is another let
<dramas> let multiple = ref 1 in ...
<dramas> and i am not sure what it is i am doing wrong. it just says "syntax error." :(
ollehar has joined #ocaml
<companion_cube> in the toplevel, you should end a declaration by ";;"
<companion_cube> so that the toplevel "knows" it can parse and compile what you've typed
<dramas> oh, but i am pasting that ito toplevel from my editor
<dramas> so that's um, 3 scopes down.
<companion_cube> there is a command to read code from a file
<companion_cube> #use "myfile.ml";;
<dramas> er
<dramas> Error: Unbound value use
<dramas> did you mean literally with the octothorpe?
<tobiasBora> And what about the question I asked one hour ago, I ran gprof and indeed I found really gready functions that deal with strings and I removed them, but now I've still some gready functions about strings, but I can't see where it come from. Could it be the not inlined functions given in parameter ? And I'm not sure, but it doesn't seems to have lots of GC functions isn't it ?
<dramas> wow, you did. huh.
<tobiasBora> *comes
<companion_cube> dramas: you need to add the leading "#"
<dramas> yeah
<companion_cube> # #use "foo.ml";;
<dramas> is there any way to make the interpreter use readline or something so i can uparrow and get keybindings?
<companion_cube> ↑ first # is the prompt, second # is the one you type
<dramas> yes, i figured that out. :)
<companion_cube> dramas: I'd suggest to install utop, or rlwrap
<companion_cube> utop is a better ocaml toplevel (installed via opam)
<companion_cube> rlwrap is just a readline wrapper
<companion_cube> if you install rlwrap, then you'll have to run "rlwrap ocaml" instead of "ocaml" to get a toplevel
<companion_cube> but it will be actually bearable
<dramas> rlwrap it is
<technomancy> there's no way to get completion and history at the same time though, right?
<whitequark> technomancy: use utop?
ahamsandwich has quit [Read error: Operation timed out]
<technomancy> ah, utop has history, it just doesn't bind it to the right keys
<companion_cube> rlwrap provides -H to manage an history file
<companion_cube> anyway, my bed awaits, sorry
<companion_cube> dramas: good luck!
ahamsandwich has joined #ocaml
<dramas> companion_cube: thank you very much
mort___ has joined #ocaml
Drup has quit [Remote host closed the connection]
Drup has joined #ocaml
mort___ has quit [Quit: Leaving.]
pango_ has joined #ocaml
a-tsioh has quit [Ping timeout: 240 seconds]
pango has quit [Ping timeout: 260 seconds]
tulloch_ has quit [Ping timeout: 246 seconds]
pango_ is now known as pango
nikki93 has joined #ocaml
tobiasBora has quit [Quit: Konversation terminated!]
a-tsioh has joined #ocaml
klltkr has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
Drup1 has joined #ocaml
Drup has quit [Read error: Connection reset by peer]
jonludlam has quit [Remote host closed the connection]
<dramas> so i have found a bunch of stuff i thnk was unnecessary and my just flailing at the toplevel thing
<dramas> but i think i have a scope error, and i can't really find it
<dramas> it's giving me just "syntax error" at the last line
<Drup1> let bla = bli IN stuff
<Drup1> not ;
Drup1 is now known as Drup
<Drup> replace all your "let ... ;" by "let .... in"
<dramas> *all* of them?
<dramas> so,
<dramas> let multiple = 1 in
<dramas> let bleh = blah in
<dramas> continually like that?
<Drup> yes
<dramas> wow, ok
<Drup> "let <id> = <expr> in <expr>" is itself an <expr>
<dramas> hummm.
<Drup> so you can chain them :)
<dramas> i thought i was opening a new scope by using in
<Drup> you are
<Drup> did I say anything that contradict with that ?
boogie has joined #ocaml
<dramas> no
<Drup> also, technically, you don't need the last ";"
<Drup> in ocaml, ";" is a separator, not a terminator
<dramas> am i doing something wrong on line 5?
<dramas> i'm just trying to assign n**2 to upper
<dramas> and it's saying it's expecting a float?
<Drup> n**2 is float exponanciation
<Drup> so the result will be a float
<dramas> oh good grief, okay
<dramas> so i can just truncate it?
<Drup> that, or code an int power function
<dramas> exp?
<dramas> no, that's float too
<Drup> but yeah, truncature will do :)
<dramas> i don't see an integer exponentiation word
<Drup> there is none in the standard library
<dramas> that leaves me wondering... why is that?
bobry has quit [Quit: Connection closed for inactivity]
cesar_ has joined #ocaml
<Drup> Don't ask political question about the state of the standard library :D
<dramas> oh
<dramas> fair enough
cesar_ is now known as Guest82800
<dramas> so if i change that to let upper = truncate(n ** 2) in
<dramas> it still moans about it getting a float?
<Drup> just no there is not that much stuff in it, but there is several external libraries that provide a replacement
<Drup> know*
<Drup> dramas: ** is of type float -> float -> float
<Drup> "2" is an int
<dramas> ooooooh.
<dramas> good grief
<Drup> ocaml is picky about int and floats :à
<dramas> yeah clearly
<Drup> :)*
<dramas> and of course being from perl, where it hardly acknowledges there's a difference in types
<Drup> I can imagine the shock.
<dramas> yes
<Drup> but it's for greater good ! :D
tulloch has joined #ocaml
Guest82800 has quit [Ping timeout: 245 seconds]
<dramas> hmmm
<dramas> and line 17?
<dramas> Error: The constructor false expects 0 argument(s) but is applied here to 1 argument(s)
<dramas> i don't seem to be giving it arguments at all?
<dramas> assume those semicolons are gone
<Drup> well, the one after false shoudn't be gone :3
<Drup> also, I didn't notice
<Drup> but the assignation operator for arrays is "<-"
Simn has quit [Quit: Leaving]
<dramas> yeah, i just fixed that. :/
madroach has quit [Ping timeout: 264 seconds]
<Drup> in this case, you are doing a sequence of operations that doesn't return anything
<Drup> you can take ";" as the sequence operator, "<expr> ; <expr>" is an <expr>
<dramas> i don't follow
<dramas> the two statements inside the while, they don't return anything
madroach has joined #ocaml
<Drup> and the semantic is "do stuff 1, ignore the result, and do stuff 2
<dramas> so you are saying they need the ;?
<Drup> you need the ";" to separate them
<dramas> okay
<dramas> and is there something wrong with the assignment under the array assignment?
<Drup> not afaict
<dramas> :/
<Drup> except that multiple is not a ref
<dramas> so, line 18, as it is written
<dramas> ok, but it gives me the same complaint with or without the bang.
<Drup> because that's not the issue
<Drup> you are using multiple as a ref
<Drup> in two ocasion : the (:=) and the (!)
<Drup> but you declared it as an int
<dramas> so just =?
<Drup> not an int ref
<Drup> "let multiple = 1 in" <- this is the part you should change.
<dramas> to ref 1?
<Drup> yes
<Drup> you will also need to change the next line, I will let you find where.
<dramas> and then on line 14, that needs to be derferenced
<dramas> wow, how about that
<Drup> exactly
<dramas> it went straight through the syntax fascist
<dramas> thank you
<Drup> syntax fascist xD
<dramas> that was the polite version of what went through my head
NoNNaN has quit [Remote host closed the connection]
<dramas> so i am a bit confused about assigning values here.
<dramas> since we just "return" the last evaluated statement, do i simply then say on the last line of the assignment, the value i wish it to have?
<Drup> yes
<dramas> with no semi or anything?
<Drup> depends :3
<dramas> heh, naturally. :)
<dramas> let me bang skull on it some more.
stevespiegel has joined #ocaml
<Drup> not *after* at least
<Drup> I can't say anything *before* because that depends of what's before
<Drup> "let .... in x" returns x
stevespiegel has left #ocaml []
<Drup> "expr1 ; x" returns x too
a-tsioh has quit [Ping timeout: 252 seconds]