flux changed the topic of #ocaml to: Yes, inria.fr is back up! | Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0beta1 available from http://caml.inria.fr/pub/distrib/ocaml-3.11/ | Or grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html
longh has quit [Read error: 104 (Connection reset by peer)]
Palace_Chan has quit [Read error: 110 (Connection timed out)]
jknick has joined #ocaml
alexyk has joined #ocaml
<alexyk> I try to compile pgocaml, which needs calendar.cma -- but my godi install has only calendar.cmi... how do I make cma?
<alexyk> how can I see which cmo's are inside a cma?
ched_ has joined #ocaml
_andre has quit ["Lost terminal"]
ched has quit [Read error: 110 (Connection timed out)]
johnnowak has joined #ocaml
orbitz has joined #ocaml
alexyk has quit []
<Squirrel> Is there a quick way to check that a list of elements has no repeated elements ? (all unique) ?
<Raevel> quick as in complexity or quick as in a built in function?
<johnnowak> Squirrel: sort and iterate?
<Squirrel> quick as in easy/short no big deal with time complexity since these are short
<Squirrel> sort and iterate ? hmm iterate applies a function to each element
<Squirrel> it would have to remember the previous to check for two consecutively equal elements after a sort
<johnnowak> er -- didn't mean the iterate function. i mean sort it then iterate over the list checking for equality.
<orbitz> hehe
<orbitz> is there no unique function for lists?
<orbitz> i guess not
<dibblego> orbitz, nub?
<dibblego> > nub [1,2,3] == [1,2,3,3]
<dibblego> I imagine if you had Ord you could sort it first, but otherwise...
<orbitz> dibblego: get lost on your way to #haskell ?
<dibblego> oh oops :)
<dibblego> sorry
<orbitz> :)
<Raevel> heh
<Raevel> okay, i can't do recursion at night
<Squirrel> johnnowak, so i can sort it, but going through it i would have to compare consecutive elements, would you for loop ? (new to ocaml and using a looooot of recursion)
<johnnowak> i'd use fold
alexyk has joined #ocaml
<Raevel> Squirrel: you could loop through and check that the head of the list isnt also in the tail
<johnnowak> ow
<Raevel> i can't think of how to solve it with fold -- my head hurts
<Squirrel> Raevel, oh nice..would you loop with a for loop ?
<Raevel> well, doing that or using a recursive function won't make a difference
<Squirrel> think i got it recursively...now i gotta struggle with the typechecker...... :(
<Raevel> :-)
jeddhaberstro has quit []
<johnnowak> that'll help your head!
<johnnowak> that's exponential time
<johnnowak> not awful given the problem
<Raevel> true, what about yours?
<johnnowak> linear + whatever the sort is
<orbitz> exponents are sexy though!
<Raevel> orbitz has a point
<johnnowak> Raevel: my implementation is something of a joke
<orbitz> that's one way to put it
<orbitz> high five anyone?
<Raevel> it did look a little verbose, yes
<Raevel> but i've been doing ocaml for a week so what do i know
<orbitz> hah
<johnnowak> i'm so used to programming with combinators in concatenative languages
<johnnowak> doing the same thing ocaml is painfu
<Raevel> okay i forget, how do i curry a binary operator?
<orbitz> johnnowak: what language do you usually use?
<palomer> ugh
<palomer> I have to restart my application every 10 minutes
<johnnowak> orbitz: the one i'm working on primarily...
<Raevel> oh, too easy n/m
<orbitz> what is a concatenative language
<johnnowak> a language based on function composition instead of function application
<palomer> HOF!
<Raevel> "See also - Pointless programming"
<johnnowak> pfft
<Raevel> johnnowak: it's right there --> http://en.wikipedia.org/wiki/Concatenative_language
<johnnowak> yes it is
<Raevel> oh well
<johnnowak> uniq = unxs[t, _f -x each[+[eq? and]] k]
<johnnowak> is how i'd write it in the second order concatenative language i'm working on
<Raevel> oo
<johnnowak> er. forgot to sort.
<orbitz> ah, so something liek J?
<johnnowak> sort[cmp] unxs[#t, _#f -x each[keep[eq? and]] k] -- better
<johnnowak> a lot like J, yes
<johnnowak> but J is still based on application
<johnnowak> heh, but you see.. when you think like that, you end up writing that sort of gibberish ocaml code
<orbitz> hah
Squirrel has quit ["Leaving"]
* orbitz has been meaning to learn J
* palomer has a sneaky feeling he has a memory leak
<palomer> how do I find memory leaks?
* palomer is starting to really dislike gtk
<johnnowak> oh there's more to come
<thelema> johnnowak: reminds me of programming in RPL (the HP48 Reverse Polish Lisp dialect)
<johnnowak> thelema: aye, it is postfix
<palomer> how do I time a function?
<thelema> palomer: Sys.time () - start_time
<thelema> err, -.
<palomer> http://ocaml.pastebin.com/m683b2221 <--this little program takes up TONS of memory
<palomer> its very simple
<palomer> it creates a text view
<palomer> and then removes/inserts 100 text entrys
<palomer> every time you press a key
<palomer> it very quickly gets up to 100 megs
<palomer> what gives?
<palomer> (it also gives a ton of uim warnings)
<thelema> so you're making *tons* of entries in your GText?
<thelema> you sure the entries get removed?
<thelema> I guess they should be, but is there a way to check?
<palomer> clearTextBuffer should remove them
<palomer> and, visually, it does
<thelema> ok.
<palomer> now I don't know if there's any stray pointers
<palomer> you can also do the same with a vbox
<palomer> here's the code:
<thelema> you might have to destroy your Gedit.entry objects
<palomer> how do you destroy?
<palomer> there's no destroy method
<thelema> somewhere.
<palomer> gtkobj#destroy?
<thelema> sounds good.
<palomer> let's see what happens...
<thelema> gtkBase.Object#destroy
<thelema> err, not method.
<thelema> GtkBase.Object.destroy obj
<palomer> no go
<palomer> #destroy doesn't work
<palomer> let's try yours
<palomer> im guessing I have to cast, right?
<thelema> to [>`gtk] obj
<palomer> #as_widget ?
<thelema> maybe past that...
<palomer> same thing happens
<palomer> I'm using the vbox example
<palomer> (cleaner)
<palomer> I included both destroying ways
<palomer> one of them commented
<thelema> can you put n a forced GC after destroying?
<palomer> how?
* thelema looks it up
<thelema> Gc.full_major ()
<thelema> also, check Gc.allocated_bytes ()
<thelema> although maybe that won't count any lablgtk bytes, because of its separate pool...
<palomer> checking...
<palomer> 6019440.
<palomer> (test2.o:24161): Gtk-WARNING **: Loading IM context type 'uim' failed <--im getting TONS of these errors though
<palomer> kind of worrisome
<palomer> 6223864.
<thelema> IM context? hmmm...
<palomer> started at 4588508.
<palomer> so allocated_bytes hasn't increased much
<palomer> that's only when I press quickly
<thelema> if the memory still shooting up?
<palomer> it shoots up every time I press quickly
<palomer> same as before
<thelema> but it goes back down?
<palomer> nope
<thelema> it doesn't shoot up if you press slowly?
<palomer> hard to tell
<palomer> well, of course it doesn't shoot up
<palomer> but it's hard to tell if it will if I continue for a long period of time
<palomer> how do I set a timer?
<thelema> how many alloc/dealloc loops do you do?
<palomer> every time I press a key it creates and removes 100 entries
<thelema> timer for an event to happen or to measure time passed?
<palomer> yeah
<palomer> ill make it happen every third of a second and ill see what happens
<palomer> after a couple of minutes
<thelema> I usually use Glib.Idle, but I think there's a timed version too...
<thelema> ignore(Glib.Timeout.add 333 (fun () -> do stuff; false))
<palomer> 333ms?
<thelema> yup
alexyk has quit []
<thelema> val add : ms:int -> callback:(unit -> bool) -> id
<thelema> actually, you probably want to return true, so your event gets re-scheduled
<palomer> doesn't do anything
<palomer> ahh
<palomer> righto
<palomer> true
<palomer> sure enough, it takes up more and more memory
<palomer> the bytes_allocated also goes up
<thelema> correspondingly to the top usage, or much less?
<palomer> it corresponds
<thelema> so it's probably ocaml usage and not gtk... hmmm
<palomer> as in
<palomer> initial top/initial bytes allocated = current top / current bytes allocated
<palomer> but bytes_allocated is only at 13651128.
<palomer> 13 megs
<palomer> top usage is 36 megs
<palomer> (RES)
<palomer> but yeah, same ratio
<thelema> hmm, when I compile that program, I get a flurry of Gdk-CRITICAL messages and a seg-fault
<palomer> whoa
<palomer> what are you using?
<palomer> remove the call to destroy
<thelema> still segfaults without the destroy call
<thelema> I'm using a CVS build of ocaml (not current, as I can't compile type-conv with current CVS)
<thelema> and lablgtk 2.10.1 built from source
<palomer> oh my
<palomer> lemme write you something...
<palomer> try that
<palomer> it doesn't remove the widgets
<palomer> and adds 3 every 1.2 seconds
<palomer> does that work?
<thelema> nope, still segfaults.
<thelema> no window even shows
pango has quit [Remote closed the connection]
<palomer> whoa
<palomer> that's just plain weird
<palomer> remove the timeout call
<johnnowak> sa
<johnnowak> oops
<thelema> well, no segfault this time.
<thelema> it just hangs.
pango has joined #ocaml
<thelema> There's a bunch of messages along the lines of
<thelema> (process:4111): Gtk-CRITICAL **: gtk_style_attach: assertion `window != NULL' failed
<palomer> if you remove the timeout call
<palomer> all it is is a window and a vbox
<palomer> that should definately work
<thelema> I'm probably compiling wrong, wait a sec
<palomer> http://ocaml.pastebin.com/m76453276 <--this is what its equivalent to
<thelema> ok, fixed. GtkMain.Main.init wasn't happening.
* thelema puts the timeout back
<palomer> don't forget the container_clear
<palomer> and setting the time to 200 ms or something
<palomer> 100ms gives me funky warnings
<palomer> and inserting 100 widgets at a time
* thelema looks forward to jacques' response on the lablgtk list
<palomer> me too
<palomer> this seems like a big bug
<thelema> or a misuse of the library
<palomer> according to the gtk documentation:
<palomer> gtk_container_remove ()
<palomer> Removes widget from container. widget must be inside container. Note that container will own a reference to widget, and that this may be the last reference held; so removing a widget from its container can destroy that widget. If you want to use widget again, you need to add a reference to it while it's not inside a container, using g_object_ref(). If you don't want to use widget again it's usually more efficient to simply destroy
<palomer> it directly using gtk_widget_destroy() since this will remove it from the container and help break any circular reference count cycles.
<palomer> is there any way to reset gtk?
<palomer> I can simple include a reload button to my system if it did
<thelema> ?? like destroy all top-level objects and re-run Gtkmain.Main.init ()?
<palomer> yeah
<palomer> free all the memory
<thelema> it's a bad solution, even if it does work.
<palomer> hrmph...
<palomer> double hrmph...
<palomer> there IS a hack around this
<palomer> but it's a little ugly
pierre- has joined #ocaml
<palomer> (for my specific application)
<palomer> but it's dog ugly
<thelema> then don't do it.
<palomer> but it stops me from destroying the widgets in the first place
<palomer> by reusing them
<palomer> heck, that's an easy solution enough
<thelema> that doesn't necessarily sound ugly.
<palomer> so I'll have this widget factory
<palomer> rather, entry factory
<palomer> which stores every entry it has created
<palomer> and simply checks if one of them is no longer needs it
<palomer> and returns that one (instead of creating a new one)
<thelema> you could have an idle task that recycles unneeded entries into a pool
<palomer> oh my
<palomer> that's also a good idea
<palomer> I was thinking of just attaching a bool ref to each entry
<palomer> and storing these pairs
<thelema> ?? just remove the widget from its container and store it in a stack or queue.
<thelema> or whatever lightweight structure you like.
<palomer> that works too
<palomer> (I'll use a list)
* palomer is not a big fan of fancy datastructures
<thelema> RefList
<thelema> let empty () = ref []
<thelema> let push rl item = rl := item::!rl
<thelema> let pop rl =
<thelema> match !rl with
<thelema> | [] -> raise Empty_list
<thelema> | e::l -> rl := l; e
<palomer> http://ocaml.pastebin.com/m189304c3 <--my solution
<palomer> oh, forgot to make sofar mutable
<thelema> you and your objects...
<palomer> :)
<palomer> I like closures
<palomer> don't you?
* orbitz barelye ver touches the OO part of various OO languages
<orbitz> most of my python reads like functional
<orbitz> and i've used calsses maybe twice in ocaml (not that I've used ocaml tha tmuch)
<thelema> let push, pop = let l = ref [] in fun e -> l := e :: !l, fun () -> match !l with [] -> GEdit.entry() | h::t -> l := t; h
<thelema> palomer: how's that for a closure.
<palomer> equivalent code, yes?
<thelema> pretty much.
<palomer> oh my
<palomer> my entries are attached to completions
<thelema> l is private in my code, sofar isn't
<palomer> I better store the entry/model/completion
<palomer> maybe that's where the leak comes
<thelema> and you use list concatenation instead of pushing one element -- yours will work inefficiently if the pool gets big.
Yoric[DT] has joined #ocaml
<palomer> not so!
<palomer> im always concatenating small lists
<palomer> (the first one is always small)
<palomer> doesn't matter how big the pool is
<thelema> you're right - I was thinking that @ was linear in the second argument
<palomer> a column_list can be used for many different models, right?
Associat0r has quit []
<thelema> yes
<palomer> it works!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
<palomer> ha!
<palomer> man, I never thought I would get into the business of recycling widgets
<thelema> at least ocaml makes it really easy
alexyk has joined #ocaml
<palomer> here's a question:
<palomer> scroll_to_iter doesn't seem to work if the view is a scrolled_window
<palomer> lemme write a test case
alexyk has quit [Client Quit]
<palomer> so
<palomer> that creates a view
<palomer> in a scrolled_window
<palomer> the view has 1001 lines
<palomer> pressing a key on the view will scroll to either line 0 or line 500 (thereabouts)
Submarine has joined #ocaml
<palomer> but...it doesn't work
pierre- has quit [Read error: 60 (Operation timed out)]
jstash has quit []
<palomer> hmm
<palomer> my application still eats up memory like a mofo
* palomer continues the hunt
<palomer> actually
<palomer> I did it wrong
<palomer> doesn't work
<palomer> :P
zenhacker_rouan has quit ["Lost terminal"]
* Yoric[DT] hopes that someday, someone will write a complete documentation for LablGTK.
<tsuyoshi> amen brother
<flux> yoric[dt], maybe you could start by writing complete, but fully erronous, documentation into a wiki, and then bait people to fix it
<tsuyoshi> ha
<tsuyoshi> I think you just need to take the c docs and adapt them to ocaml
<Yoric[DT]> flux: well, I'm already busy writing the documentation for the ocaml libraries + batteries included.
<tsuyoshi> it's not difficult, it's just tedious
<Yoric[DT]> That takes most of my time.
<Yoric[DT]> Now, LablGtk is on the list.
<Yoric[DT]> If nobody has written any documentation for LablGtk when we get around to it, I/we'll certainly try.
<Yoric[DT]> But we have a looooooong list of things to do first.
<Yoric[DT]> That probably won't be before 2010.
<Yoric[DT]> So if anyone else wants to take that particular job, that's probably a good idea :)
<Yoric[DT]> Side-note: at the moment, I'm busy adding a on-line help system to the toplevel.
<Yoric[DT]> That would fit in nicely.
<Yoric[DT]> Other side-note: if anyone is interested in implementing Thompson (I think it's Thompson)'s graphics combinator library for beginners, I'd be interested in using it.
<Yoric[DT]> But for the moment, I have a train to catch.
<Yoric[DT]> Cheers.
Yoric[DT] has quit ["Ex-Chat"]
mishok13 has joined #ocaml
jstash has joined #ocaml
ulfdoz has joined #ocaml
Submarine has quit ["Leaving"]
<palomer> it works!
<palomer> (kind of)
Snark has joined #ocaml
Camarade_Tux has joined #ocaml
<palomer> nope
<palomer> doesn't work
<palomer> recycling widgets doesn't work
<palomer> don't do it kids
<tsuyoshi> palomer: what were you trying to do?
<palomer> tsuyoshi, add a lot of entries to a text view
<palomer> many times a second
<palomer> what happens is that I run out of memory
<palomer> I have a few test cases showing this behaviour if you're interested
<tsuyoshi> you mean.. adding to a text buffer?
seafood has joined #ocaml
<palomer> yeah
<palomer> http://ocaml.pastebin.com/m41788d8d <--an example of what im trying to accomplish
<palomer> recycling my entry widgets
<tsuyoshi> you want to put a bunch of widgets inside a text view? hrm this is weird
<palomer> you're telling me!
<palomer> seems pretty standard
<tsuyoshi> wait.. so you clear the buffer, does that remove the widget that was there before?
<palomer> yeah
<palomer> that's the idea
<tsuyoshi> I've never seen a gtk program put a widget inside a text view.. I didn't even know it was possible
<palomer> and then I take that widget and stick it back in later
<palomer> but that doesn't work
<palomer> I do it all the time
<palomer> but I think I'll have to change that
jstash has quit []
<palomer> to a label/text entry mix
<palomer> since it'll let me recycle my entries
<tsuyoshi> so ok.. at any given time there is only one entry in the view, right?
<palomer> nope
<palomer> many
<palomer> I sometimes have 15 or so
<tsuyoshi> but for this code, it looks like there's only one
<palomer> oh yeah
<palomer> that's a test case
<palomer> to show that you can't recycle widgets
<tsuyoshi> so I'm wondering why you have two entries
<palomer> even if you buffer it
<palomer> in my program I have many entries scattered around
<tsuyoshi> you can reuse widgets.. it's just such a pain in the ass no one really does it
<palomer> why is it a pain in the ass?
<tsuyoshi> in c you need to make sure the ref count is ok.. in ocaml maybe it's not so hard
<palomer> how can I reuse the widgets in this case?
<palomer> my widget just goes blank!
<tsuyoshi> you mean the entry disappears or the text in the entry gets deleted?
<palomer> the entry becomes a block of white
<tsuyoshi> if you're running out of memory.. I would guess you're hitting a corner case that makes either gtk or lablgtk leak
<palomer> here's A test case which leaks like crazy:
<tsuyoshi> reusing widgets is allowed but it's rarely done so it could be buggy
<palomer> that gives me a crazy memory leak
pango has quit ["I shouldn't really be here - dircproxy 1.0.5"]
seafood has quit []
<palomer> I posted it on the list
yangsx has quit [Remote closed the connection]
filp has joined #ocaml
<tsuyoshi> I see.. so Gc.allocated_bytes keeps going up?
<palomer> yup
<tsuyoshi> that's a leak in lablgtk then
<palomer> pretty serious leak, if you ask me!
Snark has quit ["Ex-Chat"]
<tsuyoshi> well the code is unusual
<palomer> removing widgets from a vbox?
<palomer> I do it all the time!
<tsuyoshi> standard practice for removing widgets from a container is to destroy the children, not remove them
<palomer> this test case is supposed to destroy them
<tsuyoshi> yes
<palomer> I don't keep them
<palomer> this is how the program works: create 100 brand new text entries, put them in a vbox, clear the vbox, repeat
<tsuyoshi> yes, but the vbox clearing is not how I would do it
<tsuyoshi> so I'm curious as to whether the way I would do it still results in a leak
<tsuyoshi> (it should still result in a leak)
<palomer> how do you do it?
<tsuyoshi> #destroy, not #remove
<palomer> oh
<palomer> List.iter (fun y -> y#destroy) c#all_children <--like this?
<palomer> same result
<palomer> (you can try it out!)
<tsuyoshi> hrm.. I'd probably iterate some other way but I guess that's close enough
<tsuyoshi> yeah that's definitely a bug in lablgtk
<tsuyoshi> I imagine whatever code contains the bug is pretty trick, since translating gtk allocation to ocaml allocation ought to be tricky
<tsuyoshi> pretty tricky
<palomer> bummer
<palomer> now, the way I want to get around this is by using labels
<palomer> ugh
<palomer> I have no idea how I could otherwise mix text and text entries
* palomer gives up and goes to bed
<palomer> night!
<tsuyoshi> well, labels are what I always use
rmns has joined #ocaml
<tsuyoshi> if my code leaks I wouldn't even notice though, I don't create that many widgets
Camarade_Tux has quit ["Leaving"]
<palomer> labels and entries?
johnnowak has quit []
jknick has quit ["leaving"]
seafood has joined #ocaml
_zack has joined #ocaml
rmns has left #ocaml []
vpalle has joined #ocaml
vpalle_ has joined #ocaml
vpalle has quit [Read error: 110 (Connection timed out)]
Yoric has joined #ocaml
<Yoric> hi
seafood has quit []
itewsh has joined #ocaml
vixey has joined #ocaml
<guyzmo> hi
<guyzmo> I'm having difficulties to install ocamlwizard
<guyzmo> first it says '/bin/sh: ocamlwizard: not found' at every compilation command
<guyzmo> and then it ends with an error : 'Unbound module type Sig.COMPARABLE'
<guyzmo> ah
<guyzmo> it seems to be using ocamlgraph from ocaml 3.10.0 not 3.10.2
<guyzmo> :]
vpalle__ has joined #ocaml
<guyzmo> I have to find out how to specify the correct module path (/usr/local/lib and not /usr/lib)
<guyzmo> if anyone can tell me how to do so ..
<guyzmo> ;)
Associat0r has joined #ocaml
vpalle_ has quit [Read error: 110 (Connection timed out)]
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
Demitar has quit [Remote closed the connection]
Linktim has joined #ocaml
Linktim_ has joined #ocaml
azi_ has joined #ocaml
<azi_> hm.. i have three files calc.ml, parser.mly and lexer.mll i've compiled the last two with ocamlaycc/ocamllex. calc.ml uses a function defined in "parser.ml" but when i issue ocamlc -o calc calc.ml it fails saying that the named function from parser.ml is unbound, what could that mean?
<Smerdyakov> Look at the generated mli file for your parser. Is the function you want exposed?
<azi_> i did that, there is no such function.
<azi_> let me upload the thing
<Smerdyakov> Then you need to read the ocamlyacc documentation to see how you can export functions. Maybe you can't.
<vixey> azi_: Is this from the documentation?
<azi_> vixey: this what?
<Smerdyakov> (I'm not going to download a zip file. The most I do is read short source files available on the web.)
<vixey> azi_: the thing which you are talking about
<azi_> Smerdyakov: i'm following a tutorial and it doesn't mention anything about function exporting, just simply use ocamlyacc ocamllex
<vixey> ..because there's a calculator in the ocaml manual and it compiled fine for me
<azi_> vixey: it is not from the docs, no
<Smerdyakov> azi_, read the real documentation.
<Smerdyakov> azi_, which you should always do before asking a question on IRC.
<vixey> azi_: if the tutorial is broken try this instead then, http://caml.inria.fr/pub/docs/manual-ocaml/manual026.html which is not broken
<azi_> Smerdyakov: well I usually do that when i'm doing something specific for me. in this case it is something i need to extend and if it doesn't work as they wrote it should, then I start wondering if I missed something not so trivial
Linktim has quit [Read error: 110 (Connection timed out)]
<vixey> it's trivial just read that link
<azi_> vixey: sadly, i have no choice
<Smerdyakov> azi_, could be. I don't vouch for any tutorial not found in the real OCaml manual.
<vixey> no choice about what?
<azi_> Smerdyakov: nether do i for all generic topics.. but when you have some silly "homework" stuff to do, then it's another song :)
<azi_> + i think spoting mistakes in such text is part of the lerning process :)
Linktim_ has quit [Read error: 110 (Connection timed out)]
Snark_ has joined #ocaml
Snark_ is now known as Snark
itewsh has quit ["KTHXBYE"]
GustNG has joined #ocaml
Yoric has quit [Remote closed the connection]
Linktim has joined #ocaml
vixey has quit ["Leaving"]
alexyk has joined #ocaml
Linktim has quit [Read error: 104 (Connection reset by peer)]
GustNG1 has joined #ocaml
Linktim has joined #ocaml
alexyk has quit []
GustNG has quit [Read error: 110 (Connection timed out)]
_zack has quit [Remote closed the connection]
GustNG has joined #ocaml
GustNG1 has quit [Read error: 60 (Operation timed out)]
_zack has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
pierre_m has joined #ocaml
_zack has quit [Client Quit]
Demitar has joined #ocaml
Demitar has quit [Remote closed the connection]
Demitar has joined #ocaml
filp has quit ["Bye"]
Associat0r has quit [Read error: 54 (Connection reset by peer)]
Associat0r has joined #ocaml
Amorphous has quit [Read error: 104 (Connection reset by peer)]
Associat0r has quit [Read error: 104 (Connection reset by peer)]
GustNG1 has joined #ocaml
vpalle__ has quit ["Leaving"]
Amorphous has joined #ocaml
GustNG2 has joined #ocaml
Associat0r has joined #ocaml
GustNG has quit [Read error: 110 (Connection timed out)]
GustNG1 has quit [Read error: 110 (Connection timed out)]
pierre- has joined #ocaml
vixey has joined #ocaml
pierre_m has left #ocaml []
itewsh has joined #ocaml
pierre_m has joined #ocaml
jstash has joined #ocaml
Camarade_Tux has joined #ocaml
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
guyzmo has quit [Remote closed the connection]
guyzmo has joined #ocaml
det has quit [Remote closed the connection]
det has joined #ocaml
alexyk has joined #ocaml
_zack has joined #ocaml
itewsh has quit [Read error: 110 (Connection timed out)]
pierre_m has quit [Remote closed the connection]
mishok13 has quit [Read error: 110 (Connection timed out)]
dondy has joined #ocaml
_zack has quit ["Leaving."]
Linktim has joined #ocaml
johnnowak has joined #ocaml
pierre- has quit [Connection timed out]
pierre- has joined #ocaml
johnnowak has quit [Client Quit]
Linktim_ has joined #ocaml
GustNG has joined #ocaml
Yoric[DT] has joined #ocaml
<fremo> how to get a functions dependencies graph ?
itewsh has joined #ocaml
Linktim has quit [Read error: 113 (No route to host)]
<Yoric[DT]> hi
<Yoric[DT]> fremo: you can try ocamldoc -dot
<fremo> 'lo Yoric[DT]
<fremo> ok, thanks :)
alexyk has quit []
<Yoric[DT]> np
filp has joined #ocaml
GustNG1 has joined #ocaml
pango has joined #ocaml
GustNG2 has quit [Read error: 110 (Connection timed out)]
Linktim_ has quit [Read error: 110 (Connection timed out)]
Axioplase_ is now known as Axioplase
Linktim has joined #ocaml
blue_prawn has joined #ocaml
GustNG has quit [Read error: 110 (Connection timed out)]
Linktim_ has joined #ocaml
hkBst has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
marmotine has joined #ocaml
Linktim_ has quit [Read error: 110 (Connection timed out)]
<flux> evening
tomh has joined #ocaml
<flux> fremo, you might get good (approximate) results by using ocamlopt -pp, gprof, gprof2dot.py and graphviz
itewsh has quit ["KTHXBYE"]
Submarine has joined #ocaml
dondy has quit ["ERC Version 5.2 (IRC client for Emacs)"]
Linktim has joined #ocaml
alexyk has joined #ocaml
Linktim has quit [Read error: 104 (Connection reset by peer)]
Linktim has joined #ocaml
jeddhaberstro has joined #ocaml
* palomer is getting out of the business of recycling widgets
<palomer> srsly
<palomer> the internet is so boring
<palomer> I don't know how I can spend all my time on it
<blue_prawn> it's like TV
<flux> this looks like a simple-to-use genetic algorithm library for ocaml: http://www.rubinsteyn.com/genepool/
<Camarade_Tux> palomer, if you don't know how you do, then stay away from kongregate.com ;)
alexyk has quit []
Linktim has quit [Read error: 110 (Connection timed out)]
Snark has quit ["Ex-Chat"]
GustNG has joined #ocaml
<fremo> Camarade_Tux: that's extreme !
_zack has joined #ocaml
_zack has quit [Client Quit]
psnively has joined #ocaml
GustNG1 has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> fremo, well, whenever I feel like losing time, kongregate has a solution, and btw, I just felt like losing time :)
Submarine has quit ["Leaving"]
pierre- has quit [Read error: 110 (Connection timed out)]
rwmjones_ has joined #ocaml
rwmjones_ has quit [Client Quit]
marmotine has quit ["mv marmotine Laurie"]
jstash_ has joined #ocaml
Axioplase is now known as Axioplase_
jstash has quit [Read error: 60 (Operation timed out)]
<Yoric[DT]> My, oh, my, that help browser seems to work.
<Camarade_Tux> no, that's an hallucination because you're too tired :P
<Yoric[DT]> :)
<Yoric[DT]> Does anyone know how new directives may be added to the toplevel?
_JusSx_ has joined #ocaml
<gildor_> Yoric[DT]: take a look at findlib
<gildor_> Yoric[DT]: you need to call black magic function to hook the toplevel
<gildor_> this is in topfind
* Yoric[DT] browses.
<Yoric[DT]> Hashtbl.add
<Yoric[DT]> Toploop.directive_table
<Yoric[DT]> "require"
<Yoric[DT]> (Toploop.Directive_string
<Yoric[DT]> (fun s ->
<Yoric[DT]> protect load_deeply (Fl_split.in_words s)
<Yoric[DT]> ))
<Yoric[DT]> ;;
<Yoric[DT]> mmmhh....
<gildor_> this is black magic (unpublished toplevel function)
<Yoric[DT]> Yeah, I can see that.
<Yoric[DT]> Thanks.
* Yoric[DT] needs to decide whether the help browser is better off as a function or as a directive.
<Camarade_Tux> as a function it could collide (though I wouldn't name a function 'help' or 'man', but still)
longh has joined #ocaml
<Yoric[DT]> Yeah, probably.
<Camarade_Tux> and that black magic doesn't look too black, plus findlib has been using it for years
<gildor_> Camarade_Tux: this is just not documented
<gildor_> so not sure it will work forever
GustNG has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> of course but batteries already uses findlib so something will need to be updated anyway
_JusSx_ has quit ["leaving"]
GustNG has joined #ocaml
<Yoric[DT]> Ok, directive installed.
filp has quit ["Bye"]
<Yoric[DT]> Now, I'm faced with the only difficult issue: finding the help files.
<jonafan> holy god, i think i implemented remove
<jonafan> let's see if this follows ocaml tradition and works perfectly now that it compiles
GustNG has quit [Read error: 110 (Connection timed out)]
<jonafan> ehhh mixed results
<Yoric[DT]> so?
<Yoric[DT]> :/
<jonafan> it seems to do well on the left
<jonafan> so as long as you want to remove something over there, you're good
<jonafan> the function is 225 lines!
<Yoric[DT]> On the left?
* Camarade_Tux feels like typing 226dd
alexyk has joined #ocaml
<jonafan> noooooo
psnively has quit []
blue_prawn has quit ["Client exiting"]
xevz has joined #ocaml
ulfdoz has quit ["deprecated"]
<jonafan> okay
<jonafan> i think it works
<jonafan> uuuuuuugly
<jonafan> time to put this away and never use it again
<Camarade_Tux> jonafan, why did you do it ?
<jonafan> i never wrote a btree and i wanted to try it
<Camarade_Tux> the best reason to write code actually ;)
Yoric[DT] has quit ["Ex-Chat"]
<jonafan> all the operations are really simple, other than remove
<Camarade_Tux> I think we all know by now ;)
<jonafan> haha
<Camarade_Tux> btw, anyone tried to compile as many ocaml packages as possible with 3.11 ?
<jonafan> not me
tomh has quit ["http://www.mibbit.com ajax IRC Client"]
longh has quit [Read error: 104 (Connection reset by peer)]