flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
sOpen has joined #ocaml
<vuln> Um homem que nunca muda de opinião, em vez de demonstrar a qualidade da sua opinião demonstra a pouca qualidade da sua mente.
<vuln> sorry, pasted without intention
<mrvn> what he says?
<vuln> a man who never changes his opinion, instead of show the quality of its opinion, shows the few quality of your mind.
<vuln> Marcel Arachad.
<vuln> Achard*
<vuln> mrvn: If you like, that's another one which I liked:
mjambon has left #ocaml []
<vuln> The only way to go ahead in the end of a precipice, is step backward.
<vuln> is to step backward
slash_ has quit ["Verlassend"]
Ori_B_ is now known as Ori_B
<mrvn> vuln: How about a number class like this? http://paste.debian.net/33126/
<mrvn> olegfink: 'type t = E | N of t * int * t' in C would be struct Node { Node *left; Node *right; int x; } with NULL for E.
<vuln> mrvn: lemee see
seafood_ has joined #ocaml
<vuln> How can I use it mrvn ?
<vuln> haah
<mrvn> vuln: just paste it into a toplevel
<vuln> and?
* mrvn misses static methods. Like the ['a] number # plus
<mrvn> vuln: it uses it at the end
<vuln> what?
<mrvn> vuln: lines 20-23 show the integer case, 25-28 the float case
<mrvn> kaustuv: so how do you do stop the gc?
<vuln> thanks mrvn :D
<mrvn> 74 let _ = control.Gc.max_overhead <- 1_000_001 in
<mrvn> kaustuv: that is evil.
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has joined #ocaml
vuln has quit ["Só existem 10 pessoas no mundo. As que estão lendo essa mensagem, e as que não estão."]
seafood has quit [Read error: 113 (No route to host)]
seafood_ has quit []
<mbishop> neat, concurrent gc :)
<mrvn> In many cases it would be nice to have a per thread heap with its own local GC.
jeddhaberstro has joined #ocaml
Symmetry- has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
verte_ has joined #ocaml
verte has quit [Nick collision from services.]
verte_ is now known as verte
jeddhaberstro has quit []
<eut> how do nested recursive functions work?
<mrvn> they just do. what is there to ask?
<eut> how is the parameter passed into the nested function if its not explicitly called?
<mrvn> the same way let a = 5 let rec loop = function [] -> a | _::xs -> loop xs is bound to a.
<eut> hmm
<eut> ok i'll give it a shot that way
<eut> how do you get head to be the input of g?
<sOpen> eut, g closes head. what are you trying to accomplish with this?
<eut> its hard to describe but i'll try
<eut> f is meant to operate recursively on a list list by popping a list from it and using g to operate on it and g operates recursively on a list (sometimes generating a list list in which case it calls f)
<mrvn> eut: add "in g head"
<eut> here they are defined separately: http://rafb.net/p/uosSWs38.html
<sOpen> eut, use mutual recursion with "and"
<eut> where do i add in g head?
<mrvn> eut: that needs let rec f = ... and g = ...
<eut> can you give a simple example of how to do that?
<mrvn> just replace the second "let rec" with and
<mrvn> or let rec f = function [] -> []
<mrvn> head::tail -> let rec g = function [] -> []
<mrvn> | (Leaf x)::tail -> (x)::(g tail)
<mrvn> | (Branch x)::tail -> (f (gen_list_list x))::(g tail)
<mrvn> in (g head)::(f tail);;
<mrvn> eut: And think about better names for f and g.
<eut> ahhh, so the "let rec g" is not invoked until the "in (g head..."
<eut> its just defined in sort of an aside
<mrvn> eut: just like let rec f is not invoked till you call f something.
<eut> yeah i see
<eut> i think i'm starting to get it
<mrvn> The only difference of defining it inside is that g will only be known inside.
<mrvn> That greatly helps to avoid name clashes.
<eut> yea
<eut> its just like defining an intermediate value inside of a function
<mrvn> exactly.
<mrvn> the g is nothing else.
<mrvn> Remember: functions are just values too.
<eut> yea.. sometimes its hard to wrap your head around it though :P
<mrvn> eut: Do you now List.map?
<eut> no
<mrvn> List.map applies a function to every element of a list generating a new list with the result of the function.
<mrvn> What your f is doing.
<eut> i'm only applying the function to branches though
<mrvn> let rec f = List.map g and g = ....
<mrvn> and g = List.map (function Leaf x -> x | Branch x -> f (gen_list_list x)
<mrvn> g also just applies a function to every element of a list mapping it into a new list.
<eut> hmm
<mrvn> eut: Saves you some typing. :)
<mrvn> Most recursions over a list can be written as List.iter, List.map, List.fold_left or List.fold_right.
<mrvn> eut: Are you sure your code is correct though?
<eut> its giving me some error, types are bad
<mrvn> Shouldn't Leaf x stay as Leaf x?
<eut> i'd rather it not
<mrvn> And Branch x -> Branch (f (gen_list_list x))?
<mrvn> Because I assume x in Leaf x is 'a and f returns a list that is not 'a.
<eut> i would like f to return a list that is 'a
<mrvn> What is your type for Leaf/Branch=
<mrvn> ?
<eut> type ('a, 'b) symbol = Branch of 'a | Leaf of 'b
<mrvn> With 'b being for example int?
<eut> yeah, it should work with anything right?
<eut> i have been testing with strings
<mrvn> yes.
<mrvn> The problem is that | (Leaf x)::tail -> (x)::(g tail)
<mrvn> gives you a "string list" as return type
<eut> yes
<mrvn> but | (Branch x)::tail -> (f (gen_list_list x))::(g tail) gives a string list list list I think
<eut> i think i need to change one of the :: to @
<mrvn> eut: as said yesterday your ('a, 'b) symbol does not define a nice tree structure.
<mrvn> You want a string list givin all the leafs of the "tree" in order, right?
<eut> yes!
<mrvn> % ocaml -rectypes
<mrvn> # type ('a, 'b) symbol = Branch of 'a | Leaf of 'b;;
<mrvn> type ('a, 'b) symbol = Branch of 'a | Leaf of 'b
<mrvn> # let rec fold = function Leaf x -> [x] | Branch x -> List.fold_right (fun y acc -> (fold y) @ acc) x [];;
<mrvn> val fold : (('a list, 'b) symbol as 'a) -> 'b list = <fun>
<mrvn> # fold (Branch [Leaf "How"; Branch [Leaf "are"; Leaf "you?"]]);;
<mrvn> - : string list = ["How"; "are"; "you?"]
<mrvn> I believe without rectypes you can not write that with your ('a, 'b) symbol.
<eut> let rec fold ... is not evaluating with my ocaml version, 3.11.0
<eut> Error: This expression has type 'a but is here used with type
<eut> ('a, 'b) symbol list
<eut> thrown at the 'x' towards the end of the line 'acc) x [];;'
<mrvn> As I said, doesn't work without -rectypes.
<mrvn> Use type 'a tree = Leaf of 'a | Branch of 'a tree list;;
<eut> ohh
<mrvn> You need to put the recursion of your structure into the actual tree type explicitly instead of the implicit recusion of your ('a, 'b) symbol.
<eut> i was envisioning the usage of Branch a bit differently
<mrvn> Isn't Branch supposed to be a list of symbols?
<eut> nah its just a single symbol that gets expanded into a list of symbols (and possibly Branches) by the gen_list function
<mrvn> eut: hmm, then it might work. But what is wrong with using 'a tree?
<eut> i'd like to get it working this way because i'll be able to generate different trees by slightly changing gen_list
<mrvn> So how does your gen_list_list look like? Something like let gen_list_list x =[[Leaf x]]?
<eut> yeah something like that
<mrvn> let rec f = function [] -> [] | head::tail -> (g head)@(f tail)
<mrvn> and g = function [] -> [] | (Leaf x)::tail -> (x)::(g tail) | (Branch x)::tail -> (f (gen_list_list x))@(g tail);;
<eut> works :]
<eut> but i get stack overflow :/
<mrvn> Now you have to learn about tail recursive functions
<eut> arg
<mrvn> unless you really did create an endless recursion.
<mrvn> Your gen_list_list has to sometimes not include any Branches.
<eut> yea
<eut> it does sometimes not include any Branches but i guess its too infrequently and the stack overflows
<eut> is there any way to trace out the pattern of execution?
<mrvn> you can add print statements
<mrvn> eut: Does this work? http://paste.debian.net/33134/
<eut> cont acc?
<mrvn> f (List.rev) [] [[Leaf 1; Branch 2; Leaf 3]];;
<mrvn> - : int list = [1; 2; 3]
<mrvn> eut: cont is a closure what to do next and acc is the result so far
<mrvn> Sorry, pasted one line too little.
<eut> that does the trick
<eut> seems to be much more memory efficient than the previous solution
<mrvn> It is the previous turned tail recursive using 2 tricks:
<mrvn> 1) I accumulate the result in acc adding each symbol at the front and reversing the list at the end. That gets rid of the @ operations.
<mrvn> 2) By passing along the work still to do in cont the remaining function calls are stored as heap objects and passed to f/g as argument in a tail recursive call
<eut> very tricky
<mrvn> There is a formal method for doing this so you could write a camlp4 makro that does it automatically for you.
<eut> :o
<mrvn> But usualy doing it manualy gives much better code.
<eut> i see
<mrvn> A lot of the time you can avoid non tail recursion by constructing your result in reverse, passing it along as argument (the acc) and reversing the listonce at the end.
<eut> yea, that makes sense
<mrvn> Or you cheat and use mutable lists so you can append to the end. Batteries does that internally.
<eut> Batteries?
<mrvn> A "Batteries is a community-driven effort to standardize on an uniform, documented, and comprehensive OCaml development platform."
<mrvn> It adds a lot new or improved modules to the ocaml standard lib.
<mrvn> What was first? The chicken or the egg?
<eut> i dunno but i'm sure it'll cause a stack overflow :P
<eut> Batteries sounds very useful
<mrvn> For my filesystems mkfs I want to create the datastructure that stores which block is free and which is used. But to do that I need to allocate a block where it will be stored on disk. So I need the structure, so I need a free block, so I need the structure, so I need a free block...
<eut> you need to start with an empty disk
<eut> argg
<eut> woo!
<eut> i got it working :]
<eut> well.. almost
komar_ has joined #ocaml
<eut> to me it looks like a long mangled mess, but maybe you will find some beauty in it:
_zack has joined #ocaml
_zack has quit ["Leaving."]
_zack has joined #ocaml
<Camarade_Tux> you can replace (List.length lst = 0) with lst = []
<Camarade_Tux> also, you don't need so many parens : for instance, [let a, b = 3, 5] works without and [in (g nseed (List.nth lst pos))] could be [in g nseed (List.nth lst post)], that should improve readibility
<Camarade_Tux> also, [and g iseed = function] is very very very badly indented
<Camarade_Tux> [if (List.length lst = 0)] is useless : you're in the second pattern-matching clause so lst <> [] and can't be of zero-length therefore
<mrvn> Actualy lst can never be length 0 as that would match the [] case above.
<mrvn> Ups. Camarade_Tux already said that.
<mrvn> Camarade_Tux: the [and g iseed = function] is not baldy indented, it is at the level it is defined at.
<mrvn> ups, no, Camarade_Tux is right. My browser window wasn't wide enough to show the "in" in line 7.
<Camarade_Tux> yeah, it's very disturbing, it really looks right at first
<mrvn> eut: When you have a variable that is constant then you do not need to pass it to subfunctions. You can just use it.
jeanbon has joined #ocaml
<mrvn> let glist key = let (top, fn) = grammar in (fn key) in
_zack has quit ["Leaving."]
<olegfink> mrvn: exactly, but that's struct, not union, isn't it?
<mrvn> olegfink: ??
<mrvn> eut: You could write your chooser so that it picks an element out of the list instead of returning the position of it.
<mrvn> chooser : 'a -> 'b list -> ('a * 'b)
<mrvn> eut: If you use "let rec random_sentence (top, fn) chooser seed =" then you can eliminate lines 2 and 3 completly.
oriba has joined #ocaml
oriba has quit [Read error: 104 (Connection reset by peer)]
<olegfink> mrvn: was referring to "mrvn | olegfink: 'type t = E | N of t * int * t' in C would be struct Node { Node *left; Node *right; int x; } with NULL for E."
<mrvn> olegfink: Node * is implicit an option type.
<olegfink> yes, but still you haven't used unions and I figured that's my assertion you tried to proove wrong?
<mrvn> olegfink: the type is too simple to warant a union in C :)
<mrvn> One thing I like about ocaml is that type foo = Small of x | Big of a * b * c * d * e * ... * z will only use as much space as needed for each variant. Unlike a C union that always uses at least as much space as the largest member.
Alpounet has joined #ocaml
komar_ has quit [Read error: 113 (No route to host)]
komar_ has joined #ocaml
Ched has joined #ocaml
marmottine has joined #ocaml
verte has quit [":("]
jamii has joined #ocaml
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
* Camarade_Tux wonders how he managed to survive using only the toplevel and not ocamldebug
<flux> it'd be nice if toplevel and ocamldebug were integrated
verte has joined #ocaml
<Camarade_Tux> I'd also like to be able to change the sourcecode and have the changes automatically repercuted in the debugger but that's probably irrealistic for a non-interpreted language
<mrvn> Camarade_Tux: and have that change ripple through everything that has a binding on that value?
<Camarade_Tux> of course ;p
<Camarade_Tux> I know that's unrealistic but that would be great :)
<mrvn> Only way I see to do that would be to capture all I/O the code does and then replay that from scratch.
marmottine has quit [No route to host]
<mrvn> And if the bahviour differs on the replay at any point you have to stop.
<flux> camarade_tux, actually Microsoft Visual C can do that :)
<flux> but it's not very reliable
<flux> otoh C doesn't have closures
ygrek has joined #ocaml
marmottine has joined #ocaml
<mrvn> And if you change a global int to a global float that would make all pointers to that global have the wrong type unlike in ocaml where the type would get infered to float now.
<Camarade_Tux> flux, I guess that needs everything to be tightly integrated
Symmetry- has joined #ocaml
Ariens_Hyperion has joined #ocaml
hkBst has joined #ocaml
<Camarade_Tux> in [let a = 3 in f a], is it possible for ocamldebug to stop between [let a = 3] and [f a] ?
ttamttam has joined #ocaml
ttamttam has quit [Remote closed the connection]
ttamttam has joined #ocaml
hippodriver has joined #ocaml
Ariens_Hyperion has quit []
ttamttam has left #ocaml []
kaustuv_ has joined #ocaml
<mrvn> Camarade_Tux: maybe if you totaly disable inlining.
hippodriver has quit [Remote closed the connection]
<Camarade_Tux> I should try : the function I want to debug is nearly completely skipped =/
dejj has quit ["Leaving..."]
rwmjones has joined #ocaml
<steg> does ocaml let you totally disable inlining?
<mrvn> Not sure if constant inlining like that can be disabled.
<mrvn> -inline n
<mrvn> Set aggressiveness of inlining to n, where n is a positive inte-
<mrvn> ger.
<Camarade_Tux> well, my code doesn't use a constant but in ocamldebug's documentation doesn't state you can put a break point after only an alloc : let e = Some { l with y_succ = accu_true } in
<mrvn> Didn't someone say -inline -1 was needed to disable all cross module inlining?
verte has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
mishok13 has quit [Read error: 110 (Connection timed out)]
gdmfsob has joined #ocaml
BiD0rD has joined #ocaml
BiDOrD has quit [Read error: 110 (Connection timed out)]
Smerdyakov has joined #ocaml
jamii has quit [Read error: 113 (No route to host)]
Yoric[DT] has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
jeddhaberstro has joined #ocaml
sOpen has quit [Read error: 110 (Connection timed out)]
bluestorm has joined #ocaml
jeanbon has quit [Read error: 113 (No route to host)]
jeanbon has joined #ocaml
jeddhaberstro has quit []
palomer has quit [Read error: 104 (Connection reset by peer)]
ofaurax has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
jamii has joined #ocaml
chahibi has joined #ocaml
sOpen has joined #ocaml
ttamttam has joined #ocaml
Ariens_Hyperion has joined #ocaml
Ariens_Hyperion has quit []
<flux> mfp, hi, thanks again for that xhtmlcompact_lite.ml{,i} you gave quite some time ago :)
<flux> mfp, is the idea that I should provide a function to quote the &-character as &amp; myself? as parameter encode?
<flux> (in addition to other possible translations, such as character set conversions?)
<flux> bah, it doesn't do it
<flux> perhaps I'll just patch that in
<flux> or should it be the responsibility of the party putting stuff inside the XML tree? (ie. my other code)
<flux> (but that's bloody annoying, putting quoting calls everywhere ;))
<flux> well, it turns out that the xml language extension puts 'EncodedPCDATA' nodes in, not 'PCDATA', so the encoding function isn't called
<flux> but I wonder if the encoding is meant to be for different kind of encoding. that is, character set encoding, not that & -> &amp;.
<mfp> flux: I've submitted xhtmlcompact_lite.ml* to the Ocsigen team; my changes have been merged into Ocsigen 1.2
<mfp> and it's now possible to use XHTML.M without the (Ocsigen's) stream stuff
<mfp> there's a default implementation for encode (XML.encode_unsafe)
<flux> nice, I guess I'll upgrade then. or wait until godi updates, if it hasn't already
<flux> mfp, but things like $str:name$ don't get encoded with it?
<mfp> (encode_unsafe does '<' -> Buffer.add_string b "&lt;" | ... | c when is_control c -> (* #xxx *) )
<mfp> hmmm don't remember what that expanded to
<mfp> if it's EncodedPCDATA, it will be used as is
<flux> yes, it is
<flux> I suppose I need to encode those
<chahibi> What would be the benefits of an OCAML web framework compared to popular existing ones?
<flux> chahibi, well, I'm mostly just playing, but I'd say performance and cool things like statically checked html and sql queries
<flux> and, of course, an excellent language to bind them all :)
<Camarade_Tux> I'd add safety
<Camarade_Tux> what does xhtmlcompact precisely do btw ?
<Smerdyakov> chahibi, any time you're doing programming, you can benefit from using a better language. :)
<flux> camarade_tux, it's just a way to generate xhtml from XML trees
<flux> camarade_tux, and ocsigen has a syntax extension for generating such trees
<Smerdyakov> flux, BTW, anything you can implement in OCaml will be lame compared to Ur/Web. ;)
<flux> so I can write stuff like << <span class="category">$str:replace_amp name$$list:ds_tags$</span> >>
<Camarade_Tux> flux, ok, thanks
<flux> smerdyakov, well, I've got tons of libraries at my disposal for O'Caml compared to Ur/Web :)
<flux> but indeed, this is such a small project that I think I could even give Ur/Web a try..
<Smerdyakov> flux, I think that's a relatively unimportant point.
<mfp> chahibi: Ocsigen brings static safety (valid XHTML, no broken links, correct param types, etc.), performance, more reliability (because most interpreted langs have subpar runtimes), and easier deployment (can compile the server + the app code into a single (static) exec without external deps)
<Smerdyakov> flux, C libraries abound, and everyone can interface with C.
<flux> interfacing with C is often error prone and fiddly
<Smerdyakov> flux, I wonder if anyone but me could use Ur/Web for a real project yet. It would be interesting to see. :D
<flux> nicer to interface with something that's already tested and provides a type safe interface
<Camarade_Tux> I haven't had time to really learn ocsigen (and the project to practice it)
<flux> I don't actually use ocsigen, I use ocamlnet
<flux> but I use that syntax extension part of ocsigen
<Smerdyakov> I will never be able to go back to the inexpressiveness of ML for web programming again.
<Smerdyakov> You have to do too much boilerplate coding.
<flux> smerdyakov, well, I have one small toy project where one part is an IRC-bot and the other is the web page
<flux> I don't think Ur/Web is suitable for the IRC-bot, and I wouldn't be able to share any code between them if I wrote the web page in Ur/Web
<flux> albeit, small the project is, so the amount of shared code is also small :)
<Smerdyakov> That's not true. I may even add support for ML interfacing in some later version. C FFI is already pretty much there.
<flux> btw, does it have a date/time library?
<Smerdyakov> There's a time type in the basis, with not so much fancy support yet.
<det> I recall ocsigen making a lot of blog posts on planet ocaml lately.
<det> Seems similar to Ur/Web
<det> not that I have any familiarity with Ur/Web
<Smerdyakov> Ocsigen is quite far behind Ur/Web in metaprogramming capability.
jah has joined #ocaml
<bluestorm> oh
* mrvn wonders about using type foo = Nil | Clean of `Clean bar | Dirty of `Dirty bar | Pending of `Dirty bar | Writing of `Const bar
<bluestorm> hm
<bluestorm> what were those _blue versions ?
<thelema> do you remember the version of fold_right that we (mostly you) came up with?
<bluestorm> hm
<mrvn> Why is extlib_native getting worse with bigger lists?
<bluestorm> oh yeah, I remember this one
<bluestorm> it was associated to Nicolas Pouillard in my mind, don't know why
<thelema> really? somehow I have it attributed to you...
<bluestorm> not that pretty :D
<bluestorm> yes I think i coded it
<thelema> definitely not easy to read for the first... 20 times
<mrvn> Have youtimes that against List.rev + fold_left + List.rev?
<thelema> mrvn: that's what JS's core lib does - I'm adding them to my test suite now.
<thelema> mrvn: actually, fold_right = fold_left + List.rev (no second rev needed)
Ariens_Hyperion has joined #ocaml
<bluestorm> it's strange that extlib version perform badly
<bluestorm> on paper it's the best one by far
<thelema> gallium have always insisted that their versions of the stdlib functions are better than extlib's
<bluestorm> hm
<bluestorm> did you run the bench with the standard GC setting ?
<bluestorm> i suspect gallium version is very dependent on those
<thelema> yes - I didn't tweak GC at all
<bluestorm> it may be faster than the ugly blue_* with bigger pool sizes
<flux> it'd be nicer to see the list operations per second per element?
* thelema was happy staying away from any floats, but if you really want...
<mrvn> thelema: That should be a horizontal line more or less, right?
<thelema> mrvn: there'll be a bump in the line when GC limits hit
<mrvn> that would be the less part :)
<thelema> it would be horizontal if the lines on my graph would be vertical
<flux> and horizontallish plots are nicer than ones which one can't really see what is the base level?-)
<mrvn> Idealy the time per element should be the same no matter how long the list is.
<flux> mrvn, "ideally", "should", etc :-)
<flux> mrvn, if that is true, then we can just test with, say, 1000 elements
<flux> but even in those graphs we can see that there will be deviations
<mrvn> So the goal would be horizontal and any deviation would be easy to spot. With the sloping lines the ideal is a harder to see.
<bluestorm> thelema: you should try running them with say OCAMLRUNPARAM="s=2M"
<flux> thelema, and after finding cool set of parameters you can do 3d graphs! woohoo!
<thelema> flux: i'd have to change methodology - my current test runs as many iterations as it can within one second, and the graph is how many... as the # of iterations gets low (say, around 1), there's too much inaccuracy, as I can't tell whether it did 1.2 passes or 1.8 passes in one seconds.
<flux> thelema, hmm, can't you just change the gnuplot parameters?-o
<flux> you have set of points length, time?
<flux> render (length, time / length) ?
<thelema> echo "set logscale x; set logscale y; set terminal png; set xlabel \"List Length\"; set ylabel \"List-operations per second\"; set output \"$@\"; plot \"$(basename $@).gallium_byte\" w lp, \"$(basename $@).extlib_byte\" w lp, \"$(basename $@).gallium_native\" w lp, \"$(basename $@).extlib_native\" w lp" | gnuplot
<flux> plot \"$(basename $@).gallium_byte\" using $1:$2/$1 w lp .. ?
<mrvn> thelema: Do n iterations lowering n as length increases so that you have between 5-10 seconds per test.
<thelema> does make support heredocs?
<Camarade_Tux> btw, just to be sure : are you running the tests with the "performance" cpu governor and not another one as ondemand ?
<flux> hmph, what was the syntax..
<mrvn> thelema: cat << EOF \
<mrvn> $(VAR)
<mrvn> EOF ?
<mrvn> no, forget that. that won't work.
<thelema> Camarade_Tux: unlikely, but I'm roaming around a bit now, so it's possible I was plugged in for one set and unplugged for the second. I do a single iteration before starting the clock, so that should help prime the governor.
<flux> pft, my gnuplotfo is weak
<thelema> mine too.
<flux> plot .. using 1:($2/$1)
<flux> shouldn't that give the plots?
<Camarade_Tux> thelema, when benchmarking webkit's squirrelfish, the ondemand governor gave a 30% performance hit compared to the performance one
<Camarade_Tux> (but the benchmarks were microbenchmarks)
<thelema> Camarade_Tux: ok, I'll redo all the raw data now
<thelema> ... once I get my code to build again
<flux> somehow I expected the image would've changed more :)
maskd has quit [Read error: 110 (Connection timed out)]
<flux> but autoscaling does wonders..
<thelema> flux: I took y off logscale, and it was a useless 1/n curve, with 99% of data points stuck to x-axis
<flux> ah, of course
<thelema> maybe if I trim the short lists
<flux> the image is about as good as it can now
marmottine has quit ["mv marmotine Laurie"]
<bluestorm> is it run on only 1 second ?
<thelema> bluestorm: yes, I run until one second has passed, and the count that have run is my data point
<bluestorm> hm
<bluestorm> i'd run it for a bit more than that
<bluestorm> say 5-10 secs
* thelema parameterizes the time
<bluestorm> (have you tried with my bigger minor heap settings ?)
<thelema> not yet
kaustuv_ has quit [Remote closed the connection]
kaustuv_ has joined #ocaml
<thelema> grr, core's implementations don't have the same signatures as stdlib/extlib
<hcarty> thelema: They wrote a bit about that on blog post, or perhaps on the mailing list. They gave up stdlib compatibility for consistency in argument order, labeling and a few other items
<flux> I can't say I fully disagree with them
<flux> while foldl/foldr has a logic in the argument order, it's nice to have the arguments always in the same order :)
<hcarty> No, particularly given the issues discussed in yminsky's talk and their code review procedures
jah has quit []
<hcarty> It would make it more difficult to switch to Core rather than Batteries with an existing set of code using stdlib/Extlib
ygrek has quit [Remote closed the connection]
<thelema> extlib's fold_right really suffers for some reason...
pants1 has joined #ocaml
<thelema> bluestorm: your fold_right implementation beats all comers for lists > ~50_000 elements
<hcarty> Yoric[DT], thelema: Sorry to keep asking this - Should I remove some of the functions from Seq.Exceptionless?
<hcarty> There are functions in there which raise Invalid_argument in the normal module, and according to Yoric[DT]'s comment this is acceptable in the Exceptionless case
<thelema> double-rev based implementations (such as jane street's) rank at the bottom of the heap of list functions
<bluestorm> thelema: i'm not sure we'd want something so ugly as the standard library function, though
<hcarty> I'm leaning toward switching large portions of my code to use the Exceptionless modules since the move to Batteries is biting me with a lot of changes in exceptions thrown by various functions
<hcarty> Particularly the changes in the List module
<thelema> bluestorm: we could definitely have a fold_right_biglist function, for when you know you're going to fold right over a big list
<bluestorm> why not
<thelema> hcarty: can we put the List exceptions back to what they were in stdlib?
<flux> thelema, how slow would be a variant that switches after 1000 iterations?-)
<bluestorm> flux: my version already essentially do that
<bluestorm> lt fold_right_max = 1000
<bluestorm> +e
<thelema> flux: there's a noticeable drop in thoroughput on blue's function at 1000 iterations because of that. If it switched after 50_000 iterations, it'd probably win for all argument sizes
<thelema> (on this microbenchmark)
<bluestorm> the problem is that that would make the call stack 50_000 bigger
<thelema> well, 49_000 bigger, but yes...
<hcarty> thelema: I think the changes are largely for the best - replacing Failure exceptions
<hcarty> thelema: I'm not sure what the proper approach would be though
<bluestorm> thelema: we could make that fold_right_max (with a better name) a reference and let the library user play with it
<hcarty> I don't like that there is are separate "Empty_list" and "Invalid_argument" exceptions used in Batteries.List though
<hcarty> s/is //
<bluestorm> (as well as chunk_size possibly, though that may be a bit abstraction-breaking)
<thelema> bluestorm: we could add it as a parameter to fold_right_biglist
<thelema> does anyone else have opinions on the Empty_list / Invalid_argument exceptions?
<bluestorm> if it's a parameter, it should be optional
<bluestorm> hm
<bluestorm> i'd rather not have a parameter, that would break the interface compatibility
<hcarty> thelema: Their use is inconsistent in the List module
<hcarty> thelema: For example, (List.hd []) raises Empty_list while (List.reduce f []) raises Invalid_argument
<thelema> bluestorm: if someone is going to intentionally use it for big_lists, I don't think they'll mind the interface difference. If we add it as the first parameter, they can do [let fold_left = fold_left_biglist 1000]
<hcarty> thelema: And I'm not sure if it would be best to give every module its own "Empty_foo" exception or if it would be better to stick with Invalid_argument everywhere
<thelema> hcarty: I'm committing a fix for that now. anything else?
<hcarty> thelema: Is the fix to make everything use Empty_list or Invalid_argument?
<thelema> I don't think every module needs an Empty_foo exception, maybe list is special
<thelema> just reduce to use Empty_list
<Camarade_Tux> what about a module with global settings that have an impact on performance like the Gc module ?
<bluestorm> I'm not fond of that "global" idea
<hcarty> thelema: That sounds ok to me. Perhaps List deserves a bit of special treatment.
<bluestorm> hcarty: why so ?
ttamttam has left #ocaml []
<thelema> hcarty: lists are special in functinal languages
<bluestorm> I consider Enum as more "fundamental" as List in Batteries
<thelema> Camarade_Tux: I agree with bluestorm
<bluestorm> s/as/than/
<thelema> bluestorm: enum has an "empty" exception
<hcarty> bluestorm: I think Extlib introduced the special handling of List, though I may be wrong about that
<hcarty> Yes, it looks like Extlib introduced the Empty_list exception
<hcarty> I would prefer, in an ideal world, that every module has the same structure for exceptions.
<Camarade_Tux> thelema, bluestorm, on second thought, it wouldn't be that useful
<hcarty> Either lots of special, per-module exceptions or none
<hcarty> thelema: In this case, should functions which can raise exceptions such as Empty_list be added to the appropriate Exceptionless module?
<hcarty> Or is Empty_list to be treated as a special case of Invalid_argument?
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
<thelema> empty list is a special case of Invalid_argument
jeanb-- is now known as jeanbon
<hcarty> thelema: Thank you for the clarification and for posting the List fix. If these things have been biting me in moving my relatively small code base over I imagine they will affect others as well
<thelema> you're welcome. It's good to get this feedback, as most people would just give up on batteries without us ever knowing
<hcarty> My evaluation has been largely to help me decide if I should use Batteries or just cherry pick the parts I want :-)
<hcarty> I have been happy overall with the transition
<thelema> well, our intent is to make the whole batteries worth the transition
_andre has joined #ocaml
<thelema> bluestorm: the reason I only test for one second is that I can do a lot more tests this way - as it is, I have 10 functions * 28 list lengths * up to 4 implementations per function * {native, byte} * other parameters to test (heap sizes, etc)
ygrek has joined #ocaml
_zack has joined #ocaml
ygrek has quit [Remote closed the connection]
Fullma has quit [Read error: 104 (Connection reset by peer)]
jamii has quit [Read error: 113 (No route to host)]
chahibi has quit ["Leaving"]
<thelema> core's fold_right is really bad. fold_right => rev + fold_left is a poor transition
chahibi has joined #ocaml
<flux> hmph, am I correct in that ocamlnet handles redirects internally?
<flux> I suppose it might also be the scgi-module. in which case it sucks.
<thelema> it's useful to handle redirects both internally and externally (so the browser is pointing at the right URL)
<flux> I'd like to make the web browser go from /foo -> foo/
<flux> uh, /foo/ that is
<flux> and I get two requests, one which I redirect and one which is the proper / -page
<flux> but my telnet client never gets a redirect..
<flux> hah, I shall sniff the connection between apache and my app
<thelema> flux: firebug is great
<thelema> also there's a FF plugin to watch headers
<flux> yeah, I use firebug
<flux> but the thing never seems to reach the browser
<flux> the SCGI seems to get my redirect response
<flux> SCGI module that is
<flux> so it's the module that must do its internal redirection handling. surely apache wouldn't?
<flux> I suppose it's time to use META headers..
oriba has joined #ocaml
jeanb-- has joined #ocaml
<flux> mod_scgi does internal redirection
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
<flux> workaround is to use a full url. actually, it may be desirable anyway..
Symmetry- has quit [Read error: 104 (Connection reset by peer)]
slash_ has joined #ocaml
jeddhaberstro has joined #ocaml
jamii has joined #ocaml
Ppjet6 has quit [Read error: 113 (No route to host)]
jamii has quit [Read error: 113 (No route to host)]
Ariens_Hyperion has quit []
pants1 has quit ["Leaving."]
bluestorm has quit [Remote closed the connection]
jamii has joined #ocaml
jeanbon has quit [Read error: 104 (Connection reset by peer)]
jamii has quit [Read error: 113 (No route to host)]
<Camarade_Tux> it would be really great to have a display of the return values of all the different functions at the same time
tty56 has joined #ocaml
komar_ has quit [Read error: 104 (Connection reset by peer)]
_zack has quit ["Leaving."]
<Alpounet> good night
Alpounet has quit ["Quitte"]
hkBst has quit [Read error: 104 (Connection reset by peer)]
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has joined #ocaml
chahibi has quit ["Leaving"]
ofaurax has quit ["Leaving"]
tty56 has quit []
Ariens_Hyperion has joined #ocaml
Ariens_Hyperion has quit [Client Quit]
slash_ has quit [Read error: 104 (Connection reset by peer)]
Yoric[DT] has quit ["Ex-Chat"]