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/
<vincenz> "foo"?
<vincenz> with quotes?
<vincenz> nm
<vincenz> what does that mean
<vincenz> inherit ['a] method
<Smerdyakov> I doubt that will work.
GreyLensman has joined #ocaml
<Smerdyakov> (Clearly the syntax given there doesn't compile, and I'll be surprised if it can be corrected to work.)
<Smerdyakov> That would be like C #includes that depend on runtime values to choose the file to include.
<vincenz> mixins are compiletime
<Smerdyakov> Yup, and I'm making this judgment based on what is "compile time" and what is "runtime" in OCaml.
* vincenz nods
<vincenz> well of course for dynamic languages like python and ruby the point is moot
<vincenz> but in c++ it's based on templates
<vincenz> ( Which gives you the power of extensibility without the cost of virtual calls)
<vincenz> great way for horizontal layering of functionality
<mrvn_> vincenz: inherit ['a] makes Foo as subclass of 'a
<mrvn_> #class ['a] backup_ref x = object inherit ['a] ref x inherit backup end;;
<mrvn_> class ['a] backup_ref :
<mrvn_> 'a ->
<mrvn_> object ('b)
<mrvn_> val mutable copy : 'b option
<mrvn_> val mutable x : 'a
<mrvn_> method get : 'a
<mrvn_> method restore : 'b
<mrvn_> method save : unit
<mrvn_> method set : 'a -> unit
<mrvn_> end
<mrvn_> That is the example from the ocaml docs I used.
<vincenz> euhm
<vincenz> ever heard of paste sites?
<mrvn_> yes, sorry.
<Smerdyakov> mrvn_, I don't see any use of "inherit ['a]" there.
<Smerdyakov> Oh. The # was a command line, not a comment.
<Smerdyakov> But you've misunderstood what the ['a] means.
<Smerdyakov> You can't just say "inherit ['a]".
<Smerdyakov> The "['a]" there is a parameter to a class.
<mrvn_> so it is a inherit (['a] ref x) there?
<vincenz> the 'a you pass defines the type to be stored
<vincenz> it doesn't do inheritance at all
<Smerdyakov> mrvn_, yes.
<mrvn_> Ok, thought it where (inherit ['a]) (ref x)
<Smerdyakov> What on earth would that mean? 'a needn't be a class.
<mrvn_> It would have to be constrained to classes.
<mrvn_> constrain 'a : <...>
<Smerdyakov> Not doable in OCaml.
<mrvn_> Or even further depending on how it is used.
<vincenz> my system works quite niec
<mrvn_> Annyone have a good suggestion on how to write a non blocking parser? I have several sockets that need to be parsed in parallel.
ianxek has quit ["Leaving"]
<monochrom> A parser that can be told "no data yet, come back later"? I want one too.
<vincenz> threads and a queue?
<mrvn_> A parser that I feed a string every now and then and it works through its annotaded grammar.
<vincenz> thread
<vincenz> and queues
<mrvn_> nah, threads are bad for this.
<vincenz> uhuh...
<monochrom> A parser of the type f:Char -> Parser so you can just give f one character, and it returns the next-state-parser. So I can suspend and resume at will.
<mrvn_> monochrom: Yep.
<monochrom> Hrm that would imply the type equation Parser = Char -> Parser it's going to be funny.
<vincenz> use a thrad
<vincenz> thread
<mrvn_> The problem is that the top level rules of the grammar modify a global database. If I have threads I need to lock the DB in each thread in top level rules.
<vincenz> whenever you want workers that stall, use threads
<monochrom> Ok this will untangle the fixed point equation. f: (Char,ParserState) -> ParserState.
<monochrom> and main:ParserState (parser's initial state).
<monochrom> So the parser f takes the current parser state and the current character, and dumps the next parser state for your future use when you have more characters.
<mrvn_> monochrom: parser -> char -> parser is no problem type wise.
<monochrom> Yes that's isomorphic to what I'm suggesting.
<mrvn_> monochrom: You can compile such things with "-rectypes" or put them into explicit recursive types.
<monochrom> There will also be utility functions to ask for the current (incomplete) parse tree from the parser state.
<mrvn_> Well, I never have a parse tree. Most of the stuff parses one line and then acts on it and forgets it.
<mrvn_> Easier to have the grammar act whenever it has something to do then to ask for the partial tree every now and then I think.
<vincenz> monochrom what sort of research do you do?
<mrvn_> Problem is that all the parser generators for ocaml seem to be blocking.
<monochrom> Application. You are writing a plugin for an IDE for syntax highlighting. User enters characters one at a time and kind-of expects results real time. You need to give one character to the parser, ask for highlighting information, then wait for the next character.
* vincenz whispers Threads
<monochrom> Threads won't cut it because it just shovels the blocking under the carpet.
<mrvn_> Threads are bad if your IDE has 500 files open.
<mrvn_> You don't wnat to fork 500 threads that all just block.
<monochrom> Remember that after giving the parser one character, you immediately want to ask it for certain information.
<vincenz> oh
<vincenz> well for IDE's maybe not
<vincenz> but
<vincenz> sideliner
<vincenz> monochrom: what sort of research do you do?
<vincenz> ?
<vincenz> you'll never be able to do it with ocaml for a simple reason
<vincenz> it's a top-down parser
<mrvn_> You can convert the parser code into CPS notation, same with the lexer and then you can feed it a char at a time and always kep the current continuation in a queue.
<vincenz> I waas thining that
<vincenz> CPS
<vincenz> didn't dare to mention it as I hadn't thought it through comlpetely
<mrvn_> luckily I have a very simple syntax. I only have 3 tockens: word x, quoted x and newline.
mrsolo has joined #ocaml
monochrom has quit ["Don't talk to those who talk to themselves."]
GreyLensman has quit ["Leaving"]
monochrom has joined #ocaml
mrsolo has quit [Read error: 104 (Connection reset by peer)]
mrsolo has joined #ocaml
monochrom has quit ["Don't talk to those who talk to themselves."]
haakonn has joined #ocaml
mrsolo has quit [Read error: 238 (Connection timed out)]
haakonn_ has quit [Read error: 113 (No route to host)]
royce has joined #ocaml
royce has left #ocaml []
velco has joined #ocaml
pango has quit ["Client exiting"]
pango has joined #ocaml
ita has joined #ocaml
<ita> hi
srv has joined #ocaml
srv_ has quit [Read error: 232 (Connection reset by peer)]
<ita> ()
<mrvn_> moin
mrvn_ is now known as mrvn
Nutssh has joined #ocaml
Nutssh has left #ocaml []
ianxek has joined #ocaml
kinners has joined #ocaml
vezenchio has joined #ocaml
* Demitar looks about for the Ultimate OCaml FFI Generator[tm]...
<ita> Demitar: where is that ?
<velco> heh
<Demitar> ita, that's what I'd like to know. ;-)
<kinners> looked at camlidl?
<Demitar> camlidl does most of what I want, but I want to rename the function names (FunnyCapsFun -> funny_caps_fun), and a bit more control over the args: { vertex2d_x : float; vertex2d_y : float } -> (float * float )
<ita> use a preprocessor
<Demitar> To preprocess what? Generate an interface for the caml interface camlidl generates?
<Demitar> Or is there something more insidious availible?
<ita> yup :) (ok, it's a bit far-fetched)
<mrvn> What do you think about http://www.rafb.net/paste/results/Ldpa1496.html ?
<mrvn> It is a non-blocking parser that eats chars. Any ideas for improvements?
<Demitar> ita, it's a fairly good idea actually. It'll upgrade transparently when I figure out the Right Way[tm] to do it.
<vincenz> Is there such a thing as incr x
<mrvn> yes, for references.
<vincenz> for class-mutable variables
<mrvn> only: # incr;;
<mrvn> - : int ref -> unit = <fun>
<vincenz> yes I know
<vincenz> but something similar
<vincenz> "such a thing AS"
<mrvn> method incr_x = x <- x+1
<vincenz> nm
<vincenz> ok thnx
<vincenz> what's the diff between having
<vincenz> val mutabl x = 0
<vincenz> val x = ref 0
<vincenz> (conceptually)
<Demitar> type 'a ref = { mutable contents : 'a }
<mrvn> semantical suggar. you don't need !x
<vincenz> ok
<vincenz> but basically it's the same
mrvn_ has joined #ocaml
<mrvn_> re
pflanze has joined #ocaml
mrvn has quit [Nick collision from services.]
mrvn_ is now known as mrvn
Demitar has quit ["Bubbles..."]
CosmicRay has joined #ocaml
Demitar has joined #ocaml
<mrvn> Noone is intrested in the non-blocking parser?
* Demitar is having a bit uplink trouble...
<mrvn> Demitar: Its all those bubbles. :)
<Demitar> Indeed. :)
kinners has quit ["leaving"]
Demitar has quit [Read error: 60 (Operation timed out)]
<velco> # (1, 2) <> (1, 2);;
<velco> - : bool = false
<velco> # (1, 2) == (1, 2);;
<velco> - : bool = false
<velco> HUH ?!!
<mrvn> == compares addresses.
<mrvn> # (1, 2) = (1, 2);;
<mrvn> - : bool = true
<velco> thanks
<velco> how about <> ?
<mrvn> # let a = (1, 2);;
<mrvn> val a : int * int = (1, 2)
<mrvn> # a == a;;
<mrvn> - : bool = true
<mrvn> # a <> a;;
<mrvn> - : bool = false
<mrvn> <> is content of the objects like =
Demitar has joined #ocaml
<velco> ic
Herrchen has joined #ocaml
<mrvn> velco: carefull with = on recursive structures. It just compares forever.
<mrvn> (unless they differ)
<mrvn> # type foo = { foo : foo };;
<mrvn> # let rec foo = { foo = foo; };;
<mrvn> # foo = foo;;
<mrvn> never comes back.
<Smerdyakov> Which shows how OCaml is a motley lump of ungodly hacks
<mrvn> why?
<mellum> "let rec" in this context is not part of the main language.
<mellum> It's documented as experimental extension.
<Smerdyakov> mrvn, equality can run forever or throw an exception! That's awful!
<mrvn> Smerdyakov: hmm, what exception can it throw?
<mrvn> # let foo = let rec foo () = { foo = foo (); } in foo ();;
<mrvn> Stack overflow during evaluation (looping recursion?).
<Smerdyakov> # List.map = List.map;;
<Smerdyakov> Exception: Invalid_argument "equal: functional value".
<mrvn> mellum: the normal let rec doesn't do the job
pflanze has quit [Read error: 110 (Connection timed out)]
<mrvn> Smerdyakov: Well, comparing functions for equal contents (functionality) is the halting problem all over.
<Smerdyakov> mrvn, right, so that code shouldn't type-checK.
<mrvn> Smerdyakov: It might be nice if = would be a fun x y -> (x == y) || (x = y)
<Smerdyakov> That's beside the point.
<mrvn> Is there anything in the type system to say "'a but not a function"?
<vincenz> mrvn: no why?
<mrvn> # (=);;
<mrvn> - : 'a -> 'a -> bool = <fun>
<mrvn> The type it too generic
<mrvn> The compiler would have to hardcode = to check for functional types.
<mrvn> mellum: What do you think about # (=);;
<mrvn> - : 'a -> 'a -> bool = <fun>
<Smerdyakov> Look at SML or Haskell.
<mrvn> (args, pasted too much)
<mellum> mrvn: looks complicated
<mellum> what does "nonblocking" mean?
<mrvn> mellum: yeah. Its a non-blocking parser. Whenever some stream is readable I dump the text charwise into the worker.
<mrvn> The worker eats the char and returns. If it managed to parse a command it executes that internally.
<Smerdyakov> "The worker eats the char." Sounds like something from a report on industrial human rights abuses.
<mrvn> hehe
<mellum> Poor guys, working in dump streams the whole day
<mrvn> And they never die.
<mrvn> And if you tell them to they "kill"
<mrvn> (the kill_worker does)
<mrvn> It should be possible to use a CPS syntax to get rid of the nested workers.
* Smerdyakov pictures shanty-towns where families of six workers live in oversized bird nested under tarps.
<Smerdyakov> s/nested/nests
<mrvn> And they raise exceptions.
<Smerdyakov> Then the army comes through with flame throwers to get ride of those nested workers
Herrchen has quit ["bye"]
<mrvn> army isn't allowed to.
velco has quit ["Client exiting"]
lizhao has joined #ocaml
<lizhao> hello
<lizhao> who know how to generate ocaml parsers using ocaml?
<Smerdyakov> What exactly do you mean?
<lizhao> i am newbie of ocaml, i know ocaml provide tools like ocamlex and ocamlyacc
<Smerdyakov> OK, but what did your question mean?
<lizhao> that can generate parser given formal definition of the language
<lizhao> now, i want to know
<lizhao> whether i can generate a parser for ocaml using ocamlex and ocamlyacc
<mrvn> with enough work
<lizhao> i found that there are some files like lexer.mll in ocaml package
<Smerdyakov> Why not use the OCaml parser that OCaml itself uses?
<ita> lizhao: i have made a parser in ocaml, you might want to have a look at it ?
<lizhao> that's why i ask question here. :-)
<lizhao> where to get documents of ocaml parser
<lizhao> i think ocamlex lexer.mll will generate lexer for ocaml, is that right?
lizhao has quit [Remote closed the connection]
lizhao has joined #ocaml
<mrvn> Chapter 12 Lexer and parser generators (ocamllex, ocamlyacc)
<vincenz> can you have let x = mutable 1;
<vincenz> can you have let x = mutable 1 in ..
<vincenz> or can you only have mutables for class-members?
<pango> vincenz: as Demitar said, type 'a ref = { mutable contents : 'a } check for yourself in pervasives.ml
<lizhao> mrvn: i have read it, there are some simple examples of lexer and parser
<lizhao> mrvn: what i want to get is the lexer and parser for ocaml itself
<pango> vincenz: mutable can only be used in records, but ref is essentially the same
<lizhao> mvrvn: i.e. that can parser ocaml programs
<vincenz> thnx
<lizhao> i found lexer.mll in ocaml package, i wonder whether it is used to generate lexer for ocaml
lizhao has quit ["using sirc version 2.211+KSIRC/1.3.11"]
lizhao has joined #ocaml
async has quit [Read error: 110 (Connection timed out)]
lizhao has quit [Remote closed the connection]
<vincenz> They should have a filter/find function for Map
<Smerdyakov> Yes, I often find that the OCaml standard library is missing some important functions.
ita is now known as ita|aw
<Smerdyakov> The SML Basis and the SML/NJ library tend to have everything I want.
<vincenz> STOP the propaganda!!!
<Smerdyakov> Of course, you realize that a fold function is all you need to implement those two others, right?
<vincenz> not really
<vincenz> for filter, I agree
<vincenz> but not for find
<vincenz> cause for find you could quit out at the first match
<Smerdyakov> You can abuse exceptions to get an efficient find implementation from fold.
<vincenz> touche
<vincenz> but then I can as well just iter
<vincenz> right now I Iter (but without the exception)
<vincenz> are exceptions fast in ocaml?
<Smerdyakov> I don't know.
<Smerdyakov> But I know who does!
<vincenz> (some languages incur quite an overhead with exceptions, notably java iirc)
<vincenz> Smerdyakov: does SML compile natively?
<Smerdyakov> SML is a language. Unlike OCaml, there are half a dozen usable SML implementations.
<vincenz> well a stable implementation
<vincenz> thnx
<Smerdyakov> OCaml comes in 3rd for exception handling speed.
<Smerdyakov> MLton beats it out, of course ;D
<vincenz> mlton = sml/
* vincenz blinks at g++
<Smerdyakov> MLton is the leading optimizing SML compiler.
<vincenz> thnx
<vincenz> gcc shouldn't be compared tho
<vincenz> it's not real exception mechanism (there's no stack like behaviour
docelic has quit ["brb"]
<mrvn> vincenz: why? there sure is.
<vincenz> it doesn't unwind the stack and find the right one
<vincenz> it's all hardcoded
<mrvn> c++ is optimized so that exception take no time unless they are thrown. They are realy only for exceptional events.
<mrvn> If you throw it it unwinds until the catch and even transforms exceptions that should not be thrown.
karryall has joined #ocaml
docelic has joined #ocaml
<vincenz> mrvn: GCC
<vincenz> not G++
<vincenz> I was referring to the shootout site
<mrvn> vincenz: gcc has no exceptions, only setjmp/longjmp.
<vincenz> it uses setjmp
<vincenz> yes
<vincenz> hence
<vincenz> gcc shouldn't be compared tho
<vincenz> it's not real exception mechanism (there's no stack like behaviour
<vincenz> ..
<mrvn> it's whatever behaviour you implement.
* vincenz sighs
<vincenz> andthe implementation they show as example on the website for the shootout uses setjmp, which imho should not be compared with the rest
<mrvn> That it uses setjmp doesn't affect it not being stacked. Thats what I ment.
Submarine has joined #ocaml
<vincenz> cause of course it's going to be fast as it's not stacked
<vincenz> so it's not a valid speed comparison
<vincenz> they hardcode it
<mrvn> How does it fare in the comparison?
<Submarine> hi there
<vincenz> check the link Smerdyakov gave before
<mrvn> vincenz: Is the cpu (sec) the total time or time per exception?
<vincenz> mrvn: no idea
<vincenz> check their run script
<vincenz> I think it's total runtime
async has joined #ocaml
<mrvn> Anything below a second runtime I consider highly suspect for comparisons.
<mrvn> Considering a 100Hz clock as PCs have 1s runtime still has +-1% error.
<vincenz> mrvn: they run it many times and then divide
<vincenz> and run it once
<vincenz> to find the startup time
<vincenz> trust me, they use a reasonable timing system
<mrvn> If you run it many times you have the startup time in there. If you run it with higher N you don't.
<vincenz> yes
<vincenz> that's what I mean
<vincenz> they use something like that
<mrvn> I implemented the felix code in ocaml (using closures instead of exceptions). Makes no difference in speed for ocaml.
<vincenz> point being?
<Submarine> you mean CPS instead of exceptions?
<mrvn> let blowup n hi_err lo_err =
<mrvn> if n mod 2 = 0 then lo_err n
<mrvn> else hi_err n
<mrvn> let lo_fun n hi_err = blowup n hi_err (fun n -> incr lo)
<mrvn> let hi_fun n = lo_fun n (fun n -> incr hi)
<vincenz> What does it mean "You escaped the dungeon" in scren?
<vincenz> "Welcome to hacker's treasure zoo"
<mrvn> I take it back. Stupid me started the wrong binary.
<vincenz> How do I know where an exception was thrown in ocaml?
<Submarine> vincenz, it's allusions to nethack
<mrvn> ./foo 100000000 6.08s user 0.01s system 78% cpu 7.717 total
<mrvn> ./foo2 100000000 2.50s user 0.00s system 81% cpu 3.078 total
<Submarine> vincenz, there's an option to use normal messages or nethack messages
<vincenz> Submarine: thnx :)
<mrvn> Maybe I should test it on i386 to see if ocamlopt is better there.
<mrvn> any voluntears?
<vincenz> So how do I see where an exception was thrown?
<vincenz> (like a backtrace)
<mrvn> probably only with ocamldebug
<vincenz> k thnx
docelic has quit ["need to plug out some ram"]
<vincenz> ocaml-3.07+2 didn't have Map.is_empty ?!?
* vincenz palmslaps
docelic has joined #ocaml
pflanze has joined #ocaml
<mrvn> let map_is_empty x = x = Map.empty ?
<vincenz> I have 3.08
<vincenz> just found it shocking
<mrvn> There is alos no string_of_char, string_of_char_list or string_to_char_list not to mention String.split: string -> char -> string list
* vincenz is trashing two computers at the same time
velco has joined #ocaml
<pango> standard libs are never going to satisfy everybody, what's still missing is a good, automated, libs repository a-la CPAN...
<mrvn> But the buildin types are hard to replace.
<pango> all the example you gave involve builtin types
<mrvn> Nah, Map isn't buildin. You can easily make your own.
<pango> I'm not going to argue, no time to waste right now
* vincenz knows the feelings
<mrvn> I guess you can build a String2 module that uses String.t as storage type.
<vincenz> pango what do you do?
<pango> nothing ocaml related
<vincenz> pango : yes But what?
<pango> I'm trying to finish hardware maintainance on two computers so I can go home
* mrvn is going to watch some Star Trek Voyager.
<vincenz> CRAP
* vincenz has a Not_found exception that he doesn't know where it's coming from
<mrvn> Check every use of .find
<vincenz> I tried
<mrvn> add some try ... with Not_found -> print_string "here\n"; raise Not_found randomly
<vincenz> I Know
<vincenz> but still can't find it
<mrvn> It would be nice if exceptions would have __FILE__ and __LINE__ of the raise encoded
* Submarine has a replacement for Map
<Submarine> vincenz, have you run it under ocamldebug?
<vincenz> Submarine: no
<vincenz> Submarine: runtime in optimized-native version = long
<vincenz> we're talking 20-30 mins
<Submarine> 20-30 minutes with ocamlc?
<vincenz> I have a hung tho
<vincenz> Submarine: no the version that's compiled with ocamlopt takes 20-30 minutes t run
<mrvn> Sure, but you don't have the secret key on alioth group readable.
<mrvn> ups
<vincenz> s/hung/hunch/
<vincenz> big hunch
<Submarine> vincenz, we have catch-all handlers in our code
<Submarine> like:
<Submarine> try foobar with exn -> printf "we were computing <frobozz> on <bozo>"; raise exn
<vincenz> Submarine: I know but adding that everywhere is ..
<vincenz> frobozz ?!?
* vincenz blinks
* vincenz removes some output crap
<vincenz> That should be much faster
<vincenz> let's just hope the error is not in the stuff I removed
<vincenz> though I have a good hunch :)
<karryall> vincenz: you can have a backtrace with ocamlrun you know
<vincenz> karryall: I don't use bytecode
<karryall> that's too bad, you'd have a backtrace then :)
velco has quit ["I'm outta here ..."]
<vincenz> yeah and 2 hour runtime most likely
<Submarine> vincenz, I work on code which, running with ocamlopt, takes 11h30' :-)
<avlondono> might be wise to compile one bytecode version and leave it running somewhere else ... in case you don't find it in the next couple of hours ;-)
<vincenz> Submarine: what sort of code?
<vincenz> avlondono: yeah but I don't have that many computers
<vincenz> but I just installed ocaml at work
<vincenz> as well as my stuff
<vincenz> (I always login to home from work as my code is there
<vincenz> and I'll make it run here
<avlondono> vincenz, that's what I have to do some times, my code also have long runtimes (even months in a cluster).
<vincenz> my tool is just a profile-analysis tool
<vincenz> :/
<vincenz> heh
<vincenz> I originally had it in python
<vincenz> 50 minutes
<vincenz> ported to ocaml, 2 minutes
<vincenz> added features
<vincenz> now about 20-30 minutes
<vincenz> bbut I should probably move towards non-oo
<vincenz> that might speed it up
<avlondono> well, besides algorithmic solutions, there isn't much I can do about mine.
* avlondono goes back to work
<vincenz> besides algoritmic solutions?? those are usually the biggest factors
<vincenz> avlondono: what do you od?
<avlondono> some bioinfo stuff.
<avlondono> phylogenetic analysis mainly
<mrvn> avlondono: talk to mellum
<avlondono> what does he do?
<avlondono> (or she)
<mrvn> he did something similar.
<avlondono> hum ...
<avlondono> we have a position ... if someone has done this before and knows ocaml ... might be interested ...
<avlondono> :-)
<mrvn> where?
<avlondono> are you interested? NY.
<mrvn> A bit hard to commute from germany.
<avlondono> hehehehe
<vincenz> damn
<vincenz> oo prolly adds a lot of overhead, doesn't it?
<vincenz> :/
<vincenz> instead of trying to figure out internal calls at compiletime
<Demitar> vincenz, overoptimizing too early, are we? :)
<vincenz> Demitar: not really
<mrvn> vincenz: depends on how work extensive your method are. If they take seconds then the OO doesn't matter.
<vincenz> ugh
<vincenz> I'm tired of those people that claim that I overoptimize too early assuming I'm just some regular joeshmoe
<vincenz> mrvn: they don't take seconds
<vincenz> but I do most likely have about...hmm...
<Submarine> most people are regular joeshmoes
<vincenz> 270M oo-calls
<Demitar> vincenz, optimizing too early is common among skilled coders too. :)
<mrvn> If you call the method with a list of 1000000 elements to work over then it doesn't matter. If you iter over a list of 1000000 elements and call a method for each then it matters.
<vincenz> Demitar: my work is in optimization I know what I'm doing
<vincenz> no
<vincenz> I have have about 270M method-calls
<vincenz> most likely
<Submarine> vincenz, spread on what time?
<vincenz> Submarine: 5-10mons
<vincenz> mins
* Demitar . o O ( 270M calls each taking a day to complete isn't too bad. )
<mrvn> If one method calls another via self# can ocaml inline that?
<vincenz> Demitar: I know what my code does
<Submarine> 450000 method calls per second?
<vincenz> mrvn: sadly not but it should
<vincenz> I think super# and self# should be inlined
<Submarine> 4500 cycles per call
<vincenz> it's completely compiletime decideable
<Demitar> vincenz, I can understand why you want to inline. ;-)
<Submarine> I don't think that the method invokation matters.
<vincenz> especially since I use mixins
<Submarine> a method call probably takes a fraction of 4500 cycles, doesn't it?
<Submarine> maybe a few percents
<vincenz> not sure
<vincenz> might be more tho
<vincenz> that was just a guestimate
<vincenz> I know my code was faster before
<Demitar> What did you change?
<vincenz> anyways
<vincenz> I'm ocamlrun -bing
<vincenz> Demitar: moved to mixin style for the core of my analyser
<vincenz> excuse me while I go charge up my company card with moeny and get a coffee (Even though it's almost 9pm)
<mrvn> vincenz: It is not.
<mrvn> class foo = object(self) method foo = "foo" method bar = self#foo end;;
<mrvn> class bar = object(self) inherit foo method foo = "bar" end;;
<mrvn> let bar = new bar;;
<mrvn> # bar#foo;;
<mrvn> - : string = "bar"
<mrvn> # (bar:>foo)#foo;;
<mrvn> - : string = "bar"
<vincenz> mrvn: what's your point?
<mrvn> self#foo calls (self:>bar)#foo in this case.
<vincenz> I know, methods are virtual
<vincenz> mrvn: no you are wrong
<mrvn> If ocaml inlines the self#foo then it would return "foo".
<vincenz> (bar:>)#foo will still call bar#foo
<vincenz> that's the whole idea behind polymorphism
* Submarine never uses OO in Caml
<vincenz> mrvn: from the outside you can't inline
<Demitar> vincenz, hmm, doesn't the processor cache come into play somewhere around here? (Dunno how cache friendly the generated code is anyway, though.)
<vincenz> mrvn: but once you're inside an object you should be able to inline
<vincenz> aka
<vincenz> inside the bar method
<mrvn> # (bar:>foo)#bar;;
<mrvn> - : string = "bar"
<vincenz> c++ does this for classes with virtual
<mrvn> Thats the example I ment.
<vincenz> mrvn: I know, that's fine
<vincenz> inside bar
<vincenz> it knows that it should call bar#foo
<vincenz> no matter what
<vincenz> wait.
<mrvn> vincenz: How should foo#bar be inlined? It doesn't know if it should call foo#foo or bar#foo yet.
<vincenz> mrvn: lemme think
<vincenz> mrvn: nono, you don't inline outside the class but inside the class
<vincenz> though I don't know, I might be wrong
<vincenz> anyways
<vincenz> I think it might be killing me
<vincenz> but time for coffee
<mrvn> vincenz: so class bar needs an extra implicit inlined "method bar = self#foo" instead of inheriting foo's?
<Submarine> anyone here with experience in parallel / distributed programming?
<mrvn> Submarine: some
<vincenz> mrvn: you're not making sense
<vincenz> aka you're speaking gibberish
<vincenz> what I mean is that
<vincenz> when you instantiate a bar
<Submarine> if computation times are a + b/n where a, b are constants and n is the # of processors
<vincenz> the self#bar method could just be the code "bar"
<mrvn> vincenz: The method bar only exists in foo but behaves differently for class foo and class bar.
<vincenz> mrvn: no you're wrong, rethink what you're saying
<Submarine> that makes me think that the computation takes a fixed amount of time in a monoprocessing setting, and another in a full linear speedup
<mrvn> Submarine: a and b are depending on the problem size and type.
<Submarine> mrvn, a and b are constant for a given problem
<mrvn> vincenz: foo#bar gives "foo" for a true foo, bar#bar gives "bar".
<mrvn> Submarine: given problem and input.
<Submarine> problem and input
<Demitar> Submarine, ignoring the added latency of multiple processors communicating?
<Submarine> Demitar, no
<Submarine> Demitar, that's what surprises me, I was thinking of times in a + b/n + cn
<mrvn> There could be a 'c*n' term in there too.
<Submarine> but there's hardly anything in c coefficient
<Submarine> I did a fit of the computation times, and c is totally neglible.
<Submarine> negligible
<mrvn> if it isn't then forget about parallelizing it.
<Submarine> the sad thing is the constant coefficient
<mrvn> That is usually the problem.
* Submarine has usual suspects
<vincenz> mrvn: yes
<vincenz> mrvn: and BAR is defined in bar
<vincenz> so BAR willl always return "bar
<mrvn> vincenz: no: # class bar = object(self) inherit foo method foo = "bar" end;;
<mrvn> vincenz: no method bar in there at all.
pango has quit ["Leaving"]
<vincenz> oh like that
<vincenz> no you're right, but still you could make custom code for the bar and foo
<mrvn> vincenz: By overloading one function I change the behaviour of another.
<vincenz> based on what is being newed
<vincenz> anyways
<mrvn> vincenz: you could duplicate the bar method in the compiler.
<vincenz> I gotta go back to work
<mflux> only things like java or c# with jit can optimize those
<mflux> well, you could potentially implement that in pre-compiled languages too, but I don't know of any
<vincenz> mrvn: yes
<TheDracle> So does :> do a class cast or something?
<mrvn> The problem is that ocaml has no static methods, only virtual.
<mflux> a whole-program-compiler could also analyze each path and make a decision, but..
<TheDracle> I've never seen this operator before.
<vincenz> TheDracle: no just makes it appear like a different subclass
<TheDracle> Hm.
<mrvn> TheDracle: coercion to a super class
<TheDracle> So, it has to be a subclass then.
<vincenz> mrvn: it should have static methods, they're great for mixins
<vincenz> right, superclass
<mrvn> s/static/non virtual/
<TheDracle> And, he's pointing out that the dynamic binding table still results in the original class despite being coercion?
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
<TheDracle> Ahem, coerced.
<mrvn> static would be without self object, usefull too.
<mrvn> TheDracle: I'm just pointed out that methods can't be simply inlined.
<vincenz> anyways
<vincenz> with mixins...
<vincenz> it'd be great
<vincenz> non-virtual members
pango has joined #ocaml
* vincenz heavily uses that in his c++ code
<mrvn> vincenz: at least if one method calls another
<mrvn> or inside the same translation unit.
<vincenz> mrvn: well you layer functionality horizontally
<vincenz> and then have each call super
<vincenz> I do that now too, but of course it's killing me with the virtual calls
<mrvn> setup structs with closures instead of classes.
<vincenz> yeah but it means recoding again
<vincenz> besides I'm not sure whether it'll save me 10% or 50%
<vincenz> so I don't feel like making the effort just yet
<mflux> how about simply replacing method bar = .. with var bar = fun () -> .. ?-)
<vincenz> (Especially given that my Master student has just gotten to learning ocaml as well as working to extend the tool)
<mflux> for calling things locally that is
<vincenz> I don't call things locally
<vincenz> in fact my methods don't call each other at all
<vincenz> except for the super-chaining
<vincenz> and the bottom-state-machine calling the right method to start with
<mflux> oh, so the self#bar-thingy was just an example
<vincenz> yeah
<vincenz> that was mrvn
<mrvn> mflux: How do you fix this?
<mrvn> # class root = object(self) val parrent = (self:>root) end;;
<mrvn> The instance variable self
<mrvn> cannot be accessed from the definition of another instance variable
<Demitar> I don't know exactly what your code does, but would it perhaps be beneficial to cache values along the way (of course you're probably doing that already)?
<vincenz> Woot, got it!
<vincenz> Demitar: there's nothing to cache
<TheDracle> Hm, so you're wondering if removing the overhead of dynamic binding will optimize your program?
<vincenz> eah
<TheDracle> You said you changed some things, from a 2min execution time, and it boosted it to a 20min, right?
<Demitar> 270M calls and nothing to cache? Evil little application you have there. :)
<vincenz> TheDracle: nono
<vincenz> Demitar: I'm parsing a 1-2GB binary-log file and building up diffeerent maps that I then output at the end
<vincenz> let me show you an exmaple output
<vincenz> actually, let me not
<Demitar> Seen it already IIRC.
<TheDracle> Lol.
<vincenz> as I first have to fix the bug ( I found it)
<mflux> mrvn, well, you could always pass self as an argument.. if it doesn't create a type problem
velco has joined #ocaml
<TheDracle> vincenz: Are you mmaping it some how?
<TheDracle> vincenz: Or are you raw inputing it?
<mrvn> # class root me = object val parent = me end;;
<mrvn> class root : 'a -> object val parent : 'a end
<mrvn> # let rec root = new root root;;
<mrvn> This kind of expression is not allowed as right-hand side of `let rec'
<mrvn> mflux: not that I see how.
<vincenz> TheDracle: raw input
<Demitar> mrvn, not the real problem but you're not allowed to pass a type as an argument anyway.
<vincenz> TheDracle: but that shouldn't be too much of a prob
<vincenz> read_byte
<TheDracle> vincenz: You may be able to speed things up a bit if you mmap, at the expense of memory.
<mrvn> Demitar: # let rec base = new root base;;
<vincenz> TheDracle: no cause I've test it before, it should be no more than a minute to read
<TheDracle> vincenz: Alright, just a suggestion :)
<vincenz> so no biggie
<vincenz> thnx but I had thought of it :)
<vincenz> (except that I wouldn't have known how
<Demitar> vincenz, are you reading it byte by byte? I sure hope the os caches efficiently. :)
<vincenz> Anyways the reason I have the exception is cause I have a bug in my c++ code
<vincenz> Demitar: I assume so, no?
<vincenz> I have to read byte by byte
<vincenz> (sadly ocaml supports MSB not LSB)
<mrvn> vincenz: read it into a 64K string buffer and then parse it there.
<vincenz> it's a non-issue
<vincenz> os should usually cache anyways
<Demitar> I suspect you might avoid a number of context switches however.
<TheDracle> Yeah, reading byte by byte causes the processor to continually page memory out of the cache and back into the cache, usually.
<TheDracle> I dunno.
<mrvn> vincenz: it still calls a read syscall for every byte.
<TheDracle> I'd mmap for sure on something like this.
<mrvn> TheDracle: no.
<mrvn> TheDracle: only works well on 64bit cpus.
<TheDracle> What does?
<mrvn> the mmaping.
<TheDracle> Ookay.
<TheDracle> Why?
<Demitar> TheDracle, remember he's using files in the Gb range. ;-)
<mrvn> On 32bit cpus mapping 1-2 GB might fail already and you need BigArray stuff for it.
<TheDracle> Ah.
<TheDracle> Hm.. I've mapped very large files, I'm not sure in the gigabyte range.
<mrvn> On 64bit I can just allocate a 2GB string and read it in one go. :)
<velco> What's the correct syntax to obtain this: http://paste.lisp.org/display/3428
<TheDracle> Probably not in the gigabyte range come to think of it.
<mrvn> TheDracle: mips32 only has 2GB mappable address space.
<vincenz> velco: add an in after the first line
<TheDracle> Right.
<velco> vincenz: thanks
<vincenz> np
<mrvn> mflux: So no idea for the self referencing class problem?
<karryall> mrvn: define a class type before defining your class
<karryall> then you can coerce to the class type
<mflux> mrvn, class foo = object (self) val a = (fun () -> Printf.printf "%d\n" 5) method b = Printf.printf "Foo\n%!"; a (); end;; ?
<mrvn> class type root = object val parent : root end;;
<mrvn> class base = object(self) val parent = (self:>root) end;;
<mrvn> karryall: Like that?
<TheDracle> Hm. will val a = fun() -> whatever work with the type inferance mechanism?
<karryall> yes
<karryall> smthg like that
<mrvn> karryall: The instance variable self cannot be accessed from the definition of another instance variable
<mflux> thedracle, sure?
<TheDracle> mflux: Well, methods don't :p
<mflux> methods are something else ;)
<karryall> mrvn: do this in a methd
<TheDracle> mflux: As far as I can tell, it bitches on class definition that the type isn't complete.
<vincenz> mrvn: that's NORMAL
<mrvn> mflux: no, a class that has itself as value.
<vincenz> mrvn: you can't access self# until it's constructed
<mflux> thedracle, well that's true, but I don't think that's the same problem?
<TheDracle> No, it's not, I was just asking though :)
<TheDracle> I was thinking fun () -> may be a way around it.
<mrvn> # class root = object(self) method parent = (self:>root) end;;
<mrvn> class root : object method parent : root end
* vincenz wonders whether he's killing his nice 200GB hd by having c++ programs dump 2GB and then reading it with ocaml
<mrvn> karryall: Thx, that looks promising.
<vincenz> mrvn: #parent is just the identify function
<karryall> no it's not
<vincenz> oh right
<Demitar> vincenz, yes! Leave that poor drive alone! You.. you.. disk-murdering you!
<TheDracle> Classes in Ocaml seem very akward and incomplete.
<vincenz> Demitar: I'm not kidding, my work is on my hd at home, if it crashed..
<Demitar> vincenz, that's what cvs is for. (Backup for hackers. :)
<mrvn> vincenz: The problem is that I want to chain a bunch of widgets to their parent widgets in a gui and the chain has to stop at the root widget (which points at itself).
<vincenz> Demitar: euhm, the cvs is on my omputer at home
<vincenz> mrvn: the problem is that all methods are virtual
<vincenz> x#parent#method will still call X#method
<karryall> depends on wether the root class type has #method
<mrvn> vincenz: x#parrent won't be x except for the root.
<vincenz> mrvn: yes it will be
<vincenz> it will be x, seen as the parent-type
<vincenz> that's like saying in c++
<mrvn> vincenz: class widget parent = object method parent = parent end;;
<vincenz> Parent * class = new Child();
<mrvn> vincenz: class widget parent = object inherit root method parent = parent end;;
<vincenz> oh!
<vincenz> I was referring to
<vincenz> class root = object(self) method parent = (self:>root) end;;
<mrvn> vincenz: Only root will point at itself.
<vincenz> which you mentioned
<vincenz> ah ok, like that
<vincenz> I thought all classes did
<vincenz> self:>root
<mrvn> The problem is that if every widget has a parent the root has to point at something, itself.
<vincenz> mrvn: so?
<karryall> could raise an exception, that would be simpler :)
<mrvn> vincenz: I couldn't construct a root that points to itself with "val parent"
<vincenz> WOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
<mrvn> vincenz: thats all
<vincenz> I love my analysis tool
<vincenz> :)))))))))))))))))))))))))))))))))))))))))
<mrvn> Drawback of "method parent" is speed :(
<vincenz> after debuggin my ocaml app (I forgot about something
<vincenz> Illegal Free poolid: -1, scopeid: CInvDwt::~CInvDwt, size: 12
<vincenz> it pointed me directly at the problem in the c++ code
<vincenz> :D
<mrvn> Is there a way to mmap a file as say a string and have it under GC control?
<vincenz> mrvn: yes, use c
<vincenz> actuall no
<mrvn> Meaning when the string gets freed it unmmaps.
<vincenz> obviously not
<vincenz> mmap is not based on malloc
<vincenz> the GC is on the heap
<vincenz> mmap is outside the heap
<vincenz> (well on the broader 'page-heap' on most os's)
<mrvn> The GC could be extended to know about mmaped objects. They can be remaped and freeded.
<karryall> the gc mmapd /dev/zero also I think
<mrvn> Would probably even faster for large objects to remmap them instead of copying them.
<mrvn> karryall: gcc does that.
<mrvn> /libc
<karryall> I mean the caml GC, to allocate memory for it's heap
<vincenz> how do you tunnel again with ssh?
<pango> vincenz: ssh -L locallisteningport:removetarget:remotetargetport id@removebox (unless you meant tunneling to other way with -R, but it's less usual)
<pango> s/remove/remote/
<mrvn> One could use Gc.finalise I guess to ummap when the mmaped region is no longer used.
<vincenz> another coffee.....1pm at the offeice :/ (and then considering that I was up until 6am yesterday working on the code)
<vincenz> 10pm, not 1pm
<mrvn> vincenz: me too
<vincenz> mrvn: what do you do?
<mrvn> vincenz: Just letting my mind wander while I think subconciously.
<vincenz> ...
<vincenz> ?
<mrvn> I think I'm gonna make some food now, I always have great ideas over a pizza.
<vincenz> ...
gim has joined #ocaml
gim has quit [Read error: 110 (Connection timed out)]
mfurr has joined #ocaml
velco has quit ["I'm outta here ..."]
Submarine has joined #ocaml
mrsolo has joined #ocaml
CosmicRay has quit ["Client exiting"]
monochrom has joined #ocaml
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
mrsolo has quit [Read error: 110 (Connection timed out)]
cjohnson has joined #ocaml
<mrvn> Args, I wasted 20 minutes hunting a bug because I had 'n' instead of '\n' deep inside my parser.
pflanze has quit ["-> home"]
<TheDracle> What are you parsing?
<TheDracle> Yet another programming language?
<TheDracle> Heh.
<mrvn> rfc822 formated header
<mfurr> mrvn: LOL, I just wrote one those tonight (for parsing debian Package files)
<mrvn> same here.
<mrvn> I have a string containing ones entry from the Source file.
<mrvn> Can I see your code for comparison?
<mrvn> I still need the code to parse "Build-Depends: ..." too.
GreyLensman has joined #ocaml
<mfurr> I just parse everything into a (string,string) hashtbl.t where the keys are the field entries
<karryall> mrvn: eek
<karryall> explode, implode
<karryall> kinda of ugly, no ?
<mfurr> (sorry indexing isn't on on the dir)
<mfurr> very simple and ugly in the imperative sense, but it works
<mfurr> it can parse Sources Packages Release
<Smerdyakov> mfurr, what is your affiliation with UMD?
<mfurr> I'm a phd student there
<Smerdyakov> Hm. With no web site. Must be first-year? :)
<mfurr> lol... yeah, second year with an anomosity towards web pages
<Smerdyakov> OK.
<Smerdyakov> Did you go to any other schools' admitted students visit days in Spring 2003?
<mfurr> nope
<mfurr> brb
<Smerdyakov> OK. Was wondering if I could have met you at one. :)
<vincenz> mrvn: what are you parsing?
<mfurr> Smerdyakov: what school are you affiliated with?
<mfurr> Smerdyakov: where you at pldi this past year?
<Smerdyakov> No. My only conference so far was ICFP 2002.
<Smerdyakov> But I met someone you probably know over the summer: Polyvios Lastnameiforget