Banana changed the topic of #ocaml to: OCaml 3.08.1 available! | Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
monochrom has quit ["hello"]
pflanze has joined #ocaml
goomba has joined #ocaml
monochrom has joined #ocaml
Hanji has quit [Read error: 104 (Connection reset by peer)]
Hanji has joined #ocaml
gim has quit ["someil"]
hangman4 has joined #ocaml
mattam has quit [Remote closed the connection]
Herrchen has joined #ocaml
mrvn has joined #ocaml
mrvn_ has quit [Read error: 110 (Connection timed out)]
mlh has quit [Client Quit]
monochrom has quit ["hello"]
mlh has joined #ocaml
pango has quit ["Client exiting"]
pango has joined #ocaml
pharx has joined #ocaml
yakker has joined #ocaml
<yakker> i can't get about to setting breakpoints in ocamldebug - i keep getting "can't find any event" even though I've tried it on pattern matchings, function calls etc.
<yakker> i've compiled and linked my bytecode with -g
kinners has joined #ocaml
hangman4 has quit [Read error: 60 (Operation timed out)]
hangman4 has joined #ocaml
pharx has quit [Read error: 60 (Operation timed out)]
<mellum> Hmm. Is there any dirty trick to find out in Ocaml whether some value is a C NULL pointer?
pflanze has quit [Read error: 60 (Operation timed out)]
<mrvn> write a compare function?
<mellum> but how?
<mellum> without using C, I mean
<mrvn> Obj.Magic?
<mellum> And then?
<mellum> It would probably work if I store a null pointer smoewhere to compare against
<mellum> Or maybe (Obj.magic x) + 0 = 0
<mellum> but maybe Ocaml optimizes that away :)
<mellum> Oh well, I'll just do it in C.
<mrvn> That wouldn't have the int tag.
<mellum> mrvn: it should get ored in after a +
<mrvn> does it or does it subtract 1 after the + because it was in there twice?
<mrvn> (Obj.set_tag x Obj.int_tag) = 0
<mellum> Hm, probably the latter
<mrvn> Are your C types boxed?
<mellum> Yes.
<mrvn> Then why not decalre an C.null object and use the normal Persvasive.compare?
srv has quit [Read error: 104 (Connection reset by peer)]
<mellum> mrvn: that would probably do.
<mrvn> cleanest way
srv has joined #ocaml
vezenchio has joined #ocaml
kinners has quit ["leaving"]
mlh has quit [Client Quit]
smimou has joined #ocaml
smimram has joined #ocaml
pflanze has joined #ocaml
smimou has quit [Nick collision from services.]
smimram is now known as smimou
hangman4 has quit [Read error: 60 (Operation timed out)]
hangman4 has joined #ocaml
Submarine has joined #ocaml
pflanze has quit ["[x]chat"]
Herrchen has quit ["bye"]
Submarine has quit ["Leaving"]
monochrom has joined #ocaml
<mrvn> shit, my ocaml program segfaults.
<mellum> mrvn: stack overflow?
<mrvn> I guess that isn't caught as native code.
<mellum> it isn't, that would be quite expensive
<mellum> well, one could install a segfault handler and check it from there
<mrvn> mellum: via handler, yes. checking function calls would be insane.
<mrvn> let rec loop () =
<mrvn> Scanf.fscanf in_channel "%s%[^\n]"
<mrvn> (fun pkg name ->
<mrvn> loop ()
<mrvn> in
<mrvn> + 'Hashtbl.add db.maintainer pkg name);' beofr loop ()
<mrvn> That segfaults.
<mrvn> I thought Scanf.scanf would raise End_of_file at the end.
monochrom has quit [Remote closed the connection]
<smimou> mrvn: you could try to make this function tail recursive
<mrvn> It is.
<mrvn> I think the Hashtbl overflows and creates a segfault.
<smimou> mrvn: are you sur it is ? the recursive call is not the last call of the function, it's guarded by the fun (I might be wrong though)
<mrvn> the fun of the scanf is closed with ); and then loop()
<smimou> ah ok sorry
<mrvn> But Hashtbl shouldn't segfault without first exhausting my sawp.
<smimou> did you try a gdb ?
<mrvn> no.
<mrvn> Does ocaml native code has a limit on the heap size?
<mellum> Wouldn't think so. And segfaulting when hitting it would be silly
<Demitar> mrvn, pure caml and no third-party c extensions used?
<mrvn> Demitar: pure except unix.cmxa (which I plan to use but don't yet)
<mellum> mrvn: file a bug report :)
<mellum> what happens under the bytecode interpreter?
<mrvn> # let rec loop tbl = Hashtbl.add tbl 0 0 ; loop tbl;;
<mrvn> val loop : (int, int) Hashtbl.t -> 'a = <fun>
<mrvn> # loop (Hashtbl.create 0);;
<mrvn> Stack overflow during evaluation (looping recursion?).
<Demitar> mrvn, and this is 8.02?
<mrvn> Objective Caml version 3.08.1
<Demitar> I'd suggest you try it in the latest bugfix release really. :)
<mrvn> Any hashtbl fixes you know of?
<mrvn> Anyone have the latest ocaml?
<Demitar> No. But that's the kind of thing you always want to try before doing anything else.
<mellum> So Hashtbl.add is not tail recursive, or what is the problem?
<Demitar> mellum, but how could a stack overflow become a segfault?
<mellum> Demitar: That always happens in native code.
<mrvn> Demitar: native code doesn't do stack checking and linux kills it if it exceeds the stack limit.
<mellum> The problem is probably that all the zeros are hashed into the same bucket. Hashtbl is probably not optimized for that.
<mrvn> let bucket = Cons(key, info, h.data.(i)) in
<mrvn> hash collisions create a sort of list
* Demitar wonders who came up with that zany spec...
<vincenz> ?!?
<vincenz> That's how most hashtables work
<mrvn> 'let resize hashfun tbl =' isn't tail recursive.
<Demitar> (Referring to the segfault-on-stack-overflow.)
<mrvn> let rec insert_bucket = function
<mrvn> Empty -> ()
<mrvn> | Cons(key, data, rest) ->
<mrvn> insert_bucket rest; (* preserve original order of elements *)
<mrvn> let nidx = (hashfun key) mod nsize in
<mrvn> ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
<mellum> I think it's acceptable to assume users won't hash more than a few elements into the same bucket. So I wouldn't consider it a bug
<mrvn> Demitar: stacks automaticaly grow on use just like memory. If it can't grow you get a segfault.
<mrvn> mellum: yes. But if the parser doesn't terminate and adds "" "" that is what you get.
<Demitar> mrvn, I understand why it makes sense from a kernel perspective, but from the application perspective it's very odd behaviour indeed.
<vincenz> mrvn: parse'em out?
<vincenz> mellum: you can't just say "I assune so.... I'll let it slide"
<mellum> A sensible thing would be to send another signal than SEGV. But signal numbers are precious
<mrvn> Demitar: It is a bit hard to notice the reason for the segfault as user. It would be much better if ocaml had a segfault handler that checks for stack overflow.
<mrvn> vincenz: ??
<vincenz> 17:07 < mellum> I think it's acceptable to assume users won't hash more than a
<vincenz> few elements into the same bucket. So I wouldn't consider it a
<vincenz> bug
<mrvn> vincenz: hashes grow with the number of elements total. Getting a few thousand hash collisions means a very poor key distribution.
<mrvn> vincenz: And making it tail recursive just for that case is slower.
<mrvn> (unless you hack)
<vincenz> hmm
<vincenz> oh, I misinterpreted his statement
<vincenz> I thought he said it was ok to let it crash then
<mrvn> Well, it crashes with a stack overflow.
* vincenz nods
<vincenz> I know I know, disregard me :=
<pango> mrvn: export OCAMLRUNPARAM='l=10M' ?
<mrvn> pango: native code.
<vincenz> mrvn: filter out the ""
<pango> mrvn: should work too
<smimou> there's something strange
<mrvn> pango: hardly. The stack is limited by the OS.
<smimou> on a simple test it crashes with "Fatal error: exception Stack_overflow"
<smimou> in native mode
<smimou> not a segv
<mrvn> smimou: arch?
<vincenz> ^_^
<smimou> i386
<smimou> % cat toto.ml
<smimou> let rec f () = f (); 0
<smimou> let _ = f ()
<pango> mrvn: all I know is that it helps some compilations with ocamlc.opt... and ocamlc.opt is a native app, right ?
<mrvn> zsh: segmentation fault ./foo
<mrvn> Not on amd64.
<vincenz> hmm
<smimou> mmm...
<mrvn> pango: no, ocamlc.opt is the native code version of the to bytecode compiler.
<pango> mrvn: that's what I'm saying
<vincenz> cat: let rec f() = f(); 0\nlet _ = f(): No such file or directory
<mrvn> pango: But I'm compiling to native code.
<pango> mrvn: it prevents ocamlc.opt from crashing
yakker has quit [Read error: 110 (Connection timed out)]
<vincenz> Fatal error: exception Stack_overflow
<vincenz> Yip, that's on an amdxp
<vincenz> for that example shown above
<vincenz> ./exec -out echo -e "let rec f() = f(); 0\nlet _ = f()" > echo.ml&&ocamlopt echo.ml&&a.out
<mrvn> vincenz: But not an amd64 linux.
<vincenz> nope'
<mrvn> xp is just 32bit i386.
<vincenz> indeed
<vincenz> just giving a comparative case
<mrvn> Its probably just that ocaml doesn't know how to detect the stack on amd64.
<mrvn> But anyway, I fixed the source to not do it.
<vincenz> euhm, I'm pretty sure that ocaml most likely uses an os-func for that, so I doubt it's ocmal
<vincenz> but as mentioned, filter out the ""
<mrvn> vincenz: isn't an OS function, gcc has something for it but also not everywhere.
<vincenz> at every func-cal lsomething is inserted?
<mrvn> vincenz: no, the "" was because scanf didn't raise End_of_file.
<vincenz> ah
<mrvn> Scanf.scanf "%s" gives "" on EOF.
<pango> ah right, it's influenced by ulimit -s
<smimou> /* Machine- and OS-dependent handling of stack overflow */
<mrvn> smimou: hehe
<mrvn> Why isn't Getopt in stdlib?
<smimou> but :
<smimou> # Determine if system stack overflows can be detected
<smimou> case "$arch,$system" in
<smimou> i386,linux_elf|amd64,linux)
<smimou> echo "System stack overflow can be detected."
<smimou> echo "#define HAS_STACK_OVERFLOW_DETECTION" >> s.h;;
<smimou> so it should be there on amd64, no ?
<mrvn> How does it detect $arch? could be the gnu arch meaning x86_64.
<smimou> case "$host" in
<smimou> x86_64-*-linux*) arch=amd64; system=linux;;
<smimou> x86_64-*-freebsd*) arch=amd64; system=freebsd;;
<smimou> x86_64-*-openbsd*) arch=amd64; system=openbsd;;
<smimou> aren't you running linux ?
<mrvn> yes
<smimou> it's strange then
<mrvn> Configuring for a x86_64-unknown-linux-gnu ...
<mrvn> Wow! A 64 bit architecture!
<mrvn> rofl
<smimou> :)
<vincenz> ?
<mrvn> Cannot detect system stack overflow.
<mrvn> I'm reading the configure output.
<mellum> Wow! They have only been around since like 1992!
<vincenz> That Wow came from configure ?!?
<vincenz> rofl
<vincenz> Now I get your rofl
<vincenz> I thought you were being sarcarstic and I didn't see the humor
<mrvn> smimou: You have 3.08.2?
<smimou> well I checked from the cvs
<smimou> oh it's not in 3.08.1
<mrvn> smimou: Seems to be fixed in cvs then.
<smimou> indeed
<mrvn> I wonder why it doesn't work for more linuxes.
<mellum> mrvn: nobody implemented it, I guess
<mellum> It's not like every time you throw an i386 box oit of the window, you hit a MIPS Linux Ocaml developer.
CosmicRay has joined #ocaml
<mrvn> Thank god, there would be none left by now.
<vincenz> LOL
<smimou> hehe
<vincenz> What's the bonus of an amd64bit?
<mrvn> 32 extra bit. Gives you a nice alcohol level.
<vincenz> euhm..
<vincenz> no seriously
<vincenz> why go for a 64bit?
<mrvn> (Bit == Bitburger, german beer)
<vincenz> ah
<mrvn> I have one, cheaper than a pentium. And then why not use it?
<mrvn> It is nice to have 63 bit ints instead of 31.
* vincenz is going to buy a laptop,
<mrvn> and strings/arrays > 16MB.
<vincenz> but 64bit is most likely not a good idea...
<vincenz> 16MB?!?
<vincenz> that's it?
<mrvn> 8 tag bits, 24 bits for the size of a string
<vincenz> yick
<mrvn> yes. severe limit on 32bit.
<mrvn> If you need more on 32bit you have to use a BigArray of char or something.
<vincenz> but an amd64bit is most likely not a good choice for a laptop, right?
<mrvn> They seem fine although I would expect them to be quite warm. But is a P4 any cooler?
<mrvn> Several people on #debian-amd64 have one.
<vincenz> hmm
<vincenz> doesn't it kill batterylife?
* vincenz is considering a centrino
vardhan has joined #ocaml
vardhan has quit ["Leaving"]
Smerdyakov has quit ["Client exiting"]
<mrvn> I have a getopt.ml here that requires "--foo=arg" for long options. Does anyone know one that can also do "--foo arg"?
<mellum> mrvn: I think there's one in extlib
<mrvn> mellum: no debian package?
<mellum> mrvn: libextlib-ocaml-dev - extended standard library for OCaml
<mrvn> stupid name.
<mellum> Which reminds me, the dynarray from extlib segfaulted for me, abnd I never got around to tracking it
<mellum> oh well.
<vincenz> Why don't they put extlib in the std-ocaml-distro?
Submarine has joined #ocaml
<mrvn> The extlib/optParse.cmi is younger than the mli. That realy sucks.
<vincenz> bad timestamps?
<vincenz> touch em both
<mrvn> Makes the debian package quite useless to users.
<Demitar> mrvn, file a bug report against the debian package.
<Demitar> vincenz, the whole stdlib complete-or-not has been argued back and forth on caml-list already, read the archive.
<vincenz> Alright, thnx
<mrvn> Demitar: already done
pango has quit ["brb"]
mflux has quit [tolkien.freenode.net irc.freenode.net]
pacroon has quit [tolkien.freenode.net irc.freenode.net]
mflux has joined #ocaml
<mrvn> OptParse in extlib seems to be somehow broken. I have a value_option and the coercion function gets called but the value always remains the default.
pacroon has joined #ocaml
pango has joined #ocaml
<mrvn> doh, the partial evaluation killed it.
det has quit [Read error: 60 (Operation timed out)]
mattam has joined #ocaml
<Submarine> Bures sur Yvette?
<vincenz> Koi?
* Submarine regarde le hostnam de mattam
<vincenz> c koi "bures"?
<Submarine> Bures-sur-Yvette est un village au sud-ouest de Paris
<Submarine> principalement connu pour l'IHES, et pour être une banlieue où vivent plein d'universitaires
<vincenz> Ah, je pensais que burer etait un verb et qu'yvette etait une college
<vincenz> collegue
monochrom has joined #ocaml
goomba has quit [Read error: 104 (Connection reset by peer)]
tyler has joined #ocaml
<tyler> What is the best way to create a 3-dimenional array of a simple type such as an int? (Actually, I really only need a bit...)
<tyler> that is, an array of a sixe d x d x d
<tyler> and I need each cell to be a boolean value
<Nutssh> Create a 'bool array array array'. (And let the type be your guide.)
<tyler> the logical nested Array.make doesn't work because it shares the int
<tyler> doesn't work with bools either
<tyler> # let x = Array.make 3 (Array.make 3 true);;
<tyler> val x : bool array array = [|[|true; true; true|]; [|true; true; true|]; [|true; true; true|]|]
<tyler> # x.(0).(0) <- false;;
<tyler> - : unit = ()
<tyler> # x ;;
<tyler> [|[|false; true; true|]; [|false; true; true|]; [|false; true; true|]|]
<tyler> - : bool array array =
<Nutssh> You mean shared the int array. Use Array.init Array.init (fn _ -> Array.init ....)
<vincenz> use init
<tyler> ok
<tyler> is there any way to use a 'packed' array?
<tyler> like store each boolean as one bit of a byte
<tyler> I'm sure it could do it myself
<tyler> but it's more of a 'nice to have' and not nessesary, for now
<vincenz> tyler: look at bitset
<vincenz> in ocaml extlib
* vincenz aways
<mrvn> tyler: It does not share ints, it shares the int array.
goomba has joined #ocaml
tyler has quit ["leaving"]
Submarine has quit ["Leaving"]
det has joined #ocaml
smimou has quit ["?"]
Smerdyakov has joined #ocaml
vezenchio has quit ["smile, Rakka ..."]