blackdog has quit [Read error: 110 (Connection timed out)]
sergez_ has joined #ocaml
thermoplyae has quit ["daddy's in space"]
sergez_ has quit [Read error: 104 (Connection reset by peer)]
sergez_ has joined #ocaml
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
sergez_ has quit [Read error: 104 (Connection reset by peer)]
sergez_ has joined #ocaml
sergez__ has joined #ocaml
thermoplyae has joined #ocaml
AxleLonghorn has joined #ocaml
sergez_ has quit [Read error: 113 (No route to host)]
jlouis has quit [Read error: 110 (Connection timed out)]
sergez__ has quit [Remote closed the connection]
middayc has joined #ocaml
Cosmos95 has quit []
Cosmos95 has joined #ocaml
netx has quit ["Leaving"]
netx has joined #ocaml
AxleLonghorn has left #ocaml []
szell` has quit [Remote closed the connection]
szell has joined #ocaml
seafood_ has quit []
pango has quit [Remote closed the connection]
seafood_ has joined #ocaml
<ikatz>
any experts on functors here?
<ikatz>
i am building a priority queue that holds ordered types, using a functor that takes "sig type t val compare : t -> t -> int end"
<ikatz>
so, say my ordered type is "node"...
kmeyer has left #ocaml []
<ikatz>
the problem i'm seeing is that even though ordered_type.t = node, and priority_queue.t = ordered_type.t, i can't figure out how to make ocaml see the queue as holding node types
<ikatz>
i keep getting an error that it was expecting a priority_queue.t
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
middayc has quit []
Cosmos95 has quit []
Cosmos95 has joined #ocaml
mwc has quit ["Leaving"]
thermoplyae has quit ["daddy's in space"]
<tsuyoshi>
huh.. what does CAMLreturn actually do
<tsuyoshi>
actually on second thought, I don't care, it works....
ecc_ has joined #ocaml
olleolleolle has joined #ocaml
mfp has quit [Read error: 104 (Connection reset by peer)]
olleolleolle has quit []
mfp has joined #ocaml
ttamttam has joined #ocaml
olleolleolle has joined #ocaml
seafood_ has quit []
Tetsuo has joined #ocaml
tetsuo_ has joined #ocaml
tetsuo_ has quit [Client Quit]
filp has joined #ocaml
Morphous has joined #ocaml
Morphous_ has quit [Read error: 110 (Connection timed out)]
OChameau has joined #ocaml
<thelema>
ikatz: module Node = struct type t = node let compare = Pervasives.compare end;; module NodeQueue = PriorityQueue.Make(Node);;
<xavierbot>
Characters 1-6:
<xavierbot>
ikatz: module Node = struct type t = node let compare = Pervasives.compare end;; module NodeQueue = PriorityQueue.Make(Node);;
<xavierbot>
^^^^^
<xavierbot>
Unbound value ikatz
<xavierbot>
Characters 6-7:
<xavierbot>
Parse error: illegal begin of top_phrase
thelema is now known as thelema|away
<flux>
tsuyoshi, perhaps you want to add some calls to major gc and compaction if possible, to test it better :)
Yoric[DT] has joined #ocaml
rwmjones has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
Yoric[DT] has joined #ocaml
<mfp>
ikatz: you have to use "with type ..." in the signature, as in module Make(M : ORDERED) : PRIORITYQUEUE with type elm = M.t
olleolleolle has left #ocaml []
<mfp>
(actually : functor(M : ORDERED) -> ..., I mixed interface and impl syntax, but you get the point)
<mfp>
.oO(does xavierbot allow multiple phrases per line?)
<mfp>
1;; 2;;
<xavierbot>
- : int = 1
<mfp>
print_string "1";; print_string "2";;
<xavierbot>
1- : unit = ()
szell has quit [Remote closed the connection]
jderque has joined #ocaml
Snark_ has joined #ocaml
Snark_ is now known as Snark
seafood_ has joined #ocaml
szell has joined #ocaml
hkBst has joined #ocaml
seafood_ has quit []
jderque has quit [Read error: 113 (No route to host)]
p3l has joined #ocaml
ikaros has joined #ocaml
ikaros has quit [Remote closed the connection]
bongy has joined #ocaml
letrec has quit []
kig_ has joined #ocaml
kig has quit [Read error: 104 (Connection reset by peer)]
kig_ is now known as kig
dramsay has joined #ocaml
Snark has quit ["Ex-Chat"]
fradiavalo has joined #ocaml
mdmkolbe|ubuntu has joined #ocaml
ecc has quit [Read error: 104 (Connection reset by peer)]
<mdmkolbe|ubuntu>
I'm trying to translate come O'Caml code (I don't know O'Caml) to another language. Most is easy to figure out but what does "x lsr 1" mean? Is that logical-shift-right x by 1 bit (i.e. integer div by 2)?
ecc_ is now known as ecc
<rwmjones>
mdmkolbe|ubuntu, yes
<mdmkolbe|ubuntu>
rwmjones: thx
<Yoric[DT]>
mdmkolbe|ubuntu: the manual of the standard library may help you there.
<rwmjones>
is there a function to do incremental MD5 digests in ocaml?
<rwmjones>
Digest only lets me do a one-off
* Yoric[DT]
has no clue.
bluestorm has joined #ocaml
<Yoric[DT]>
Does anyone know if we have pattern-matching on objects in OCaml ?
postalchris has joined #ocaml
<bluestorm>
Yoric[DT]: there is nothing in the manual, so i assume the answer is 'no'
<bluestorm>
are you looking for a new syntax extension ? :p
<Yoric[DT]>
That's my reasoning, too, but I figured someone may have known better.
<Yoric[DT]>
:)
<Yoric[DT]>
No, I'm trying to answer Jon Harrop's latest post.
letrec has joined #ocaml
middayc has joined #ocaml
rwmjones has quit ["Closed connection"]
xavierbot has quit [Remote closed the connection]
rwmjones has joined #ocaml
<mdmkolbe|ubuntu>
Another syntax question. Does "if foo then bar; baz" mean "if foo then bar else baz" or "if foo then (bar; baz) else ???"?
<rwmjones>
mdmkolbe|ubuntu, neither
<rwmjones>
it menas
<rwmjones>
means
<rwmjones>
(if foo then bar); baz
<rwmjones>
xavierbot help
xavierbot has joined #ocaml
<mdmkolbe|ubuntu>
rwmjones: ah! thx
<rwmjones>
if false then printf "not printed"; printf "printed" ;;
<xavierbot>
Characters 14-20:
<xavierbot>
if false then printf "not printed"; printf "printed" ;;
<xavierbot>
^^^^^^
<xavierbot>
Unbound value printf
<rwmjones>
open Printf;;
<rwmjones>
if false then printf "not printed"; printf "printed" ;;
<xavierbot>
printed- : unit = ()
<rwmjones>
if false then printf "not printed" else printf "else clause"; printf "printed" ;;
<xavierbot>
else clauseprinted- : unit = ()
hkBst has quit ["Konversation terminated!"]
marmottine has joined #ocaml
filp has quit ["Bye"]
middayc_ has joined #ocaml
<bluestorm>
Yoric[DT]: i had understood that the _exn functions were intended to raise *any* kind of exception
middayc has quit [Connection timed out]
<Yoric[DT]>
bluestorm: indeed, that was the original idea.
thelema|away is now known as thelema
<bluestorm>
i'm not sure the way you presented it in your spec. is better
OChameau has quit ["Leaving"]
<Yoric[DT]>
But since there are only two exceptions covered by this recommendation and one of them is assert, which could presumably happen anywhere, it's the same thing, isn't it ?
<bluestorm>
in the specific contest of "purely-functional code" is must be, but if you don't have the regular exception way, i'm not sure for exemple i'd use a stdlib like that
<Yoric[DT]>
I don't get it.
<bluestorm>
hm
<bluestorm>
take the List.find example
<Yoric[DT]>
Yes ?
<bluestorm>
i think the _exn idea was to allow a
<bluestorm>
List.find, wich is pure ( -> 'a option)
<bluestorm>
and List.find_exn, wich raises Not_found
<bluestorm>
if i understand your spec proposal correctly, the latter is not considered anymore
<bluestorm>
eg. it would not be included in a "spec-friendly stdlib"
<Yoric[DT]>
Oh, ok.
<Yoric[DT]>
I get it.
<Yoric[DT]>
So you say that you would like to be able to write functions which do raise some exceptions.
<Yoric[DT]>
In addition to "exception-safe" functions.
<Yoric[DT]>
Is that it ?
<bluestorm>
yes it is
<bluestorm>
Yoric[DT]: and i thought it was the common use of that "_exn" idea
<flux>
the higher order function called by List.find can still cause an exception, and List.find should let it through, right?
^valerio has joined #ocaml
<^valerio>
ciao
<^valerio>
sono italiano..
<bluestorm>
flux: hm, does List.find use an higher order function ?
<^valerio>
whats??
<flux>
bluestorm, the first argument is a function, no?
<bluestorm>
^valerio: can't you speak english ?
<bluestorm>
hm.. :D
<^valerio>
not very good
<^valerio>
..
<bluestorm>
i confused it with List.assoc
<bluestorm>
sorry :p
<bluestorm>
flux: of course the provided function is unaffected
^valerio has quit [Killed by Stx (Please stop that.)]
<Yoric[DT]>
Thanks.
<thelema>
Stx: thanks
<flux>
so, what'cha guys were talking about, resume ;)
envirocbr has left #ocaml []
<Yoric[DT]>
:)
<Yoric[DT]>
bluestorm: I'm considering that for a second.
<Yoric[DT]>
Well, or more.
jonafan has quit [Read error: 110 (Connection timed out)]
ita has joined #ocaml
mdmkolbe|ubuntu has quit ["Leaving."]
<Yoric[DT]>
bluestorm: updated
<Yoric[DT]>
What do you think of the new version ?
jderque has joined #ocaml
<bluestorm>
much better in this regard
ttamttam has left #ocaml []
<bluestorm>
hm
<bluestorm>
Yoric[DT]: it's funny to see that you answered flux's question the opposite way :p
<bluestorm>
"(find some_predicate some_list) should produce value None if some_predicate raises an exception."
<bluestorm>
i'm not sure this is a good idea
<bluestorm>
as some_predicate is a user-defined function and i think he may want control over his own exceptions
<Yoric[DT]>
I believe my idea is more consistent.
<bluestorm>
hm
<Yoric[DT]>
When a user uses a non-_exn function, they should be certain that it will never raise an error.
<bluestorm>
i was just thinking of doing a find_user_exn version" :D
<bluestorm>
Yoric[DT]: i think they should be certain they won't raise an error _by themselves_
<Yoric[DT]>
Put that on writing :)
<bluestorm>
hm
<Yoric[DT]>
Sounds like a good idea.
<bluestorm>
_user_exn ? sounds horrible to me :D
<bluestorm>
i bet you allow that and we end up having _user_exn, _nearly_compliant and _was_in_bad_mood all over the place
<Yoric[DT]>
Well, the name is awful.
<Yoric[DT]>
But a variant of find specially suited for people who want to send exceptions and get them back but don't want any other exception could find its place.
* Yoric[DT]
isn't sure he would write that code, though :)
jonafan has joined #ocaml
ygrek has joined #ocaml
<bluestorm>
hm Yoric[DT]
<Yoric[DT]>
Yes ?
* Yoric[DT]
is starting to dread bluestorm's "hm".
<bluestorm>
i think the use of may_fail and generally the monadic layer is not totally obvious to non-monadic-users
<bluestorm>
you should add an example of return-using code
<bluestorm>
hm
<bluestorm>
i may do that actually
<Yoric[DT]>
ok
<bluestorm>
do you excpect the publicly-exposed functions to type mail_fail or result ?
<Yoric[DT]>
may_fail
<Yoric[DT]>
mmmhhh...
<Yoric[DT]>
Values do not match:
<Yoric[DT]>
val result : ('a, 'b) may_fail -> ('a, 'b) status
<Yoric[DT]>
is not included in
<Yoric[DT]>
val result : ('a, 'b) may_fail -> ('a, 'b) status
<bluestorm>
:p
<bluestorm>
toplevel abuse ?
<Yoric[DT]>
Not in toplevel.
<Yoric[DT]>
And I only have one type called may_fail .
<flux>
where would tehse find_exn/assoc_exn -function be put?
<flux>
ExtLib?
<flux>
wouldn't _opt be be more compatible, and perhaps even more expectable?
<bluestorm>
hm
<Yoric[DT]>
First + second question: something like that.
<Yoric[DT]>
Third: mmhhh....
<bluestorm>
i think Yoric would like to use the usual name for "pure" (ie. exception-less) functions
<Yoric[DT]>
That's the idea.
<Yoric[DT]>
So, yes, it would be more compatible.
<bluestorm>
and the _exn name for the "impure" (ie. the one we have now)
<flux>
otoh some (like me ;)) would expect a function like find actually return 'a
<Yoric[DT]>
The idea is not to keep compatibility of conventions with the existing, though.
<bluestorm>
you'd have find 'a option and find_exn 'a
<flux>
someone who's familiar with ocaml but not familiar with the library would be surprised by a different type signature for find
<bluestorm>
the problem with the _opt idea (instead of _exn) is that it doesn't scale with the different exception-less management ways : we have "option", but "either" too, etc.
<Yoric[DT]>
Ok, found my error.
<Yoric[DT]>
flux: that's true.
<flux>
and if _all_ functions that can fail are going to have an _exn-version, that would mean file output functions would need to return a bool, or be called output_exn
<flux>
and if not.. well, that's not very consistent then :)
<Yoric[DT]>
File output functions are probably not covered by the recommendation.
<flux>
the whole point of exceptions is (?) to have a secondary channel that's not quite visible?
<Yoric[DT]>
And, well, what if they're called _exn ?
<flux>
well, then you have _exn sprinkled all around
jlouis has joined #ocaml
<Yoric[DT]>
The whole point of this convention is to prevent exceptions from being too invisible :)
<flux>
well, I suppose changing all functions to fail with their return values does address that issue
<flux>
however even having a list of all functions that throw exceptions would cover that?
<flux>
perhaps tuareg could highlight functions that are known to throw exceptions differently..
<bluestorm>
Yoric[DT]: actually, i think your idea is quite heavy in term of end-user code
<bluestorm>
i mean, if one has to use "result (find ..)" everywhere
<Yoric[DT]>
bluestorm: that's my worst fear wrt this recommendation.
<bluestorm>
it's not cheaper than the old "wrap .." camlp4 extension idea
<Yoric[DT]>
which one is that ?
<bluestorm>
hm
* Yoric[DT]
has a wrap camlp4 extension, but it's probably not the same.
<bluestorm>
what you used to do with lazy evaluation
<Yoric[DT]>
ok, so it's mostly the same :)
<bluestorm>
try Result (Lazy.force the_argument) with exn -> Error exn
<Yoric[DT]>
So the answer is no, it's not cheaper than wrap.
<Yoric[DT]>
The question being: is it cheap enough ?
<bluestorm>
i'm afraid the answer will be "no"
<flux>
could the compiler be optimized to handle these kinds of cases more efficiently?
smimou has quit ["bli"]
<bluestorm>
flux: wich ones ?
<flux>
even if it were a "too specific" optimization..
<flux>
converting exceptions into values
<bluestorm>
i'm not sure try ... with .. is very costly
jlouis has quit ["leaving"]
<Yoric[DT]>
try ... with ... is expected to be quite fast.
jlouis has joined #ocaml
<flux>
so what was the cost you were referring to?
<Yoric[DT]>
bluestorm: do you have a cheaper suggestion ?
<Yoric[DT]>
flux: readability
<bluestorm>
(in my mind, it is neglectible wrt. to the additional boxing/unboxing of the pattern matching following)
<bluestorm>
(but on the other hand, i know nothing of the implementation and that all)
<bluestorm>
Yoric[DT]: i'm afraid cheaper suggestions doens't provide the same modularity
<Yoric[DT]>
That's also my conclusion.
<bluestorm>
i'm not sure the modularity is a great win here
<Yoric[DT]>
Now, we could have a Camlp4 extension to avoid the call to "result".
<bluestorm>
hm
<bluestorm>
how that ?
<flux>
how cheap is Lazy.force (lazy (foo ())) ?
<bluestorm>
flux: "less cheap" :p
<Yoric[DT]>
well, let's call it "attempt" : attempt some_expression with ...
<flux>
oh, wait, what was the point of Lazy.force lazy anyway?
<Yoric[DT]>
flux: where ?
<Yoric[DT]>
How ?
<bluestorm>
flux: hm
<flux>
in the example bluestorm wrote
<bluestorm>
the Lazy.force was used to implement "wrap" as a function
<bluestorm>
wrap (lazy ...)
<flux>
oh, ok
<bluestorm>
because you have to delay the exception-susceptible part
<Yoric[DT]>
flux: to force execution order
<flux>
so a syntactic optimization
<flux>
is lazy faster than fun () -> ?
<bluestorm>
yes
<Yoric[DT]>
flux: I suspect it's slightly slower.
<bluestorm>
hm
<flux>
hm :)
<Yoric[DT]>
bluestorm: you sure ?
<bluestorm>
:D
<bluestorm>
i'm not
* Yoric[DT]
never checked, of course.
<flux>
never check: assume!
<bluestorm>
but i guess if it was, we wouldn't bother with Lazy.t
<flux>
well, because of its semantics, maybe?
<bluestorm>
hm
<bluestorm>
then we could silently replace the Lazy module with a "fun () -> .." implementation, couldn't we ?
<Yoric[DT]>
Mmhhh....
<flux>
no
Snark has joined #ocaml
<flux>
because Lazy.force evalutes the value exactly once
<Yoric[DT]>
Something a tad harder, but yes, that's the idea.
<flux>
even if you call it multiple times
<bluestorm>
ah, see
<bluestorm>
there is memoization involved
<Yoric[DT]>
Now, the *runtime* has a "lazy" tag, so yes, I assume it's faster at least than what I had in mind.
<Yoric[DT]>
indeed.
<flux>
I suppose the memoization needs to be thread-safe though
<Yoric[DT]>
Possibly.
<flux>
with ocaml's threading model that might be quite easy though
<Yoric[DT]>
Well, anyway, I'll have to go.
<Yoric[DT]>
Time to leave the office, it's 8 pm.
<Yoric[DT]>
Cheers.
<bluestorm>
:p
Yoric[DT] has quit ["Ex-Chat"]
smimou has joined #ocaml
middayc_ has quit [Connection timed out]
love-pingoo has joined #ocaml
ttamttam has joined #ocaml
<flux>
has it been researched that what if functions would have exception signatures?
<flux>
similar to java :-)
<flux>
I think it has been atleast mentioned on the channel earlier (possibly even by me)
<flux>
something like val find : ('a -> bool/raises 'b) -> 'a list -> 'a/raises 'b
pango has joined #ocaml
<flux>
it would need some other operands though
<flux>
like [Not_found | 'b]
<flux>
should not be that difficult when we lack polymorphic exceptions
<flux>
or lemme say it this way: they would complicate matters further
<bluestorm>
hm
<bluestorm>
the polymorphic variant version is quite similar to that
<bluestorm>
hmm
<bluestorm>
it's not actually :D
<bluestorm>
i didn't see you were propagating the "raises 'b" constraint
<mfp>
yay my first ocamlopt patch: remove bound checking in Bigarray.get/set access when given -unsafe; 20 minutes to read asmcomp sources + modify + compile
<bluestorm>
:p
<thelema>
mfp: can I get a copy of that patch under the QPL license + linking exception?
<flux>
mfp, oh, you're they guy who is writing that relational algebra thingy?
<mfp>
yep
<mfp>
I'm a bit ashamed of the encoding :-|
<flux>
mfp, well, the type system isn't turing complete, so you need to live with what you have :)
<bluestorm>
i've discovered your blog with the "steam carving" posts
<flux>
mfp, I actually also was doing relational algebra, but with in a more dynamic fashion
<flux>
but as it apparently can be typed quite nicely, perhaps that's a bit redundant
<mfp>
I'm basically using polymorphic variants to encode "a is a subtype of b" using a b -> a function
<mfp>
plus existential types (encoded with polymorphic records, as usual) for products
ttamttam has left #ocaml []
<flux>
mfp, have you got plans/time for the code base?
<mfp>
flux: I'm not sure I'll be able to type aggregate functions, though (haven't really tried yet). I might give up on that and just provide a way to add "annotations" to be placed next to opaque SQL code
<mfp>
no big plans
<mfp>
I might try to add aggregates and maybe support SQLite at some point
<flux>
mfp, yes; IMO, if it's to be useful, practicality comes first :)
<flux>
mfp, did it support more complex update operations? with data from other tables?
<mfp>
nope
<flux>
I noticed it didn't support the IN operator; one can often encode that with a join, though
<mfp>
but it seems doable
<flux>
but I might still give it a go in a place where I have currently tons of hand-written queries
<flux>
(and some composed ones: composing is far from pretty ;-))
<flux>
mfp, you have some actual use for the library, not just for fun?
<flux>
(that's what I picked from your posting anyway)
<mfp>
I'm just beginning to use it, yes
<mfp>
so I might add stuff as I need it
<flux>
support for cursors (while iterating large collections) and folding was also missing. but you surely accept patches ;-).
<mfp>
folding = easy, cursors = doable (that's what I had in mind when I did materialization as streams)
<mfp>
and yes, it's a public git repository for a reason ;)
dibblego has quit [Read error: 110 (Connection timed out)]
dobblego has joined #ocaml
thelema has quit ["back in a bit"]
thelema has joined #ocaml
<Yoric[DT]>
mmhhh....
<Yoric[DT]>
I'm wondering whether find_exn should have type 'a option after all.
petchema has quit [Read error: 113 (No route to host)]
petchema has joined #ocaml
postalchris has quit [Read error: 113 (No route to host)]
Snark has quit [Read error: 113 (No route to host)]
<thelema>
Yoric[DT]: what reason would find_exn need to return None?
<Yoric[DT]>
The convention could be
<Yoric[DT]>
find_exn p l returns an 'a option
<Yoric[DT]>
but raises an exception if p raises an exception.
middayc has joined #ocaml
<thelema>
if p raises an exception, it seems most logical to allow that to percolate to the user no matter find or find_exn
<Yoric[DT]>
That's something which needs to be debated.
<Yoric[DT]>
I'm not 100% sure.
<thelema>
me neither
<flux>
if it simply maps every exception to None, it could lose exceptions that weren't really meant to be lost
<thelema>
flux: correct, the implementation won't be quite as trivial as it seems
<Yoric[DT]>
I've just fixed that.
<flux>
yoric[dt], hm, does your suggestion mean there would be a function that would not rethrow an exception?
<flux>
plain find?
<Yoric[DT]>
Now, the question becomes: is it more important to be 100% sure that find will never throw an exception or to allow the user to decide when find throws an exception ?
<Yoric[DT]>
In other words, find_exn can already throw exceptions.
<thelema>
maybe we should judge implementations and decide which pieces of code i come down on the side of user control.
<flux>
I think with find the issue is that which one is more convenient
<flux>
for me it's not about "guarantees"
<Yoric[DT]>
Fair enough.
<flux>
it's sometimes convenient to write find (do_stuff (find a foolist)) barlist
<flux>
and if something doesn't get found, well, then I might handle it
<thelema>
trying to guarantee something will usually fail in some wierd corner case no matter how hard you try.
<flux>
but at times I'm especially interested if the element is not found
<Yoric[DT]>
But we can do that with find_exn.
<flux>
didn't you just say find_exn would return 'a option?
<Yoric[DT]>
Do we want to also do that with regular find ?
<Yoric[DT]>
I'm wondering.
<Yoric[DT]>
Ok, I take your point.
<Yoric[DT]>
(I actually had started rambling on something else in some private corner of my mind)
<Yoric[DT]>
Well, let's leave it to that for the moment.
<flux>
hmh, it's difficult to find the reverse dependencies in godi, or atleast in godi_console..
love-pingoo has quit ["Connection reset by pear"]
ReachingFarr has joined #ocaml
jderque has quit [Read error: 113 (No route to host)]
bluestorm has quit ["Konversation terminated!"]
ygrek has quit [Remote closed the connection]
bzzbzz has joined #ocaml
bzzbzz has quit [Client Quit]
magnus_ has quit ["Lost terminal"]
marmottine has quit [Read error: 104 (Connection reset by peer)]
<Yoric[DT]>
thelema: I believe I'll apply your wisdom.
jlouis_ has joined #ocaml
<mbishop>
On linux, where does ocaml get it's "random" from?
<ReachingFarr>
Probably /dev/random
<ita>
mbishop: if you want a real random, you should implement your own mersenne twister
<ita>
/dev/urandom (non blocking)
<jonafan>
doesn't look like it
<mbishop>
I have implemented mt in ocaml, actually
<Yoric[DT]>
iirc, it's not /dev/random
<jonafan>
if random.ml is the source, it generates its own seed and manages its own state
<ita>
mbishop: make it public, it is is very useful
* Yoric[DT]
wonders if mbishop is talking about the Unix mt command, something Monte-Carlo related or something entirely different.
<ita>
Yoric[DT]: mersenne twister
<Yoric[DT]>
ok
<ita>
probably
* mbishop
nods
* Yoric[DT]
is reading Wikipedia.
<ita>
Yoric[DT]: look at RANDU too
<thelema>
mbishop: ocaml's prng is a linear feedback shift register. on non-win32 it uses gettimeofday() to self-init
jlouis has quit [Read error: 110 (Connection timed out)]