flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
seafood has quit []
LordMetroid has quit ["Leaving"]
|jedai| is now known as Jedai
redocdam has quit []
marmotine has joined #ocaml
marmotine has quit [Client Quit]
jlouis has quit ["Leaving"]
Morphous_ has joined #ocaml
Chile` has quit [Remote closed the connection]
Chile` has joined #ocaml
Morphous has quit [Read error: 110 (Connection timed out)]
Ched- has quit [Read error: 110 (Connection timed out)]
Ched- has joined #ocaml
sponge45 has quit ["see you at http://ocamlhackers.ning.com/"]
seafood has joined #ocaml
delamarche has joined #ocaml
<seafood> Anyone here got some good pointers to the memory layout of OCaml data structures?
guillem has quit [Remote closed the connection]
<seafood> Ahah. The original OCaml book has a lot of on this topic!
delamarche has quit []
netx303 has joined #ocaml
TypedLambda has quit [Read error: 110 (Connection timed out)]
ramenboy has joined #ocaml
Jedai has quit [Read error: 110 (Connection timed out)]
netx303 has left #ocaml []
filp has joined #ocaml
filp has quit [Client Quit]
bluestorm has joined #ocaml
bluestorm has quit [Remote closed the connection]
bluestorm has joined #ocaml
bluestorm_ has joined #ocaml
bluestorm_ has quit [Client Quit]
Snark has joined #ocaml
mishok13 has joined #ocaml
filp has joined #ocaml
filp has quit [Client Quit]
Kopophex has quit ["Leaving"]
<tsuyoshi> seafood: best thing to do is read the header files
<tsuyoshi> the book has an introduction but it doesn't cover everything
<tar_> It can solve "easy" puzzles (yay)
oc13 has joined #ocaml
<bluestorm> tar_: how could a backtracking solver not solve every puzzle ?
<tar_> I haven't finished back-tracking.
<vixey> bluestorm: If it's depth first puzzles that have cycles might never be solved
<tar_> At least sudoku shouldn't ever have cycles
<tar_> Learning to fold has been mind-bending
<vixey> What's the ML "forall + ref" bug?
bluestorm has quit [Remote closed the connection]
asmanur has joined #ocaml
philip__ has joined #ocaml
oc13 has quit [Read error: 110 (Connection timed out)]
guillem has joined #ocaml
hkBst has joined #ocaml
munga has quit ["Leaving"]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
zhoupp has joined #ocaml
redocdam has joined #ocaml
seafood has quit []
zhoupp has quit []
philip__ has quit [Read error: 110 (Connection timed out)]
m3ga has joined #ocaml
hkBst has quit [Remote closed the connection]
hkBst has joined #ocaml
seafood has joined #ocaml
mattc58 has joined #ocaml
sponge45 has joined #ocaml
seafood has quit []
mattc58 has left #ocaml []
m3ga has quit ["disappearing into the sunset"]
tomh has joined #ocaml
RobertFischer has joined #ocaml
asmanur has quit [Read error: 110 (Connection timed out)]
marmotine has joined #ocaml
tar_ has quit []
<RobertFischer> I've done something like match ((a::b) as seg)::lst -> (seg,lst) | _ -> ([],[]) before -- but "as" isn't the right syntax there. What is?
<vixey> why is "as" not the right syntax?
<RobertFischer> vixey: Because it gives me a syntax error in the toplevel?
<RobertFischer> vixey: Hold up.
<RobertFischer> vixey: Typo. Problem solved.
<vixey> what was the problem ?
redocdam has quit [Remote closed the connection]
<Smerdyakov> No spaces before question marks in English!
<RobertFischer> vixey: I had it in an explicit argument context, so I had to do a "match x with" structure.
<vixey> hehe
<vixey> Smerdyakov: does it bug you ?
<Smerdyakov> vixey, yes.
dobblego has quit [Read error: 113 (No route to host)]
<vixey> RobertFischer: ok.. I don't even know what that is yet
<vixey> Smerdyakov: *tries to stop*
tar_ has joined #ocaml
tar_ has quit [Client Quit]
tar_ has joined #ocaml
RF_Smokejumper has joined #ocaml
tomh has quit ["http://www.mibbit.com ajax IRC Client"]
dobblego has joined #ocaml
Linktim has joined #ocaml
RobertFischer has quit [Read error: 110 (Connection timed out)]
asmanur has joined #ocaml
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
LordMetroid has joined #ocaml
bluestorm has joined #ocaml
<jonafan> I wrote most of a scheme interpreter last night
<vixey> jonafan: Is it online? I would be interested to see it
<jonafan> well i don't have the lexer and parser written
<jonafan> i guess it's more of a scheme evaluator
<jonafan> i don't know how ocamllex and ocamlyacc work
<vixey> I wrote a bit of a Prolog parser using those tools
<vixey> I think it's quite straightforward there is a good example in the ocaml manual
<jonafan> interesting idea... i could look at the documentation!
<bluestorm> you could even try a recursive descent parser (with integrated lexer), i think for scheme it would work quite well
<bluestorm> and is lighter to set up than a lexx/yacc duo
<jonafan> i'll remember those words, but i really have no idea what you are saying at this moment
<jonafan> this is my first attempt at an interpreter
<bluestorm> have you played with streams once ?
<jonafan> a little i guess
tar_ has quit []
tar_ has joined #ocaml
tar_ has quit [Client Quit]
mishok13 has quit [Read error: 104 (Connection reset by peer)]
guillem has quit [Remote closed the connection]
bluestorm has quit [Remote closed the connection]
letrec has joined #ocaml
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
RF_Smokejumper has left #ocaml []
Katen has joined #ocaml
tar_ has joined #ocaml
tar_ has quit [Client Quit]
rwmjones has quit ["Closed connection"]
Katen has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
redocdam has joined #ocaml
filp has joined #ocaml
Morphous has joined #ocaml
<vixey> Does anyone know what the ML "forall + ref" bug is?
<Smerdyakov> It's a historical reference. No relevance to OCaml or SML.
<vixey> Smerdyakov: Is it acceptable to ask what it is here?
<Smerdyakov> If you find an explanation of why the value restriction is necessary, this will probably be covered there.
seafood has quit []
<mfp> does anybody know why Lazy.force is so expensive? It takes 10 times as many instructions (and I think I read somewhere that it amounted to ~70 cycles) as a trivial operation with a type 'a lazy = { mutable v : 'a option; f : unit -> 'a }
<mfp> or type 'a lazy = { mutable v : 'a; mutable set : bool; f : unit -> 'a } if you want to avoid the extra dereference
<vixey> thank you Smerdyakov
<mfp> (w/ the std Lazy module, the GC "de-conses" the value when forwarding the pointers)
Morphous_ has quit [Connection timed out]
zbrown has quit ["Changing server"]
zbrown has joined #ocaml
tar_ has joined #ocaml
tar_ has left #ocaml []
zbrown has left #ocaml []
Kopophex has joined #ocaml
<mfp> self-reply: after minor GC, the thunk is discarded and the 'a lazy.t is replaced by the 'a, avoiding further dereferences and possibly a L2 miss
<mfp> *Lazy.t
sporkmonger has joined #ocaml
<asmanur> mfp: so Lazy.force should not be more expensive ... ?
<mfp> it seems it should be faster after a minor GC run, if the data doesn't fit in the cache
<mfp> and slower if you Lazy.force repeatedly before GC
<asmanur> hum ok
<vixey> what is it about L2 cache?
<mfp> vixey: the GC bypasses the thunk when doing a minor GC run, patching references to the 'a lazy to point to the 'a directly
<mfp> => one less dereference
<mfp> hmm it seems Lazy.force could be made nearly 2X faster by declaring Obj.tag with "noalloc" (which seems safe: I see no allocation/exceptions there, and the function doesn't use CAMLparam*...)
<mfp> saving ~10 insns in caml_c_call + indirect branch which will be mispredicted (= 10-20 cycles)
bluestorm has joined #ocaml
RobertFischer has joined #ocaml
asmanur has quit [Read error: 110 (Connection timed out)]
r0bby has quit [Client Quit]
r0bby has joined #ocaml
LordMetroid has quit ["Leaving"]
<jonafan> does anyone know how yacc works?
Yoric[DT] has joined #ocaml
Linktim_ has joined #ocaml
Axioplase_ is now known as Axioplase
<bluestorm> jonafan: do you need documentation or have any more precise question ?
<jonafan> fairly precise
<bluestorm> yes, i assume some one on earth knows how yacc works.
<jonafan> i'm not sure how to set it up to get the list of variable names from lambda expressions
<jonafan> (lambda (how do i get this stuff) (blah blah blah ...)
<vixey> why does it matter that its lambda
<vixey> just parse everything as s-expressions uniformly
<jonafan> everything else in my interpreter has a set number of arguments thus far
<bluestorm> hem, don't you have lists everywhere ?
<bluestorm> even + doesn't have a fixed number of arguments in scheme iirc
<vixey> (+) ;=> 0
<jonafan> i have pretty much the same question about arguments to functions
<vixey> (+ 1 2 3 4 5) ;=> 15
<vixey> jonafan: Have you heard about eval/apply?
RobertFischer has left #ocaml []
<jonafan> eh?
Linktim has quit [Read error: 110 (Connection timed out)]
<vixey> Are you answering my question by saying "eh?"
<jonafan> i guess so
<jonafan> I don't know what you mean
Kopophex has quit ["Leaving"]
asmanur has joined #ocaml
filp has quit [Read error: 113 (No route to host)]
Proteus_ has quit [Read error: 113 (No route to host)]
Proteus_ has joined #ocaml
asmanur has quit [Remote closed the connection]
asmanur has joined #ocaml
Linktim_ has quit ["Quitte"]
Kopophex has joined #ocaml
asmanur has quit [Remote closed the connection]
filp has joined #ocaml
ofaurax has joined #ocaml
filp has quit ["Bye"]
<msinhore> gildor, hi
<msinhore> gildor, did you look my package? Is unsure yeat :)
Snark has quit ["Ex-Chat"]
Snrrrub has quit []
Yoric[DT] has quit ["Ex-Chat"]
<gildor> msinhore: hi
ofaurax has quit ["Leaving"]
LordMetroid has joined #ocaml
<gildor> msinhore: well I have some "pending" issue to close about bitmatch
<gildor> msinhore: and concerning your package i was unsure that you send me the latest version since you seemed to have solved issue after having send it to me
<gildor> msinhore: resend me the package
<gildor> if something has been updated
netx has quit [Read error: 110 (Connection timed out)]
netx has joined #ocaml
marmotine has quit ["mv marmotine Laurie"]
<Chile`> I'm playing around with functional programming in general for pretty much the first time, had a few questions about implementing generic memoization for recursive functions (the memo function is out of Hickey's intro to ocaml)
<Chile`> http://rafb.net/p/eUK35U97.html this was my implementation in C++, which works as expected
Associat0r has joined #ocaml
<Chile`> http://ocaml.paste.f-box.org/86 these were some of my stabs at it in ocaml. I'm confused especially as to why the bottom attempt fails
<Chile`> are either of my attempts close to valid? actually, even better, what would be the preferred way to write this?
<dobblego> @google simon peyton-jones weak pointers
<dobblego> oops
* Smerdyakov reads Chile`'s code.
<Smerdyakov> Chile`, peculiar way of doing things. Do you understand why the first attempt doesn't memoize anything but top-level calls?
<Chile`> right, because plain_fib calls itself recursively & not the memoized
<Chile`> I realize the first one is useless
<Smerdyakov> I don't understand what you are trying to do in the second attempt well enough to critique it. Clearly it doesn't make sense type-wisew.
<Chile`> fair enough. it was an attempt to use mutually recursive definitions to actually apply f (the memo function to be passed in) each time, instead of at top level only
<Smerdyakov> I hope you at least understand what the error messages are saying.
lde has quit [Read error: 104 (Connection reset by peer)]
<Chile`> the error about 'this kind of expression not allowed' wasn't terribly clear, since 'let [rec] foo = f other_fun' works outside of the mutually recursive defn
<Smerdyakov> I'm surprised if it works with [rec].
<Smerdyakov> [let rec] is only for [fun x -> ...] bodies, and syntactic sugar that achieves the same effect.
rwmjones has joined #ocaml
<Chile`> 'let rec fib_memo = f fib_internal' doesn't give me an error if fib_internal is already defined
<Chile`> (nor a warning)
<vixey> oh I want to try this
<Smerdyakov> Chile`, if you write a non-recursive [let rec], I guess the type-checker treats it like [let]..
<bluestorm> Smerdyakov: there are specific rules for immediate recursive values
<bluestorm> eg. let rec ones = 1 :: ones works, but let rec ones = cons 1 ones won't
<vixey> how can let rec ones = 1 :: ones work?
<vixey> if you try to take the hd will it diverge?
<bluestorm> nope
<bluestorm> but List.length certainly will
<bluestorm> vixey: immediate recursive algebraic data types are not diffuclt to implement or understand
<vixey> that is not a data type
<bluestorm> yes, :: is an ADT constructor
<Smerdyakov> bluestorm, I don't think this case depends on the rules for immediate recursive values. I think it's just realizing there is no recursion and pretending there was no [rec].
<vixey> I think it's a value not a type
<bluestorm> :: is a constructor, not a function
<bluestorm> ok
<bluestorm> you mean i should have said "values from immediate recursive algebraic data types" ?
<bluestorm> hm
<bluestorm> immediate recursives values from ..., actually
<bluestorm> fair enough
<vixey> how is this?
<vixey> ocaml <file>.ml
<vixey> it just checks the code it doesn't go into the repl
<bluestorm> try in the toplevel directly
<bluestorm> Chile`: your C++ approach is unelegant because you actually have to insert memoization-related code _inside_ the fib declaration
<bluestorm> can't you do that transparently (that is, add memorization to a memo-unaware function) ?
<Chile`> not for recursive functions as far as I know
<bluestorm> hm
<Chile`> I'm alright with allowing for memoization-related code as long as its generic
<Chile`> and there's no code duplication
<bluestorm> you could write an untied function instead
<vixey> I got a stack overflow
<bluestorm> let untied_fib f n = if n <= 1 then n else f (n - 1) + f (n - 2)
<bluestorm> vixey: how ?
<bluestorm> then Chile`
<bluestorm> let rec rec_fib n = fib rec_fib n
<bluestorm> let rec rec_fib n = untied_fib rec_fib n, sorry
jlouis has quit [Read error: 54 (Connection reset by peer)]
<vixey> oh you can't make lazy lists
<bluestorm> vixey: they're not lazy
<bluestorm> they're only infinite
<bluestorm> let rec memo_fib n = untied_fib (memoize (memo_fib n)) may work
<bluestorm> hm
jlouis has joined #ocaml
<bluestorm> let rec memo_fib n = untied_fib (memoize memo_fib) n actually
<bluestorm> vixey: if you want lazy-lists, there are several implementations available, though not in the stdlib
<vixey> I've got this type 'a list = Nil | Cons of 'a * 'a list;;
<bluestorm> ?
<vixey> type 'a list = Nil | Cons of 'a * 'a list lazy_t;;
<vixey> is the lazy version
<bluestorm> hm
<bluestorm> depends on how lazy you want it : it's strict on the head
<bluestorm> type 'a llist = 'a cell lazy_t and 'a cell = Nil | Cons of 'a * 'a llist is lazier
<vixey> oh I wrote mi version but it doesn't seem to actually memoize
<vixey> what is cell?
<bluestorm> those are two mutually recursive types
<bluestorm> llist and cell
<vixey> oh right
<vixey> in said "If x has already been forced, force_val x returns the same value again without recomputing it" :/
<bluestorm> ?
<vixey> but it doesn't seem to memoize
<bluestorm> i think it does. do you have any code ?
<vixey> yes
<vixey> I think this is the problem, and fibs () = map fib (up 0);;
<vixey> I wanted ot write fibs = map fib (up 0)
<vixey> but it's not allowed maybe this is because of the value restriction
<bluestorm> hm
<bluestorm> if you lazyfied a function, of course the forced function is evaluated again when you give it a parameter
<vixey> I don't think that's possible
<bluestorm> vixey: each fibs () call returns a new list
<vixey> yeah I don't think it's possible to avoid that
<vixey> so this method seems impossible
<vixey> you know the error, This kind of expression is not allowed as right-hand side of `let rec'
<vixey> is that the value restriction?
<vixey> is there a flag to turn it off?
<bluestorm> vixey:
<bluestorm> let rec fib a b = Cons (a, lazy (fib b (a + b)));;
<bluestorm> let fibs = fib 0 1;;
<Chile`> oh, interesting. this has already been played out on the list
<Chile`> er, or on the fa.caml group
<bluestorm> Chile`: there are syntaxical extension for automagic memoization, they could support recursive functions quite easily
<Chile`> bluestorm: good to know. the point was more to play around with the language than to actually memoize anything, since I'm trying to get out of my C++ mindset.
<bluestorm> thanks
<bluestorm> hm
<bluestorm> seems they propose the untied version first, and then suggest a syntaxic transformation :p
<bluestorm> haha
<bluestorm> and the code for lazyness is quite hackish
LordMetroid has quit ["Leaving"]
<bluestorm> i remember having written something similar for a far-fetched recursion function
<bluestorm> let rec value = lazy (Utils.memoize @$ fun name -> ...
<vixey> why is lazyness so awkward in ocaml?
<vixey> in Oz is it fine ...
<vixey> I mean shouldn't Lazy.force be implicit?
<vixey> (or force_val)
<bluestorm> vixey: i have no knowledge of Oz, but making force implicit looks like a strange idea
<bluestorm> if you're talking syntax, there are syntax extension that ease the pain
<bluestorm> similar to what Okasaki suggested
<vixey> oh
<vixey> I don't understand why the added the lazy keyword to ocaml
<vixey> is it not possible to just implement it in a library?
<bluestorm> the keyword has to have syntaxic support
<bluestorm> but yes you can implement lazyness in a library
<bluestorm> but if lazy was a function, you'd have to use something like lazy (fun () -> value)
redocdam has quit []
Axioplase is now known as Axioplase_