dan2 changed the topic of #ocaml to: OCaml 3.08.2 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/
<judge> smimou: what are you doing with ocaml/c?
<judge> i was just messing with these same macros a few hours ago
ne1 has quit ["Few people understand understanding."]
<smimou> bindings for ssl
<judge> ah
<judge> i see
<judge> i'm working on doing an os in ocaml
<judge> so threading a c<->gc interactions are interesting
<smimou> interesting (you must be the one posting on the caml-list:)
<judge> no
<judge> that's my friend
<smimou> is there any code publicly available ?
<smimou> ok
<judge> it's all in my svn repo
<judge> we just havent released it cos it's not shiny yet
<smimou> what do you have working for now ?
<judge> but my network stack can respond to pings and we have an ocaml kb driver
<dan2> judge: os in ocaml huh
<dan2> judge: how do you write stacks to handle memory allocation in ocaml
<smimou> judge: did you have a look at the previous attempts to write a kernel in caml ?
<judge> low level stuff is in c
<judge> so malloc/friends
<dan2> judge: ok, was just wondering
<judge> memcpy/etc
<dan2> judge: make the kernel a microkernel
<judge> on top of that lives the ocaml runtime
<judge> we found one other project that claims to be an ocaml os
<dan2> judge: in fact, write a coreutils in ocaml
<judge> but the os is all done in c
<judge> and ocaml is run in userspace
<dan2> judge: yeah you have to
<judge> as a regular app
<judge> which is silly
<dan2> judge: hmm you could embed ocaml in the kernel if you want
<judge> we do
<dan2> which would be prety damn quick
<judge> you can try it
<judge> if you are lucky
<judge> type make
<judge> and you'll get a floppy.img
<dan2> judge: why don't you take an existing kernel an implement it, like, the linux kernel
<judge> cos C should burn in hell :)
<dan2> judge: but you can't implement a kernel in ocaml
<judge> no
<dan2> judge: thats why I said build a microkernel
<judge> you cant implement kernel in 100% ocaml
<judge> but you can implement a kernel with minimal C/ASM
<judge> and lots of ocaml
<dan2> judge: yeah, microkernel
<dan2> judge: do you know what a microkernel is?
<judge> yes
<dan2> judge: why not take the l4 microkernel and build ocaml off that
<judge> cos it's a complicated beast
<dan2> its not that bad
<dan2> but l4 is fast
<dan2> erm
<dan2> l4 pistachio is the fastest microkernel in the world
<judge> yes, but i'm not making a kernel for you
<dan2> how do you plan to do device drivers in ocaml
<judge> i'm making myself a nice reliable os
<judge> dan2: it's fairly easy
<judge> same as in C really
<judge> just have to be careful
<dan2> judge: heh
<judge> linux/newos/netbsd/etc wrap asembly stuff in C
<judge> as do we
<judge> but then call it from ocaml
<dan2> I don't like the idea of using a garbage collected language for driver for development
<judge> heh
<judge> but my stupid tcp stack can handle a ping flood while using less than 10K of ram
<judge> without any optimizations
<dan2> judge: you ever hear of forth?
<judge> ok
<judge> i'm gonna go back to my dhcp code now
<dan2> judge: forth, math library + editor + compiler in under 14k
smimou has quit ["?"]
<judge> Alan Kay said that if you think you can do better, try it
<judge> so instead of trying to patch existing OSes or something
<judge> we decided to try our approach from scratch
<judge> and so far we have good results
<judge> everybody else is welcome to use C, but we get an os that's a pleasure to program
<judge> and which should theoreticly be quite robust
<dan2> judge: do you have a c library for it?
<judge> yeah
<dan2> judge: do you have seperate memory spaces
<judge> ripped netbsd's one
<judge> dan2: todo
<dan2> judge: how fast is your process spawning
<dan2> judge: todo eh, then its about as robust as dos
<dan2> judge: dos if you have a segfault it would crash the whole system
<judge> dan2: yes it's as robust as dos
<judge> after 1 week of active coding
<dan2> *sigh*
<dan2> you could create dos in a week
<judge> why do you have such a need to whine?
* dan2 hugs pistachio
<dan2> judge: my question is, why do you need another kernel?
<dan2> take a good well built kernel
<dan2> and build off of it
<judge> i want to write another kernel to bother you
<senko> hey! a ocaml kernel is way more cool! :)
<dan2> senko: thats like writing a kernel in java, impossible
<judge> heh
<judge> dan2: there is a couple of java kernels
<senko> that only makes it more interesting :)
<dan2> judge: you can't boot a system with them
<judge> dan2: you cant
<judge> senko: some people just don't get it :)
<judge> senko: what's your ssl lib for?
<senko> dont know?
<senko> what is it fore? :)
<senko> *for
<judge> heh
<judge> senko: well, when you get bored, feel free to give us a hand
<judge> :P
<senko> id love to, but im not very skilled..
<dan2> judge: did you rip off the BSD network stack?
<judge> dan2: no, mine is currently 200lines of ocaml
<dan2> judge: can I see
<judge> just does basic arp, ip, icmp and soon udp/dhcp
<dan2> judge: tcp is a bitch to put in a network stack
<judge> dan2: looks that way
<dan2> judge: I've written network stacks
<judge> i'm gonna separate that code out
<dan2> judge: I personally would have ripped off the BSD or Linux network stack these days
<judge> and make it so one can use it as a userspace stack on linux
<judge> that's good for network testing/etc
<judge> dan2: i don't care what you'd do personally
<dan2> judge: Linux and BSD have the world's two best network stacks
<judge> in general
<judge> its fairly rude to lecture me on what i should be doing
<dan2> judge: if you make it a userspace layer, could you build in an aio library
<judge> i dunno what aio is
<judge> if it's easy to deal with
<judge> sure can
<dan2> judge: async io
<dan2> judge: so you can queue and operation and get some sort of signal when its done
<dan2> judge: basically an event system built in
<dan2> but many case study's show that aio is only useful built in to the kernel
<dan2> otherwise it doesn't scale
<judge> heh
<judge> studies
<judge> :P
<judge> i did a study on the price of pizza
<judge> dan2: if you see any bugs in the code
<judge> there is many
<judge> a patch would be nice
<dan2> ok
<judge> dan2: you can try to make floppy.img
<judge> then you can ping the os
purevoid has joined #ocaml
<judge> currently it responds to all arp queries and all icmp requests
humasect has joined #ocaml
monochrom has joined #ocaml
KrispyKringle has joined #ocaml
Smerdyakov has joined #ocaml
Svrog has joined #ocaml
humasect has quit [Read error: 104 (Connection reset by peer)]
gim has quit ["zzzz++"]
Smerdyakov has quit ["Tell the sunset I'm on my way."]
quamaretto has joined #ocaml
<quamaretto> If my function returns a tuple, is the best way to use the tuple values in a non-tupular fashion to use match with a single pattern, or am I missing something obvious?
<Riastradh> let (x,y,z) = f a b c in ...
<quamaretto> ARGH! I lose.
<quamaretto> Thank you.
<quamaretto> And I come from being Python-crazy. I should be ashamed. :)
Submarine_ has quit [Remote closed the connection]
vezenchio has quit ["Greenspun's Tenth Rule of Programming: any sufficiently complicated C or Fortran program contains an ad hoc informally-specif]
Banana has quit [Remote closed the connection]
<quamaretto> Is there a better way to "pause" than Unix.sleep?
<pango> better in what way ?
<monochrom> getLine
<pango> you can use select for smaller granularity
<quamaretto> Granularity, I guess. Unix.sleep takes integers...
<pango> let usleep d = ignore (Unix.select [] [] [] d)
<KrispyKringle> quamaretto: out of curiosity, why are you trying to pause? user interface thing, or what?
purevoid has quit [Read error: 110 (Connection timed out)]
<quamaretto> Well, at the moment, I'm just writing a thing that draws a parabola over time.
<quamaretto> As in, draws a parabola as the path of an object over time. In real time.
<quamaretto> I'm just trying to wrap my brain around ocaml at the moment, and that's what I'm doing
<KrispyKringle> ah, ok
<KrispyKringle> i was just going to say, in general, it seems that if someone wants to sleep, he's not writing his program right ;)
<KrispyKringle> IMHO.
<monochrom> That's a truism. If he is sleep-deprived, he should go to sleep rather than code.
<Riastradh> Sleep is for wimps.
<Riastradh> Or students during classes.
<Riastradh> Caffeine is what he really needs.
<quamaretto> What module is that in?
<quamaretto> Okay, I've found a saner way to do it, which is to set an interval timer...
<KrispyKringle> quamaretto: Unix :P
<KrispyKringle> if yo meant Unix.sleep
<KrispyKringle> you, even.
<quamaretto> KrispyKringle, I started out trying to get away from Unix.sleep :)
<quamaretto> Because it only takes integers.
<KrispyKringle> oh. sorry :P
<KrispyKringle> couldn't remember where we were at ;)
<quamaretto> I should go to sleep now.
<quamaretto> :/
<KrispyKringle> i *thought* you'd mentioned Unix.sleeep, so I couldn't figure out why you'd ask which module it's in :p
<KrispyKringle> yeah, same. i have to be up fairly early tomorrow.
<quamaretto> I was asking which module [sic] caffeine was in.
<quamaretto> So, g'night
quamaretto has quit [""...people who aren't capable of reading adult books shouldn't talk about them." - C.S. Lewis"]
<KrispyKringle> heh
KrispyKringle has quit ["Get MacIrssi - http://www.g1m0.se/macirssi/"]
<monochrom> Bed is for reading. Class is for sleeping.
<Riastradh> Exactly.
<Svrog> haha
* Riastradh goes off to bed to read for the next eight hours.
<mbh> hmmm
monochrom has quit ["Few people understand "understanding"."]
mrsolo has quit [Read error: 60 (Operation timed out)]
purevoid has joined #ocaml
purevoid has quit []
mbh has quit [Read error: 110 (Connection timed out)]
mbh has joined #ocaml
Herrchen has joined #ocaml
smimou has joined #ocaml
Banana has joined #ocaml
mbh has quit ["Lost terminal"]
mrvn_ has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
Submarine has joined #ocaml
smimou has quit ["?"]
Svrog has quit [" HydraIRC -> http://www.hydrairc.com <- irc client ownage!"]
Submarine has quit ["Leaving"]
pnou has joined #ocaml
pnou has quit [Client Quit]
vezenchio has joined #ocaml
CLxz has quit [Ping timeout: 14400 seconds]
pnou has joined #ocaml
Tristram has joined #ocaml
Submarine has joined #ocaml
Smerdyakov has joined #ocaml
smimou has joined #ocaml
Smerdyakov has quit ["BRB!!"]
Smerdyakov has joined #ocaml
Banana has quit ["Lost terminal"]
Banana has joined #ocaml
menace has joined #ocaml
gim has joined #ocaml
smimou has quit ["?"]
monochrom has joined #ocaml
mbh has joined #ocaml
budjet has joined #ocaml
pango has quit [Nick collision from services.]
pango_ has joined #ocaml
budjet has quit [Remote closed the connection]
gim has quit [Read error: 104 (Connection reset by peer)]
Banana has quit [Read error: 113 (No route to host)]
gim has joined #ocaml
xet7 has joined #ocaml
<xet7> Hi, with which code in OCaml calculation 1/2 gives correct answer? without adding .0:s?
<Smerdyakov> What is "the correct answer"?
<lodewijk> what would you consider the correct answer to be?
<xet7> 0.5
<Smerdyakov> Impossible
<Smerdyakov> (/) : int -> int -> int
<lodewijk> (float 1) /. (float 2)
<xet7> thanks :)
fab__ has joined #ocaml
Smerdyakov has quit []
Smerdyakov has joined #ocaml
Banana has joined #ocaml
_fab has quit [Read error: 110 (Connection timed out)]
menace has quit []
<dan2> hmm
<dan2> whats the best approach to writing the merge sorting algo in ocaml
<dan2> nevermind
<Smerdyakov> Use the implementation in the standard library.
pnou has quit ["leaving"]
<dan2> Smerdyakov: nah, I want to make my own
<dan2> so it looks like something like this
<dan2> let rec merge a b =
<dan2> match a,b with
<dan2> | a,[] -> a
<dan2> | [],b -> b
<dan2> | ha::ta,hb::tb ->
<dan2> if (ha <= hb) then
<dan2> merge ta (hb::tb)
<dan2> else
<Smerdyakov> Hooray for flooding. >:[]
<dan2> hb::(merge (ha::ta) tb);;
<dan2> yay
<mbh> Amorphous: freenode can handle it :)
<mbh> er
<mbh> Smerdyakov
<Smerdyakov> mbh, it's considered bad etiquette.
<mbh> because it's disrupting the many conversations going on right now? :)
<Smerdyakov> mbh, are you a Berkeley student?
<mbh> yeah
<Smerdyakov> Did I already know that
<Smerdyakov> ?
<mbh> <-- async
<Smerdyakov> Aha.
<Smerdyakov> Why don't you have a web site?
<mbh> because i haven't done anything significant?
<Smerdyakov> Doesn't matter. You could include exciting information, like which classes you are taking!
<Smerdyakov> There you go!
<Smerdyakov> Are those classes for last semester?
<mbh> yeah
<mbh> are you going to be a TA for 61a?
<Smerdyakov> I don't know yet. I haven't heard anything.
<mbh> i'd like to be a reader again
<mbh> it was pretty fun actually
<Smerdyakov> Have you done anything about that idea for an ML class?
<dan2> in a match
<dan2> whats the best way to show only one element in the list
<mbh> i asked necula, he said he'd be willing to sponsor it next semester
<Smerdyakov> dan2, "show"?
<dan2> ugh
<dan2> Smerdyakov: will [a] work
<Smerdyakov> mbh, that's ridiculous! He's on sabbatical! :D
<Smerdyakov> dan2, that will match any one-element list.
<mbh> i mean F 2005
<mbh> hehe
<dan2> Smerdyakov: thats what I want
<Smerdyakov> dan2, tada!
<mbh> dan2: are we supposed to test that code for you?>
<dan2> mbh: no, I just wanted a question answered
<Smerdyakov> mbh, what year are you now?
<mbh> 2
<mbh> dan2: sorry, what was the question?
<monochrom> The question is such that its answer is "match whatever with [a] -> ..." the [a]->... part
<dan2> whats a function that splits a list like splitAt in haskell
<mbh> i don't think there is one in the standard library, but it's easy to make one
<mbh> there is a List.merge though :)
<dan2> ugh
<dan2> mbh: I just wrote my own merge implementation
<dan2> mbh: not that I understand what List.merge does
<dan2> mbh: it doesn't seem to be an implementation of Merge algorithm
<mbh> List.merge compare [1;3;5] [2;4;6]
<dan2> hmm
<dan2> or maybe something is wrong with my merge algo
<Smerdyakov> dan2, definitely
<dan2> Smerdyakov: I don't see anythinng obvious that I did wrong
<dan2> I swore I did a direct translation of what the haskell algo
<dan2> Smerdyakov: maybe the haskell algo is wrong
<dan2> Smerdyakov: I'm going to look for the algorithm text instead
<mbh> dan2: does your algo sort it in descending order?
<mrvn_> dan2: do you have the source pasted somewhere?
<dan2> I pasted it above
<dan2> right where smeryakov is talkinga bout flooding
<Smerdyakov> The error should be obvious.
<dan2> <Smerdyakov> Hooray for flooding. >:[]
<Smerdyakov> Try any two calls with the same second argument.
<Smerdyakov> I think you will get the same result. Your implementation is an identity function in its second argument.
lodewijk has quit [Remote closed the connection]
lodewijk has joined #ocaml
<dan2> Smerdyakov: hmm?
<mrvn_> dan2: you are forgetting ha in the <= case
* dan2 looks
<mrvn_> And for a merge sort you need to do log n merges
<mrvn_> And you should try to make it tail recursive.
<dan2> mrvn_: hmm, ok... but it isn't tail recursive as is?
<mrvn_> hb::(merge ...) isn't.
<dan2> hmm ok
<dan2> mrvn_: what would I have to do to change that
<mbh> pass the list you're building as an argument
<dan2> mbh: I see
<dan2> so
<dan2> change hb::(merge (ha::ta) tb);;
<dan2> to merge hb::ta ha::tb
<Smerdyakov> LOL
<Smerdyakov> Try that and see what happens.
<dan2> yeah this is stupid
<dan2> I know that won't work
<dan2> its the same as ha::ta hb::tb
<dan2> so it calls itself endlessly
<Smerdyakov> mbh is suggesting that you change the type of your function.
<dan2> Smerdyakov: in what sense
<Smerdyakov> In the sense that it will have a different OCaml type than your current version does....
<dan2> I don't see how
<Smerdyakov> Then you should read a functional programming textbook or tutorial.
<dan2> this also means the haskell implementation was poorly implemented
<dan2> I was just copying it
<mrvn_> let rec loop accu a b = match (a, b) with ([], []) -> List.rev accu | (a,[]) -> (List.rev accu) @ a
<mrvn_> | ([],b) -> (List.rev accu) @ b | (ha::ta, hb::tb) -> if (ha <= hb) then loop (ha::accu) ta b else loop (hb::accu) a tb
<Smerdyakov> mrvn_, it's a little silly to set things up so that you need to reverse the accumulator at the end, don't you think?
<mrvn_> Smerdyakov: you can use a set-bang to append to a list but that is very dirty.
<Smerdyakov> Hm.. maybe not. I was thinking of just reversing the <= to >=, but that wouldn't work!
<dan2> mrvn_: but now that requires 3 lists
<dan2> mrvn_: that isn't the same as my merge
<mrvn_> dan2: let merge a b = loop [] a b;;
<dan2> bah
<Smerdyakov> mrvn_, there is "set-bang" in OCaml?
<mrvn_> dan2: for merge sort you would avoid the List.rev and use <= and >= alternating in the sort loops.
<dan2> mrvn_: ok
<mrvn_> Smerdyakov: worst case you use Obj.magic.
<Smerdyakov> mrvn_, that's a pretty bad case.
<mbh> can you do set! with Obj.magic?
<dan2> mrvn_: what does List.rev do
<mflux> smerdyakov, hm, I've found it common to have the need to reverse accumulator at the end..
<mrvn_> dan2: reverse the list so it is ascending instead of decending at the end.
<dan2> ahh I see
<mflux> if I don't want to have a O(n^2)-sections in the algorithm
<mflux> s/a //
<Smerdyakov> mflux, yeah, but I was thinking that it was easily avoidable in this case, since you can build the list in reverse order. (I was wrong.)
<dan2> mrvn_: is this really that much faster than mine?
<mrvn_> dan2: no, slower. But it works on lists greater than 1000 (or so) elements.
<Smerdyakov> dan2, no, but the OCaml implementation will give you out of memory errors with large lists for your original.
<dan2> oh hmm
<dan2> I guess that wasn't the case in haskell
<dan2> it must have limitless length lists
<Smerdyakov> That's not the issue.
<Smerdyakov> The issue is the number of stack frames allowed at once, or the amount of stack space total.
<dan2> hmm
<mrvn_> dan2: for merge sort youu will have multiple passes with growing lists and only one List.rev at the end in 50% of the cases (unless you count the list size first).
<dan2> mrvn_: hmm ok
<dan2> mrvn_: if I made it tail recursive, I wouldn't have to worry about stack frames would i
<dan2> mrvn_: and this performs at the speed of a recursive function in C huh
<mrvn_> dan2: For my merge sort I started with a single list. [] and [a] get returned directly. Other lists get List.map (fun x -> [x])'ed and then two each merged.When done repeat the merging until there is only one list left
<dan2> mrvn_: ok
<mrvn_> dan2: if it is tail recursive it is much faster than the recursive one generally.
<dan2> mrvn_: well, how do I make mine tail recursive
<mrvn_> dan2: use the code I pasted
<dan2> mrvn_: but
<dan2> mrvn_: thats slower
<mrvn_> for the full merge sort you can avoid the List.rev
<Smerdyakov> Is it really?
<mrvn_> The List.rev at the end is probably still faster than creating all the stack frames. But that depends.
<Smerdyakov> Better run a dependency analysis.
<dan2> mrvn_: what I don't understand is why you are reversing accu if you have two other empty lists
<mrvn_> dan2: The accu is the list in decending order. When a and b are empty then accu has all elements. To get the wanted ascending order you need to reverse it.
<mrvn_> dan2: What you would like is adding the ha/hb to the end of the accu each time but that is too slow.
<dan2> mrvn_: what about currying it
<mrvn_> dan2: what do you want to curry?
<dan2> mrvn_: the merge at the end of mine
<mrvn_> It already is curried by ocaml. I don't see how that changes anything.
<mrvn_> It might even be better to uncurry it, let rec loop accu = function ([], []) -> ...
<dan2> what if I did something like this
<dan2> (merge ha (merge ta (hb::tb))
<mrvn_> not tail recursive
<Smerdyakov> Think before you speak. Types, types, types.
<mrvn_> And merge needs 2 lists
<dan2> then [ha]
<mrvn_> That is not tail recursive and would probably loop forever.
<dan2> hehe
<dan2> mrvn_: I'm going to reimplement the C version instead
<mrvn_> C versions usualy append to linked lists.
<dan2> hmm
<dan2> I just want the merge algorithm written like an algorithm
<pango_> it uses arrays, not lists
<dan2> hmm
<dan2> arrays would be nicer to use
<pango_> don't know, but it's difficult to implement the same algorithm with a different data structure
<pango_> at least without expecting some changes ;)
<dan2> yes
<dan2> merge (a:as) (b:bs)
<dan2> | a <= b = a : merge as (b:bs)
<dan2> | otherwise = b : merge (a:as) bs
<dan2> was the haskell aglo
<dan2> mines practically identical
<pango_> what was the question btw ?
<dan2> dunno anymore
<mrvn_> the haskel is not tail recursive
<mrvn_> # merge_sort [1; 3; 5; 7; 9; 8; 6; 4; 2];;
<mrvn_> - : int list = []
<mrvn_> hmm, that somehow doesn't seem right.
<mrvn_> # merge_sort [1; 3; 5; 7; 9; 8; 6; 4; 2];;
<mrvn_> - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9]
<mrvn_> much better.
<dan2> mrvn_: what's the code to your merge_sort
<dan2> mrvn_: how well does that scale in comparison to the previous 2
<mrvn_> dan2: That should work with any sized list.
mrsolo has joined #ocaml
<dan2> mrvn_:
<dan2> erm
<dan2> well the alternative is I could use the C version and camlidl
<mrvn_> loop2 loops as long as there are lists to merge toggling between ascending and descending lists on each iteration. loop merges all pairs of lists in a list and can handle a single one at the end. merge actualy merges a pair of lists reversing its order in the process.
<mrvn_> Does the C version handle ocaml lists?
<dan2> mrvn_: but... camlidl should be able to make the switch
<mrvn_> That costs time.
<dan2> *sigh*
<mrvn_> you can optimize the code a bit more, like pulling "fn" out of the recursion. No point passing that allong each time.
<mrvn_> And you can try the merge function with (a,b) and a b as parameters to see what is faster.
<mellum> What's the problem with the standard library's sort?
<mrvn_> Or you could rewrite it to use linked lists like type 'a foo = { next : foo; val : 'a; }
<mrvn_> mellum: I think thats only for arrays.
<dan2> no, I wanted to make my own merge algo implementation in ocaml
<mellum> # List.sort compare [ 4; 666; 23; 42 ];;
<mellum> - : int list = [4; 23; 42; 666]
<Smerdyakov> mrvn_, List.sort
<pango_> dan2: and ended with the conclusion that the best way to do it with ocaml is to program it in C ?
<dan2> pango_: yes
<pango_> am I missing something
<mrvn_> Smerdyakov: I see that now. Is that new?
<mrvn_> 'The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space.'
<Smerdyakov> Beats me.
<mrvn_> That somewhat limits the list size :)
<Smerdyakov> Not much..
<mellum> Depends on the constant factors :)
<Smerdyakov> It probably works for any list that would fit in memory.
<mrvn_> The recursion limit is somewhere around 1024 calls limiting it to 2^1024 elements in a list?
<pango_> dan2: at that point you don't even know the relative efficiency of the two solutions, you just avoided learning ocaml...
<Smerdyakov> mrvn_, sounds reasonable... that's more than the addressable memory!
<dan2> # 2.**1024.;;
<dan2> - : float = infinity
<mrvn_> hehe
<dan2> 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216
<dan2> mrvn_: thats more elements than any list I've ever had to deal with
<dan2> mrvn_: I wonder how well merge sort would even scale on thast
<Smerdyakov> Well, I once had a list with 179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137215 elements, but definitely not 179769313486231590772930519078902473361797697894230657273430081157732675805
<dan2> how does compare work?
<mrvn_> The stdlib List.sort is ugly.
<dan2> mrvn_: very
<mrvn_> The chop is very ugly and slow.
<Smerdyakov> I'm somewhat surprised if it is clearly worse than something you came up with yourself.
<dan2> hehe
judge has quit ["Hey! Where'd my controlling terminal go?"]
<mrvn_> The stdlib is O(1.5 n lg n) compared to my O(n (1 + lg n)
* Smerdyakov laughs.
<Smerdyakov> Those are the same.
judge has joined #ocaml
<mrvn_> in O() yes but in real life not
<Smerdyakov> Don't use O() if you don't mean O().
* dan2 wonders what happens if you obj.magic infinity
<Riastradh> Magic.
<mrvn_> dan2: you end up in Cansas
<Riastradh> Unless you're already in Kansas, in which case you end up in Nebraska.
<Smerdyakov> Like when you blow the whistle while already in the warp zone world, in Super Mario Bros. 3.
<mrvn_> The stable_sort with external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" looks very ugly too.
<Smerdyakov> I don't concern myself with the uglyness of the standard library implementation.
<mrvn_> I mean the comment at the end.
<mrvn_> let stable_sort cmp l =
<mrvn_> let a = Array.of_list l in
<mrvn_> Array.stable_sort cmp a;
<mrvn_> array_to_list_in_place a
<dan2> mrvn_: hahaha
<dan2> mrvn_: and what does stable sort for an array look like
<mrvn_> Wouldn't array_to_list_in_place confuse the GC if it is in the middle of a major cycle and just in the middle of the array?
<dan2> mrvn_: probably
<mrvn_> The current implementation uses Heap Sort. It runs in constant stack space.
<dan2> haha
<dan2> mrvn_: if you think thats bad, don't look at glibc or pam
<judge> hah
<dan2> pam is written in 100% CPP
<judge> or any serious c code
<judge> it's CPP
<judge> dan2: yeah, it's horrid :)
<dan2> judge: yes, very
xet7 has quit [Read error: 60 (Operation timed out)]
<mrvn_> dan2: messing with the GC is much worse than the glibc code or even the glib code (which is far worse than glibc).
<dan2> mrvn_: how can glib be far worse than glibc?
<mrvn_> dan2: the API already sucks.
<dan2> mrvn_: aside from the obvious
<judge> best inspiration to not use C is to see some of the most popular c code :)
mattam has joined #ocaml
Smerdyakov has quit ["eat"]
zzorn has joined #ocaml
vincenz_ has quit [Read error: 104 (Connection reset by peer)]
zzorn has quit ["They are coming to take me away ha ha"]
vincenz has joined #ocaml
Submarine has quit ["Leaving"]
Herrchen has quit ["good night"]
<mbh> if you declare a module X in a file, and the you do 'open X' right after the module was declared, does it open the module you just declared?
<monochrom> yes
rifleman has quit [Read error: 104 (Connection reset by peer)]
smimou has joined #ocaml
smimram has joined #ocaml
CLxyz has joined #ocaml
smimou has quit [Read error: 60 (Operation timed out)]
smimram has quit ["?"]