<mfp>
peper: tuples are much less efficient than records or arrays in this case, since the floats are boxed (and you don't have destructive updates)
<peper>
hmm
<olegfink>
mfp: I thought tuples are exactly polymorphic arrays
<mfp>
olegfink: they don't benefit from the special-casing performed by the compiler for records & arrays to unbox floats
<olegfink>
ah
<olegfink>
I was pretty sure only the type system knows the difference
loran has joined #ocaml
chickenzilla has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
<Alpounet>
mfp, olegfink, do you know anywhere I could find OCaml's formal grammar ?
<mfp>
Alpounet: not sure there's any. You basically have the reference manual & the sources.
Camarade_Tux has quit ["Leaving"]
<Alpounet>
yep, that would have been a great shortcut, though.
jlouis has joined #ocaml
<hcarty>
thelema: ping
chickenzilla has quit ["J'y trouve un goût d'pomme."]
jlouis has quit ["Lost terminal"]
slash_ has quit ["leaving"]
jlouis has joined #ocaml
<Alpounet>
good night all
Alpounet has left #ocaml []
<peper>
how expensive are objects in ocaml?
<peper>
would making the vector a class instead of a record be expensive?
AxleLonghorn has joined #ocaml
<hcarty>
peper: A class would be more computationally expensive than a record or array
loran has quit ["When two people dream the same dream, it ceases to be an illusion. KVIrc 3.4.2 Shiny(svn-2995) http://www.kvirc.net"]
l_a_m has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml
Associat0r has joined #ocaml
Associat0r has quit [Read error: 104 (Connection reset by peer)]
elgi has joined #ocaml
olegfink has quit [Read error: 104 (Connection reset by peer)]
<peper>
how do i use * in a normal function form? i.e. for + i can do (+) 2 3;;
<peper>
but (*) starts a comment...
vuln has joined #ocaml
AxleLonghorn has quit [Read error: 145 (Connection timed out)]
jeddhaberstro has quit []
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
shortc|desk has quit ["Probably rebooting."]
shortc|desk has joined #ocaml
alexyk has quit []
vuln has quit ["leaving"]
ched_ has joined #ocaml
ched__ has quit [Read error: 110 (Connection timed out)]
Nynix has joined #ocaml
m3ga has joined #ocaml
<hcarty>
peper: ( * )
<hcarty>
For that reason, it is generally considered proper to write all operators that way ... ( + ), ( - ), etc
alexyk has joined #ocaml
alexyk has quit [Client Quit]
Nynix has left #ocaml []
m3ga has quit ["disappearing into the sunset"]
alexyk has joined #ocaml
alexyk has quit [Client Quit]
l_a_m has joined #ocaml
jamii_ has quit [Read error: 54 (Connection reset by peer)]
jamii has joined #ocaml
Alpounet has joined #ocaml
Camarade_Tux has joined #ocaml
elgi is now known as olegfink
_zack has joined #ocaml
ttamttam has joined #ocaml
ramenboy has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
rwmjones_ has joined #ocaml
s4tan has joined #ocaml
roderyk has joined #ocaml
<roderyk>
is the evaluation of tuples right-to-left in ocaml? Just playing around I have this:
<roderyk>
let timer = function _ -> let (a,b) = (Unix.gettimeofday(), Unix.gettimeofday()) in a > b (* why is this true? *)
hkBst has joined #ocaml
m3ga has joined #ocaml
Camarade_Tux has quit ["Leaving"]
<flux>
I would not rely on the evaluation order of tuples
<flux>
but, indeed, it does do that, as it is for function arguments
filp has joined #ocaml
s4tan has quit []
<mrvn>
flux: but on function arguments you can rely on I think.
<flux>
well, I wouldn't :)
<flux>
even if the reason was that later I might want to port/transliterate the code to another language :)
<mrvn>
Would be verry confusing if the order chnaged between 'f a b' and let g = f a in ...; g b
<mrvn>
or in let f = function x -> Printf.printf "x = %d" x; function y -> ...
<flux>
well, it does
<flux>
let a = ref 0
<flux>
f (a := !a + 1) (a := !a * 2) -> a = 1
<flux>
(well, !a = 1)
<flux>
but: let g = f (a := !a + 1);; f (a := !a * 2);; -> a = 2
OChameau has joined #ocaml
<flux>
hm, actually I messed that up
<flux>
but it doesn't matter
<mrvn>
wow. confusing.
<flux>
so I hope you haven't relied on that order :)
<mrvn>
Nope. I don't use constructs like that that have no clear sequenze points.
<mrvn>
Too much like a++ = a++;
<flux>
indeed, best to avoid them
<kaustuv_>
Without trying it out, can you say what order the two print statements in the following will be?
<kaustuv_>
type t = { f : unit ; g : unit } ;;
<kaustuv_>
let x = { g = printf "Hello, world\n" ; f = printf "Goodbye, world\n" } ;;
<flux>
kaustuv_, I can, but I wouldn't write that kind of code
<flux>
that is, if it matters in which order it outputs the text
<flux>
atleast I would say it first says Goodbye then Hello, but hey, I could be wrong :)
<flux>
not that I completely avoid side effects in such constructs, but only such constructs for which the order of execution matters
<kaustuv_>
You would be wrong if you thought goodbye would be printed first.
<roderyk>
ok, it was sort of a rush in the dark - would I need to use nested let..ins to show such ordering?
kaustuv_ is now known as kaustuv
<roderyk>
basically I just wanted a quick timer hack function, since I couldn't find one easily with googling: a <- getTime(); fn (); b <- getTime(); b - a
<flux>
well, that works?
<flux>
because it has ;'s in it
<flux>
they put the order in
tvn has joined #ocaml
<tvn>
hi
<flux>
hm, actually that might be confusing, because the ; in that case are different than the ; in records :)
<roderyk>
errr.. that was my "psuedocode" :) that doesn't seem legal: would I need: let a = ... in let r = fn ... in let b = .... in b - a?
rwmjones_ has quit ["Closed connection"]
<kaustuv>
You can always do:
<kaustuv>
let a = getTime () in let _ = fn () in let b = getTime () in b - a
<kaustuv>
hmm, too late
<roderyk>
this actually brings up 2 questions I had that are not easy to google: is there a syntactic sugar for recursive lets: ie. "let a = ...; r = ...; b = ...; in ..."
<roderyk>
and I recall once seeing some syntax like: let r = .... where/which (?) x = ... \n y = ... etc.
<flux>
roderyk, well there is the where-extension, but I wouldn't either of them recursive
<roderyk>
flux: ah, ok. so the where was an extension; ok, just trying to settle into the language here. Coming from haskell so I'm having some syntax conflicts ;-)
jedai has quit [Read error: 110 (Connection timed out)]
<flux>
or perhaps something like: let timing f = let t0 = Unix.gettimeofday () in f (); let t1 = Unix.gettimeofday () in t1 -. t0
<roderyk>
ah, ok :) flux's version makes more sense to me. Will take me a bit to grok munga's stateful version ;-)
<kaustuv>
let time f = let (a, _, b) = (Sys.time (), f (), Sys.time ()) in a -. b
<mrvn>
I would use tstart and tend or tbefore and tafter
<flux>
mrvn, just because? I mean, it's not like t0 and t1 don't have established meanings also :)
tvn has quit ["Leaving"]
<mrvn>
Just because I find it clearer.
s4tan has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
chickenzilla has joined #ocaml
<peper>
fwiw you can do that with just one variable :)
<flux>
the t1 was named for clarity ;)
<peper>
t = -Unix.gettimeofday () ... t = t + Unix.gettimeofday ()
ttamttam has left #ocaml []
chickenzilla has quit ["J'y trouve un goût d'pomme."]
Associat0r has joined #ocaml
Associat0r has quit []
<mrvn>
let start = Unix.gettimeofday () in f (); Unix.gettimeofday () -. start
det_ is now known as det
ppsmimou has joined #ocaml
oriba has joined #ocaml
oriba has left #ocaml []
filp has quit ["Bye"]
Alpounet has quit ["Ex-Chat"]
bering has joined #ocaml
<kaustuv>
let time f = ~-. ((f () ; Unix.gettimeofday ()) -. Unix.gettimeofday ())
<kaustuv>
(0 lets)
bering has quit ["Leaving"]
<kaustuv>
oops, the ~-. is unnecessary
<mrvn>
kaustuv: do the specs define an evaluation order for infix perators?
<mrvn>
It could evaluate (f () ; Unix.gettimeofday ()) first giving you basically 0 every time.
seafood has quit []
filp has joined #ocaml
mehdid has quit ["leaving"]
mehdid has joined #ocaml
<flux>
I think the issue here is that there is no specification other than the compiler source?-)
<kaustuv>
mrvn: the parser turns infix operators into ordinary function calls
<kaustuv>
By the way, I consider the right-to-left evaluation order for OCaml to be a defect and have said as much to the Gallium folk. The consensus was that yes, this should be rectified if OCaml were ever to have a backwards-incompatible release.
<mrvn>
so better not rely on it.
<kaustuv>
Well, there is a good chance that OCaml will never progress beyond version 3.x, given new French research rules that make it really hard to work on OCaml as such.
<kaustuv>
But I may be too pessimistic
<mrvn>
one could fork it
<kaustuv>
Or industrial users of OCaml could fund or participate in further development of OCaml. INRIA is generally quite happy to collaborate with industry. I think this is a general [let rec chicken = egg and egg = chicken] problem.
alexyk has joined #ocaml
schme has joined #ocaml
alexyk has quit [Client Quit]
thelema_ has quit [Remote closed the connection]
alexyk has joined #ocaml
schme has quit ["leaving"]
kmkaplan has quit [Read error: 60 (Operation timed out)]
<mrvn>
My B-Tree doesn't like it when I try to insert a (key, value) where key is lower than any existing key.
<mrvn>
Do I break my legs trying to get this supported or do I just add a dummy key that is lower than all keys to the empty tree?
Associat0r has joined #ocaml
Associat0r has quit [Read error: 104 (Connection reset by peer)]
<flux>
I've never written a B-tree :(. also, iirc, I had trouble deleting items from a rb-tree at a time :)
<mrvn>
B-Tree as in disk based tree. not binary.
<flux>
yes, I know what B-tree is
<mrvn>
Block tree
<flux>
well, atleast superficislly :-)
<mrvn>
Problem is that the inner nodes have the lowest key of each child and a reference to the child stored in an AVL tree. I have a find_le (less or equal) to find the best fit, the one that is least smaller. But if the new key is smaller than an existing one that raises Not_found.
<mrvn>
Also when I insert the key leftmost I would have to correct all the "lowest key" on the way back up.
<mrvn>
Inserting a dummy key though would be real simple.
<mrvn>
hmm, I don't even have to add the dummy key. I just have to pretend I have it when I split the root node. Hah. this will work.
<mfp>
mrvn: you can also do without the constraint here
<mfp>
it's just there to document that you want an object type as the 'a
<mrvn>
What I want is extend a variant type to one with the same number of variants but with each variant having some extra data attached at the end.
<mfp>
you can just allow extra data with type 'a currency = Euro of float * 'a | Dollar of float * 'a | ...
<mfp>
then money = unit currency, and coins = (int * int) list currency
<mrvn>
But then I still can't call print_money with the extended type.
<mrvn>
In classes I would have "inherit money"
<mfp>
why not? print_money would be 'a currency -> unit
<mfp>
for all 'a
ttamttam has joined #ocaml
<mrvn>
mfp: look at the 2nd paste
<mrvn>
The money type can not be int * 'a. I need it as just int in other places.
<mfp>
where? you can pattern match over (x, _) wherever you had x
<mrvn>
different modules. the money type does not know what the smallmoney type might add. Could be Euro of int * string | Dollar of int * int * int | yen of int * string * int list
<mfp>
a different one for each?
<mrvn>
yep.
<mrvn>
een the number of args can differ.
vovkaii has joined #ocaml
<mrvn>
even
<mfp>
then type ('eur, 'dol, 'yen) money = Euro of int * 'eur | ... ?
<kaustuv>
As long as you are Obj.magic'ing a record to a prefix of that record, you should be OK-ish.
<mfp>
better avoid Obj.magic if possible --- and it doesn't look impossible here
<mrvn>
mfp: as said, can't do that. I need it without the extra attachment in other places.
<mrvn>
wastes tons of memory and breaks comparison which I need.
<mfp>
ok, enjoy your segfaults :)
<mrvn>
So there is no way to make ocaml see that one type is a prefix of another? Maybe with type foo = { ... }?
<mfp>
(tons of memory = 2 words per value)
<kaustuv>
mrvn: no, there is no way to make ocaml see that because "prefix" is not defined in the OCaml language specification
<mrvn>
mfp: for the simple example. I actualy have a 32 byte key structure and 8-65536 byte 'a
<mfp>
the size of 'a doesn't matter here
<mrvn>
hmm, right, just a value, one word.
<mfp>
those 2 words are the overhead for the ref to the value + the header
ttamttam has left #ocaml []
<mrvn>
but I would still need a value at all times. I have to construct values of the smaller type at various places that have no idea what value to use for 'a.
<mfp>
and those values must be used by code that requires a specific 'a?
<mfp>
if not, you can use unit
<mrvn>
mfp: it has to match the 'a that is actually used. same type.
<mfp>
across modules, or can you let the compiler infer it?
<mrvn>
e.g. lookup a key in a tree and return the (key, 'a) pair.
<mrvn>
peper: just count the number of iterations? Or does it have to do a fixed number of iteratiosn per second?
<kaustuv>
peper: let run_with_timer f = (f () ; Unix.gettimeofday ()) -. (Unix.gettimeofday ()) ;;
<Alpounet>
mrvn, my professor told ùe about that problem... My implementation could be useful for such ... use, yep.
<Alpounet>
s/ùe/me
<mrvn>
kaustuv: wrong paste
<peper>
mrvn: hmm, im not really sure. I can do the simulation with arbitrary precision, but also want to display the live results
<mrvn>
kaustuv: What is wrong with ocamls regexp module?
<mrvn>
peper: so do on iteration, plot, repeat.
<mrvn>
peper: or do you only want to plot every so often? Then check Unix.gettimeofday ()
<kaustuv>
mrvn: Str is not that great and pcre doesn't do fuzzy matching (I believe)
<peper>
well i just don't want it to be too fast or too slow depending on the cpu power
<peper>
i can probably just let the user change the "speed"
<Camarade_Tux>
I'm sure it is possible to get a nice, fast, regexp working on a patricia-like tree :)
<Camarade_Tux>
it would support fuzzy-matching nearly out-of-the-box
<mrvn>
Alpounet: #(n) has not yet been computed for any instance of n > 4, though lower bounds of 4098 and 101439 have been determined for n = 5 and n = 6 respectively.
<mrvn>
Alpounet: go write your turing simulator and find a busy beaver for 5 or 6.
<Alpounet>
I doubt my computer is more powerful than researchers'
<Alpounet>
but nice try for convincing me ! :-)
<mrvn>
Alpounet: n=5 doesn't sound too impossible.
<Alpounet>
Researchers are probably working on it, with computers with much more power I think... Don't you ?
<mrvn>
"but there remain about 40 machines with nonregular behavior which are believed to never halt, but which have not yet been proven to run infinitely."
<mrvn>
So just run them each for a while and see if one halts. That will be an achievement already.
kaustuv is now known as kaustuv_
<Alpounet>
My objective would be to do such stuffs, for learning purpose though. BTW, do you think my approach for the transition function is good ?
<Alpounet>
your approach would make it ... 'boring' to define transitions, IMO.
alexyk has joined #ocaml
<peper>
how can i access object values?
<mrvn>
alternatively you could just have a function
<peper>
or can i only access methods?
<mrvn>
peper: method get = x
oriba has joined #ocaml
slash_ has joined #ocaml
<mrvn>
Which reminds me that I want a 'const' keyword for methods and arguments.
<peper>
hmm
<peper>
No implementations provided for the following modules:
<peper>
what does it mean?
<peper>
i can load them successfuly now
<peper>
err. open
<mrvn>
Someone extend the type systen and write a "const : 'a -> const 'a" for me please.
ofaurax has joined #ocaml
jeanbon has quit ["J'y trouve un goût d'pomme."]
<mrvn>
mv /me bed
<Alpounet>
mrvn, good night
<Alpounet>
launch a busy beaver program before, heh.
<Alpounet>
Pff... If only the OCaml community was larger.
<bjorkintosh>
Alpounet, why need it be larger?
<Alpounet>
to have more projects around it
<Alpounet>
to get more dynamism
<Alpounet>
etc
slash_ has quit ["leaving"]
<bjorkintosh>
pfft. you want to make it the next VB?
<bjorkintosh>
you'd be nauseated in no time.
* Camarade_Tux
had 130 unread threads from the ocaml lists until yesterday, and "only" 80 now
<Alpounet>
Camarade_Tux, cheers :-p
vovkaii has left #ocaml []
<Alpounet>
bjorkintosh, no, there must be moundaries, but additional libraries and more dynamism wouldn't be bad.
slash_ has joined #ocaml
thelema has quit [Read error: 110 (Connection timed out)]
jeanbon has joined #ocaml
MageSlayer has joined #ocaml
<MageSlayer>
Hi guys. Can I ask a question? On Ocaml of course :)
<MageSlayer>
Ok. I am interested in OCaml and see it has toplevel. But use APL at work with something like toplevel also integrated. But seems like APL toplevel behaves differently. I can "run" almost any function under it's toplevel. It is so for OCaml?
prime2_ has joined #ocaml
<Camarade_Tux>
MageSlayer, you can run any function under the toplevel, there's no restriction on what you can do in it
<MageSlayer>
Ok. Thanks for answer. I try to use toplevel with MLDonkey, but seems like all that I have - only syntax errors :)
<Camarade_Tux>
he, mldonkey doesn't have a toplevel
<Camarade_Tux>
or are you trying to debug mldonkey under the toplevel ?
<MageSlayer>
Well, yes. And MLDonkey seem to have mldonkeytop makefile target and it builds.
Alpounet has quit ["Ex-Chat"]
<MageSlayer>
Could you be more specific about OCaml toplevel? I'm using emacs+tuareg-mode
<Camarade_Tux>
mldonkey is a pretty big program, probably too complex to get all of it working under the toplevel at the same time
<Camarade_Tux>
well, the toplevel, is a ... toplevel ;p
kaustuv has joined #ocaml
<Camarade_Tux>
running it under emacs is quite common afaict (/me is using vim :D )
<MageSlayer>
Hm, APL toplelvel is pretty functional on 3+ miliion LoC project :), not all loaded at once of course.
<MageSlayer>
Maybe you can give some peace of advice for MLDonkey?
<Camarade_Tux>
well, the ocaml toplevel can certainly handle that but I don't think mldonkey is written in a way suitable for any toplevel, no matter the language
<MageSlayer>
Hm, what do you mean?
<Camarade_Tux>
as for mldonkey, maybe, I'm myself an mldonkey user (* argh, dadvsi *)
<MageSlayer>
Ok. Tha's interesting :) Do you also exprerience torrent problems? :)
prime2_ has quit ["leaving"]
prime2 has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux>
MageSlayer, I can't be more precise, the thing is just I think running mldonkey in the toplevel is a bit crazy, mldonkey just isn't meant to be run that way (that's my very own opinion)
<Camarade_Tux>
torrent problems, mldonkey support for BT is not perfect, could you be more precise ?
* Camarade_Tux
wonders if we'd better swap to #mldonkey
<MageSlayer>
I agree. You mean go there right now?
<Camarade_Tux>
well, yeah
<MageSlayer>
Ok. Let's go there
seafood has joined #ocaml
ched_ has quit ["Ex-Chat"]
rwmjones_ has joined #ocaml
Ched has joined #ocaml
jlouis has quit ["Lost terminal"]
rwmjones_ has quit ["Closed connection"]
grykgru has joined #ocaml
Yoric[DT] has joined #ocaml
oriba has left #ocaml []
grykgru is now known as grykgru_
grykgru_ is now known as grykgru
grykgru has left #ocaml []
willb has quit [Read error: 110 (Connection timed out)]
jamii has quit [Read error: 110 (Connection timed out)]