gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.1 http://bit.ly/nNVIVH
joewilliams is now known as joewilliams_away
lopex has quit []
mjonsson has joined #ocaml
sebz has joined #ocaml
sebz has quit [Client Quit]
emmanuelux has quit [Ping timeout: 240 seconds]
dnolen has joined #ocaml
everyonemines has joined #ocaml
mjonsson has quit [Remote host closed the connection]
joewilliams_away is now known as joewilliams
dnolen has quit [Quit: dnolen]
shaleh has joined #ocaml
* shaleh is trying to understand pattern matching in ocaml.
<shaleh> in haskell is can say something like foo (x:xs) (y:ys) = (x+y) : foo xs ys
<shaleh> how would I say that in ocaml?
<shaleh> sure I could use hd and tl, but then I might hit null lists and have to check for that with an if or two
<shaleh> is there something close to the haskell multiple pattern match?
<everyonemines> let rec foo x y = match (x,y) with (x::xs,y::ys) -> x+y :: foo xs ys;;
<everyonemines> That creates a pair, but I think the compiler optimizes that away.
<shaleh> hmm, I see
<everyonemines> : is used for type annotations in ocaml, I guess haskell uses something else
<everyonemines> Hah, it uses ::
<everyonemines> My memory got mixed up.
<_habnabit> shaleh, `let rec foo (x :: xs) (y :: ys) = x + y :: foo xs ys`
<_habnabit> shaleh, but that doesn't account for the case of empty lists.
<shaleh> _habnabit: right, and ocaml does not appear to support multiple function definitions like haskell
<_habnabit> shaleh, correct. no overloading at all.
<everyonemines> _habnabit: But how would you do (x::xs,y::ys) -> x+y :: foo xs ys | ([],[]) -> [] ;; with that?
<_habnabit> everyonemines, you can't.
<everyonemines> that's what I thought
arubin has quit [Quit: arubin]
<everyonemines> Hmm, I thought function would be more elegant but I don't really use it. How do you correctly do
<everyonemines> let rec foo = function | x::xs y::ys -> x+y :: foo xs ys | [] [] -> [] ;; ?
<everyonemines> Ah, you need to do let rec foo = function | x::xs, y::ys -> x+y :: foo (xs,ys) | [],[] -> [] ;;
<everyonemines> still need to make pairs
ulfdoz has joined #ocaml
<everyonemines> I always use match because I think it's more readable.
<everyonemines> But I think it's faster sometimes too.
<everyonemines> I feel like some people use gratuitous currying to be like, "look at me, I'm all functional and shit"
<everyonemines> and then their code becomes unreadable
<everyonemines> But then, I feel like ocaml should have goto, so maybe I'm not a paragon of code readability principles. :-)
<_habnabit> ocaml doesn't need goto; it has exceptions.
<everyonemines> Aren't they pretty slow compared to goto?
<everyonemines> And you can't implement a while loop with exceptions.
<_habnabit> 'slow' ?
<_habnabit> anyway, ocaml /has/ while loops. why would you need to implement them?
<_habnabit> the only use of goto in modern C is for cleanup code. exception handling buys you that already.
<everyonemines> So there isn't a significant performance penalty for exceptions in ocaml?
<shaleh> # let evalRPN tokens =
<shaleh> let rec go stack tokens =
<shaleh> match tokens with
<shaleh> [] -> stack
<shaleh> | t :: ts ->
<shaleh> match (t, stack) with
<shaleh> (Digit _ as d, st) -> go (d :: st) ts
<shaleh> | (Plus, (Digit x) :: (Digit y) :: st) -> go (Digit (y + x) :: st) ts
<shaleh> | (Minus, (Digit x) :: (Digit y) :: st) -> go (Digit (y - x) :: st) ts
<shaleh> | (Times, (Digit x) :: (Digit y) :: st) -> go (Digit (y * x) :: st) ts
<shaleh> | (Div, (Digit x) :: (Digit y) :: st) -> go (Digit (y / x) :: st) ts
<shaleh> | (_, _) -> failwith "Invalid stack state"
<shaleh> in go [] tokens;;
<_habnabit> 1) compared to what? 2) premature optimization is the root of all evil.
<_habnabit> shaleh, pasting to the channel is kinda rude.
<shaleh> _habnabit: yeah, sorry about that, missed the window I meant
<shaleh> that said, using the tuple trick made the pattern match turn out ok
<_habnabit> a lot of your parentheses are redundant.
<shaleh> _habnabit: I hate remembering precedence (-:
<_habnabit> , has pretty low precedence.
<_habnabit> I don't know the order offhand, though.
<everyonemines> I'm with shaleh, extra parens are faster than debugging if you're not sure.
<everyonemines> I mean, philosophically.
<shaleh> one can go overboard for sure, but I did not think I did.
<shaleh> how close to ocaml style is that code? I have been playing in haskell and just started trying out ML
<_habnabit> leaving off the first | in a match always looks strange to me.
<everyonemines> I leave it off, but it really doesn't matter
<shaleh> _habnabit: that is how both the O'Reilly and "Think OCaml" do it
<shaleh> _habnabit: so I was just following along
<everyonemines> shaleh: ocaml is multi-paradigm. You can program in a more functional or imperative style, or even (ugh) object-oriented.
<everyonemines> If you're from a haskell background, then you'll probably use a functional style.
<shaleh> everyonemines: yeah, I tend to functional, even in my C
<_habnabit> those aren't all mutually exclusive.
<everyonemines> Personally I'm a fan of recursion combined with array mutation.
<shaleh> I wanted to try out ML. I like haskell but I find trying all of the choices makes for a more well rounded result
<everyonemines> shaleh: Memoization and IO in haskell seems painful. It's also slower in practice.
<shaleh> "slower" is relative and often not what I am concerned with. That said it is way to easy to hit stack explosion in Haskell.
<shaleh> I wrote a really simple brainfuck interpreter and on really complex code it never really finished
flux has quit [Read error: Connection reset by peer]
<everyonemines> Adding extra layers makes it harder to understand what the machine is doing, and sometimes you must. I find ML to be a happy medium, for now.
<shaleh> ML is a little syntax heavy for me. The explicit match, rec, let, etc. make the code less elegant than the haskell I am used to readng
<everyonemines> You mean, the keywords are visual clutter?
<everyonemines> Meh, maybe you just get used to it. I like that it's easy to understand how something will be parsed, myself.
flux has joined #ocaml
<shaleh> I never found Haskell hard to parse. Reason about is another story.
<shaleh> f . g . h x is nice and I miss it
<shaleh> Is there a haskell <-> ocaml functions like somewhere? I keep looking for the equiv of things like "words".
<everyonemines> rosettacode
<shaleh> words "this is a string" -> [this, is, a, string]
<everyonemines> read through the standard library for stuff like that
<shaleh> everyonemines: where is the easy place to do that online?
<shaleh> or better, where is a reasonable online starting place? The inria site is not all that well put together
junsuijin has quit [Quit: Leaving.]
<everyonemines> hmm, I guess exceptions in ocaml are faster than I thought
ulfdoz has quit [Ping timeout: 258 seconds]
joewilliams is now known as joewilliams_away
<shaleh> how does one rip a string apart? In haskell a string is a [char] so I can pattern match on (c:cs) and test for [].
<_habnabit> 'rip it apart' how? there's string methods.
joewilliams_away is now known as joewilliams
<shaleh> _habnabit: let rec foo str = match str with c :: cs -> op c :: foo cs
<_habnabit> yeah, you have to index it and/or use String.sub
<shaleh> the string methods seem more C 'esque with loop or index variable to walk the string
<_habnabit> eh?
<shaleh> _habnabit: I just have not found a tutorial I am happy with yet so I am floundering around with my Haskell knowledge and the ref combined with the O'Reilly text
ankit9 has quit [Quit: Leaving]
<shaleh> write now I would like a function to split a string into a list of words --> "this is a test" should become ["this", "is", "a", "test"] like perl or python's split or Haskell's words. Hmm, I just found Str (as opposed to String)
joewilliams is now known as joewilliams_away
<everyonemines> Use Str.split
<everyonemines> you need to use Str.regex on the split string.
<everyonemines> Strings being lists instead of arrays seems dumb to me.
<shaleh> everyonemines: choices, choices. I do not mind either way. I am just learning enough of the vocabulary to think straight.
<everyonemines> Seriously though, random access of substrings is important.
<shaleh> Not being able to pattern match directly on strings just feels foreign right now
<everyonemines> I feel like I'm starting to understand why Haskell is slow.
avsm has joined #ocaml
bitbckt has quit [Quit: out]
Cyanure has joined #ocaml
bitbckt has joined #ocaml
ankit9 has joined #ocaml
thomasga has joined #ocaml
edwin has joined #ocaml
Cyanure has quit [Remote host closed the connection]
ikaros has joined #ocaml
Boscop has joined #ocaml
avsm has quit [Quit: Leaving.]
PiepScuim has joined #ocaml
Cyanure has joined #ocaml
everyonemines has quit [Quit: Leaving.]
shaleh has quit [Quit: shaleh]
avsm has joined #ocaml
avsm has quit [Quit: Leaving.]
fracek has joined #ocaml
avsm has joined #ocaml
surikator has joined #ocaml
Kakadu has joined #ocaml
<flux> shachaf, if you're feeling you don't need performance, iirc batteries comes with an explode function
<flux> (or perhaps it's list String.to_list or something)
surikator has quit [Read error: Connection reset by peer]
surikator_ has joined #ocaml
<rixed> shaleh: in batteries, you have BatString.nsplit "this is a test" " " -> ["this"; "is"; "a"; "test"]
<rixed> flux BatString.to_list will make a string a list of chars.
<flux> oh yes, I was just looking the discussion about the difference of choosing string as an array vs string as a list of chars
<rixed> flux: string as a list of chars would be unpractical for sharing them with C, and would be quite innefective. I like Ocaml compromise, although I'd like to be abble to pattern match them anyway. Surely there is a syntax extention for that?
<flux> rixed, not quite, but almost, and perhaps even better: mikmatch
<flux> (hm, was is micmatch or mikmatch which was more recent? I never remember ;-))
flux has quit [Remote host closed the connection]
flux has joined #ocaml
flux has quit [Remote host closed the connection]
flux has joined #ocaml
flux has quit [Remote host closed the connection]
Boscop has quit [Quit: OutOfTimeException: Allocation of TimeFrame failed due to lack of time. Free up time by cancelling unimportant events.]
everyonemines has joined #ocaml
bitbckt has quit [Quit: out]
bitbckt has joined #ocaml
flux has joined #ocaml
ttamttam has joined #ocaml
lopex has joined #ocaml
larhat has joined #ocaml
flux has quit [Ping timeout: 260 seconds]
_andre has joined #ocaml
emmanuelux has joined #ocaml
fracek has quit [Quit: fracek]
everyonemines has left #ocaml []
flux has joined #ocaml
Cyanure has quit [Remote host closed the connection]
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
PiepScuim has quit [Read error: Connection reset by peer]
mjonsson has joined #ocaml
Cyanure has joined #ocaml
<adrien> gildor: I'm going to make lablgtk-react use oasis; should I take the 0.2.0, 0.2.1 alpha or latest in source control
<adrien> ?
<adrien> ah, I won't be able to really chose the latest darcs
foocraft has quit [Read error: Connection reset by peer]
foocraft has joined #ocaml
<gildor> adrien: go for 0.2.1~alpha, it is quite safe
<adrien> ok, thanks =)
<sgnb> gildor: btw, how about a proper release?
<adrien> I'm going to install ocamlify-0.0.1, and the version number is quite low :P
<adrien> hmmmm
<adrien> File "src/pa_odn.ml", line 47, characters 2-9:
<adrien> Error: Unbound value Gen.idp
<adrien> gildor: does ODN work with type-conv 3.0.4?
<adrien> I've updated my libraries for the new version of Core and changed quite a lot of things (that was really annoying and frustrating to do) and I think I changed type-conv too
ankit9 has quit [Quit: Leaving]
<gildor> adrien: I am not sure about type-conv and ODN
<gildor> adrien: there is a lot of things changed in type-conv
<gildor> sgnb: I am all for a proper release, I expect to resume my OCaml related works ~1st November
* gildor busy painting shelves and walls at his house since 3 months
<adrien> gildor: yeah, that's my issue: many many incompatible changes
<hcarty> adrien: odb is still on typeconv 2.3.0 by default at least in part to keep odn (and oasis) compatibility
<hcarty> adrien: Just to provide another data point :-)
<adrien> sgnb: thanks for the link; do you know if the fix is good?
<adrien> janestreet really did something not very clear/clean recently
<adrien> looks like the fix is working
<adrien> also, godi uses "wget $WEBSITE/$DISTFILES"; this doesn't seem to work nicely with the forge since you can have https://forge.ocamlcore.org/frs/download.php/625/ocaml-fileutils-0.4.3.tar.gz and https://forge.ocamlcore.org/frs/download.php/462/ocaml-fileutils-0.4.2.tar.gz
<adrien> there is 625 and 462 which is not predictable without looking it up; is there a solution?
<sgnb> adrien: I don't
<sgnb> will have a look when OCaml stuff are un-stuck in Debian
<adrien> well, it works and the tests passed, but I have no idea what the code does
<edwin> how is 3.12.1 transition going in Debian? is jocaml/mingw32-ocaml only things blocking?
<gildor> adrien: what the problem with godi/wget this 2 links are not the same
<adrien> gildor: it'd be nice to be able to deduct the URI for version 0.4.3 from the URI for version 0.4.2 =/
<adrien> but I guess the forge does not even guarantee there is only one filename per project
<gildor> adrien: indeed, no guarantee
<gildor> the number in it allow the uniqueness (AFAIK)
<adrien> =/
<adrien> what should I use to pass -use-ocamlfind to ocamlbuild?
<adrien> or should I rather remove my currently existing _tags files? (moving to oasis for the build system)
<hcarty> adrien: oasis, as long as it supports what you need
<hcarty> adrien: Or you could wrap a thin Makefile around your ocamlbuild setup.
<hcarty> oasis would hopefully allow for easier future growth.
<adrien> so ditch my _tags files?
avsm has quit [Quit: Leaving.]
<hcarty> As long you have a backup, yes. oasis will generate one which you may need to modify, depending on your project.
<adrien> ok; find -name '_tags*' | xargs ... I think ;-)
avsm has joined #ocaml
lopex has quit []
<hcarty> My oasis conversions have generally gone along the lines of: git checkout -b oasis && rm build_system_files && oasis quickstart && vim _oasis && oasis setup
<adrien> ah, branching, that's not stupid :P
<hcarty> adrien: With several repetitions of the last two steps in order to get everything working properly
<hcarty> :-) They do serve a purpose from time to time
<adrien> if I have "Library \"minifrp\"", do I need to add a FindlibName option?
<adrien> but lablgtk-react is zomg-leet bleeding-edge, you have to be bleeding-edge and uber-cool to use it too: no branches! safety is for wimps!
<gildor> adrien: I tend to keep the _tags at the beginning and just add # OASIS_START \n # OASIS_STOP then see what oasis setup adds and remove the duplicate lines
<hcarty> adrien: Branch, but immediately after branching delete the original branch. Burning bridges, all the cool kids are doing it.
<hcarty> gildor: That's an even better plan :-) Thanks for the tip!
<gildor> hcarty, adrien: oh, and of course, when I see some tags missing, I fix the generation process directly in oasis ;-)
<hcarty> adrien: I think you do need to add FindlibName if you want one. I think this is in part to support nested findlib names.
<gildor> (and submit a patch upstream ;-)
<hcarty> gildor: Of course :-)
<adrien> gildor: oh, right, I had forgotten about that :p
<adrien> hcarty: and rebase, amend commits, rewrite history, delete branches and replace them with different ones which only share the name
<adrien> how do I give "-thread" to ocamlfind?
<gildor> adrien: pkg_thread
<gildor> or BuildDepends: thread
<adrien> thanks, also found it in lwt's oasis
fracek has joined #ocaml
lopex has joined #ocaml
testcocoon has joined #ocaml
<edwin> gildor: btw did you notice that lately ocamlbuild doesn't show the error messages from ocamldep, just that it exited with error code 2? (when the .ml/.mli files have a syntax error)
<edwin> do you know of a way to work around that with myocamlbuild.ml, or should I open a bug in mantis?
ankit9 has joined #ocaml
<sgnb> edwin: maybe you are affected by http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=642922 ?
<sgnb> (don't know if ocamlbuild is at fault, though)
<sgnb> oh, didn't pay attentention to the "when the .ml/.mli files have a syntax error" part
<sgnb> well, printing to stderr is indeed involved...
<edwin> if I run the ocamlfind ocamldep command manually it prints the message
<edwin> from ocamlbuild it doesn't
<sgnb> I observed the same behaviour in aforementioned bugreport
<edwin> let me try upgrading dash though
<sgnb> I wasn't able to reproduce the behaviour outside of ocamlbuild
<edwin> yay its working now
<edwin> sgnb: thanks for the hint
<sgnb> it would be nice to understant what was going on, though
<sgnb> I've never been so clueless about a bug I "solved" myself
<edwin> would probably involve digging into dash
<edwin> maybe some buffer doesn't get flushed that should
<edwin> and looses stderr
<edwin> did upstream revert that patch too?
<sgnb> the problem is still not understood and the revert remains Debian-specific
joewilliams_away is now known as joewilliams
<edwin> sgnb: interesting, looking through strace and apparently its a problem with file descriptor 2 in the parent, which is a pipe and in one case its closed already
<edwin> scratching my head on the why
<edwin> sgnb: although there is something seemingly silly there: dup(0) = 3, close(0), dup2(3,0) = 0, close(3)
<edwin> whats the point of that?
mnabil has quit [Ping timeout: 256 seconds]
<edwin> sgnb: maybe that helps shed some light, in the bad case (5.7.2-1) it creates a pipe on fd 8,9, and then closes fd 8
<edwin> sgnb: in the good case it closes fd 8, and then creates a pipe on fd 8,9
<edwin> would be interesting to know where that close(8) comes from in the bad case
__marius__ has joined #ocaml
ulfdoz has joined #ocaml
<sgnb> the original patch doesn't make any sense to me w.r.t. its description in the first place
larhat has quit [Quit: Leaving.]
larhat has joined #ocaml
larhat has quit [Client Quit]
surikator_ has quit [Quit: Computer is sleeping. I'm probably not.]
ttamttam has quit [Remote host closed the connection]
avsm has quit [Quit: Leaving.]
junsuijin has joined #ocaml
fracek has quit [Quit: You are not prepared!]
avsm has joined #ocaml
thomasga has quit [Quit: Leaving.]
lpereira has joined #ocaml
jamii has joined #ocaml
_andre has quit [Quit: leaving]
ulfdoz has quit [Ping timeout: 256 seconds]
Kakadu has quit [Ping timeout: 276 seconds]
<sgnb> edwin: after looking closer, it seems that ocamlbuild does misbehave... the "if m = 0" branch in ocamlbuild_executor is blatantly wrong in the 5.7.2-1 case
<sgnb> IIUC, it assumes a job is finished if reading from an fd returned as ready-to-read by select, which is not true with dash 5.7.2-1
edwin has quit [Remote host closed the connection]
ikaros has quit [Quit: Ex-Chat]
lpereira has quit [Quit: Leaving.]
avsm has quit [Quit: Leaving.]
thomasga has joined #ocaml
thomasga has quit [Client Quit]
__marius__ has quit [Remote host closed the connection]
Amorphous has quit [Ping timeout: 256 seconds]
Amorphous has joined #ocaml
dnolen has joined #ocaml
Cyanure has quit [Read error: Operation timed out]
dnolen has quit [Quit: dnolen]
Old-User` has joined #ocaml
dnolen has joined #ocaml
dnolen has quit [Quit: dnolen]
sebz has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]