<Kakadu>
pippijn: everybody knows that 4.0 is out :D
<wieczyk>
Yeah, big sensation.
<pippijn>
I don't know it until it's in debian
<wieczyk>
Ok, could some help me with typechecker? ;]
<pippijn>
and I was probably in nepal when it got out
lggr has joined #ocaml
<pippijn>
binary search on 4 elements is faster than iterating through them
<pippijn>
and faster than a hash table lookup, too
<pippijn>
(the elements are strings)
<pippijn>
I'm still generally unhappy about my algorithm
lggr has quit [Ping timeout: 244 seconds]
tufisi has quit [Ping timeout: 245 seconds]
cixaxa has joined #ocaml
lggr has joined #ocaml
<adrien>
pippijn: some time ago, I did an unscientific benchmark that showed that a binary tree that you'd balance manually and which was built in a random order was faster than association lists for 4 elements or more
lggr has quit [Ping timeout: 252 seconds]
lggr has joined #ocaml
lggr has quit [Ping timeout: 246 seconds]
Kakadu has quit [Quit: Konversation terminated!]
lggr has joined #ocaml
lggr has quit [Ping timeout: 245 seconds]
lggr has joined #ocaml
osa1 has joined #ocaml
lggr has quit [Ping timeout: 252 seconds]
wmeyer`` has joined #ocaml
lggr has joined #ocaml
wmeyer` has quit [Ping timeout: 244 seconds]
<pippijn>
ocaml optimisation makes no sense
<pippijn>
let foo = { bar = bloh } in ...
<pippijn>
in some cases is faster and in some cases is slower than
<pippijn>
let foo = { bar = Obj.magic [] } in foo.bar <- bloh ...
<pippijn>
just marginally, though
lggr has quit [Ping timeout: 260 seconds]
<adrien>
it's not ocaml optimisations which make no sense :-)
<pippijn>
maybe it's the architecture
<pippijn>
interesting
<pippijn>
Obj.magic is not for free
<pippijn>
creating a new empty object instead of setting it to 0 takes less time
lggr has joined #ocaml
<pippijn>
wtf
<pippijn>
"let rec" gave me faster code than "let"
<pippijn>
but not always
<pippijn>
usually it's slower
lggr has quit [Ping timeout: 260 seconds]
wmeyer``` has joined #ocaml
emmanuelux has quit [Ping timeout: 246 seconds]
<thizanne>
si
lggr has joined #ocaml
<thizanne>
sorry
wmeyer`` has quit [Ping timeout: 244 seconds]
wmeyer has quit [Ping timeout: 264 seconds]
Snark has quit [Ping timeout: 246 seconds]
Snark has joined #ocaml
<pippijn>
if cond then fn a b c d e else fn a b c d f
<pippijn>
is faster than
<pippijn>
fn a b c d (if cond then e else f)
lggr has quit [Ping timeout: 245 seconds]
sepp2k has quit [Read error: Connection reset by peer]
<pippijn>
making a local variable of the last argument is in between the two
sepp2k has joined #ocaml
lggr has joined #ocaml
<pippijn>
wow
avsm has joined #ocaml
<pippijn>
List.iter (fun e -> fn a b c d e) list
<pippijn>
is *much* faster than
<pippijn>
List.iter (fn a b c d) list
<pippijn>
I thought that would generate the same code
<pippijn>
I think I need to write an ocaml optimiser..
<pippijn>
because there is a lot of (prettier) code that can easily be transformed into more efficient code
pango has quit [Ping timeout: 245 seconds]
<pippijn>
and by "much" I mean 4%
lggr has quit [Ping timeout: 240 seconds]
xarch has joined #ocaml
lggr has joined #ocaml
lggr has quit [Ping timeout: 252 seconds]
Yoric has quit [Ping timeout: 255 seconds]
pango has joined #ocaml
lggr has joined #ocaml
wmeyer has joined #ocaml
chambart has joined #ocaml
<wmeyer>
wtf, google.com domain can't be pinged on any of the computers at home
<wmeyer>
gmail stopped working
<wmeyer>
\o\ /o/
<wmeyer>
strangely fb and skype works ^^
xarch has left #ocaml []
<pippijn>
I de-inlined some big stuff and now it's much slower again
<pippijn>
but I like it better
<djcoin>
pippijn: I do not program much in OCaml, but this kind of "unoptimization" always astonish me. I guess OCaml would be really faster if some optimization on the compiler were made
<wmeyer>
djcoin: I keep saying that but I will say what Xavier L says: "Who will write a good inliner for OCaml will be welcome like the Mesiah"
lggr has quit [Ping timeout: 246 seconds]
<wmeyer>
In other words nobody had time or took the chalenge
<djcoin>
Yeah, I'm far from having the skill. But I think, as OCaml may be chosen for its predictibility, its speed etc. Pushing performance would really be a killer, each step making it closer than C++ performance. Gaining interest/market
<djcoin>
s/than/to
chambart has quit [Ping timeout: 260 seconds]
<wmeyer>
but if you want to write a functional code then it's so needed
lggr has joined #ocaml
<djcoin>
wmeyer: how had this not happen yet ? (if my sentence is proper english)
<pippijn>
I'm also very unhappy that while !foo do ... done is faster than let rec loop foo = ... loop newfoo
<pippijn>
in my opinion, that should generate exactly the same code
<pippijn>
it's non-trivial to transform such code (correctly)
ftrvxmtrx has quit [Read error: Connection reset by peer]
<wmeyer>
<oCamlGuy> Kakadu: its not supposed to be just a binary tree [21:40]
<Kakadu>
do you see what I'm seeing?
<wmeyer>
<oCamlGuy> wmeyer: what do you mean
<wmeyer>
<Kakadu> wmeyer: I'm confused about ( 'a * 'a ) tree
<wmeyer>
*** lggr (~lggr@84-73-159-126.dclient.hispeed.ch) has joined channel #ocaml
<wmeyer>
<wmeyer> that would be easier: type 'a tree = Leaf of 'a | Bra of 'a tree * 'a
<wmeyer>
tree
<wmeyer>
<oCamlGuy> that makes two of us
<wmeyer>
<oCamlGuy> so are the tuples in this tree? [21:41]
<oCamlGuy>
yes
<wmeyer>
<wmeyer> i am sure it's try ocaml
<wmeyer>
<oCamlGuy> huh?
<oCamlGuy>
wtf
<wmeyer>
<wmeyer> yes, but with your example the construction is slightly different
<wmeyer>
<Kakadu> oCamlGuy: where do u read that?
<wmeyer>
<oCamlGuy> ('a * 'a) [21:42]
<wmeyer>
<oCamlGuy> wmeyer: are you saying your type is equivalent? [21:43]
<wmeyer>
ERC> so in one case it's Branch (Leaf (1, 1)) or Branch(Branch (Leaf ((1,1), (1,1))));;
wmeyer has left #ocaml []
<Kakadu>
oCamlGuy: it's either IRC bug or wmeyer's ?
wmeyer has joined #ocaml
lggr has quit [Ping timeout: 245 seconds]
<wmeyer>
hm
<wmeyer>
so what's that surprising?
<wmeyer>
it's different data structure
<wmeyer>
but formally represenint the same thing
<oCamlGuy>
wmeyer: are you familiar with haskell?
chambart has joined #ocaml
<wmeyer>
oCamlGuy: not really, but I did some Haskell in past
err404 has joined #ocaml
<oCamlGuy>
I was thinking if someone converted it to haskell i might understand it better
<wmeyer>
so yes haskell has higher rank polymorphism aka. polymorphic recursion
<wmeyer>
in Haskell you have more intuitive notation
<wmeyer>
it would be
<wmeyer>
data Tree a = Leaf a | Branch (Tree a) (Tree a)
<wmeyer>
for the second case
<wmeyer>
and for the first
<wmeyer>
data Tree a = Leaf a | Branch (Tree (a a))
<wmeyer>
data Tree a = Leaf a | Branch (Tree (a,a))
lggr has joined #ocaml
<wmeyer>
(but actually I am not sure if the polymorphic recursive example is OK)
<wmeyer>
but then yes, you have tuples instead of regural constructor in Haskell but i suppose there is no other way to represent the tree
<oCamlGuy>
so is the structure supposed to be a complete tree of complete trees?
<oCamlGuy>
I'm still confused
<wmeyer>
it's a binary tree, tree is recursive data structure
<wmeyer>
each tree has left subtree and right subtree
<wmeyer>
where subtree can be a tree of leaf
<wmeyer>
in polymorphic recursive example, each branch generate a new type
<wmeyer>
which recursively expand each time to tuple
<wmeyer>
then you have leaf, where the type variable is of type as much expanded as branch has done
<wmeyer>
so for single Leaf it will be just 'a
lggr has quit [Ping timeout: 256 seconds]
<wmeyer>
for single Branch and then Leaf you will get the tuple
<wmeyer>
for double nested Branches and leaf you will get double tuple of two elements
<wmeyer>
(pair of pair)
<wmeyer>
in non polymorphic variant, each Branch constructs just the same type
<wmeyer>
where 'a is unified with the type wrapped in the tree
lggr has joined #ocaml
<wmeyer>
but you will need each time a tuple of sub trees
<wmeyer>
hope it makes sense :-)
Xizor has quit [Quit: So yes it's mIRC under wine under debian double peche capital. ;) I'll soon see in kfreeBSD.]
Snark has quit [Quit: Quitte]
lggr has quit [Ping timeout: 248 seconds]
err404 has quit [Remote host closed the connection]
lggr has joined #ocaml
lggr has quit [Ping timeout: 246 seconds]
lggr has joined #ocaml
lggr has quit [Ping timeout: 252 seconds]
chambart has quit [Ping timeout: 260 seconds]
lggr has joined #ocaml
oCamlGuy has quit [Quit: oCamlGuy]
lggr has quit [Ping timeout: 260 seconds]
lggr has joined #ocaml
panard has joined #ocaml
<panard>
Hi
<thelema>
hi
<panard>
I'm experiencing an odd behaviour with Set equality
lggr has quit [Ping timeout: 246 seconds]
<thelema>
Are you using the polymorphic (=) to compare sets?
<panard>
is structural equality (=) supposed to give the same result as Set.equal ?
<thelema>
no, it is not.
<panard>
oh ok
<thelema>
(=) will give false negatives
<panard>
exactly
<panard>
what is the reason?
lggr has joined #ocaml
<thelema>
(=) doesn't know the meaning of the values it's comparing, so it can't tell that two trees balanced in different ways represent the same thing.
<panard>
oh! I see!
<panard>
ok. So actually, I'm using set of sets
<panard>
and calling Set.equal also give false negatives
<thelema>
are you using Pervasives.compare to compare sets?
<panard>
(i.e. I have module A = Set.Make (...) and B = Set.Make(... type t = A.t , etc.), and calling B.equal gives false negative
<thelema>
what's your compare function on B?
<panard>
for B.compare, I use something like : compare e1 e2 = if A.equal e1 e2 then 0 else compare e1 e2
<thelema>
B = Set.Make (struct type t = A.t let compare = A.compare end)
<thelema>
you should just use the A.compare function to instantiate B
<thelema>
or more easily: module A = Set.Make(...) module B = Set.Make(A)
<thelema>
what you're doing is using Pervasives.compare in your 'else'. This function has the same problems as (=)
lggr has quit [Ping timeout: 245 seconds]
<panard>
ok, it seems to work!
<thelema>
great
<panard>
Yes, but as I'm using equal before, it should not return false negative ?
<panard>
thanks a lot for these tips
<thelema>
it can have false negative because compare won't be stable around different representations of the same set
<thelema>
so it my report X < X' where both are the same set
<thelema>
*may
<panard>
even if I'm checking that A.equal X X' is false ?
<thelema>
yes, it may report that X < Y but Y' < X