<gasche>
reinforces my point about reasonable backend/runtime interaction choices more performance-important than massively clever optimization in most situations
<gasche>
(OCaml has a good calling convention and uses the native stack for better locality; that's enough to trump most functional languages on this benchmark)
<pippijn>
interesting
<pippijn>
and I'm curious what makes C almost 3 times as fast
<adrien>
as far as I'm concerned, except for the pathological cases where ocaml's performance is very bad (whatever they are), I think performance is not where the issues are
<adrien>
ootb perf is definitely good
<adrien>
some parts of the ecosystem are bigger issues
<pippijn>
I think I'm looking at massively clever optimisations here..
<pippijn>
except they don't seem to be so clever, because it ended up generating several KBs of code
ttamttam has quit [Quit: ttamttam]
ulfdoz has joined #ocaml
<bernardofpc>
pippijn: by the way, I guess GCC code would be *even faster* if it only inlined 4 levels of m instead of 8, because (naturally) it puts the stack for the outermost levels, but those are the ones really used
<pippijn>
gasche: Clean is faster than ocaml on that benchmark
<gasche>
pippijn: you mean 4.32 instead of 4.43? looks barely relevant
<pippijn>
barely relevant, but consistent
<pippijn>
my point is actually: Clean is also a fast functional language
<pippijn>
not so much "faster than ocaml", but rather "as fast as ocaml"
<gasche>
for information, I've made tests with the Trunk version of OCaml; on my machine 4.00.1 and 3.12 take around 4.8s, and trunk 4.0s
<pippijn>
ok
<gasche>
that's a relatively wide performance gap and I have no idea where it comes from
<pippijn>
do you have the asm?
<gasche>
that's the trouble with micro-benchmarks
<gasche>
(but yes, it's nice to know that Clean's code generator was reasonbly effective for this micro-benchmark; doesn't tell you much about performance at large of the language, though; it would be more interesting to have information on a GC-stressing test)
<pippijn>
./t 1.38s user 0.00s system 99% cpu 1.385 total
<pippijn>
gcc with profile guided optimisation
<pippijn>
0.4s faster
<gasche>
pippijn: the only ASM change that seems relevant
<pippijn>
20%
<gasche>
(between 4.01 and trunk, x86_64) is after .L100, `addq $2, %rbx` is turned into `addq $2, %rax` after the movq
<pippijn>
haha
<pippijn>
gasche: can you give me the two binaries?
<gasche>
what's your email?
<pippijn>
<- @xinutec.org
Uvs has joined #ocaml
UncleVasya has quit [Ping timeout: 255 seconds]
<gasche>
pippijn: mail sent
<gasche>
note that I'm not claiming that this trunk change will remain in next OCaml releases
gustav__ has quit [Remote host closed the connection]
<gasche>
it may be an ephemeral state that'd turn out to be reverted in trunk or whatever
<gasche>
some random live-range-splitting change made ackerman 20% faster
<gasche>
if I had a good benchmark suite at hand, I could try to check the performance effects on other pieces of code
<gasche>
(eg. are there performance regressions as well?)
Neros has joined #ocaml
<Yoric>
pippijn: hardcoding benchmarks in the (JIT) compiler
<pippijn>
ah, hehe
<Yoric>
Or just slightly more generic optimizations.
eni has quit [Quit: Leaving]
<pippijn>
./test 1.77s user 0.00s system 99% cpu 1.776 total
<pippijn>
ousado: ^ felix compiled statically
<pippijn>
=> same as C
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
Zerker has joined #ocaml
tane has joined #ocaml
sgnb has quit [Remote host closed the connection]
Snark has joined #ocaml
q66 has joined #ocaml
ulfdoz has quit [Ping timeout: 255 seconds]
ollehar has joined #ocaml
RagingDave has joined #ocaml
ttamttam has quit [Quit: ttamttam]
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
Zerker has joined #ocaml
eikke has joined #ocaml
tane has quit [Quit: Verlassend]
Uvs has quit [Read error: Connection reset by peer]
UncleVasya has joined #ocaml
UncleVasya has quit [Client Quit]
sgnb` has joined #ocaml
UncleVasya has joined #ocaml
emmanuelux has joined #ocaml
ollehar has quit [Ping timeout: 264 seconds]
breakds has joined #ocaml
mehdid has quit [Ping timeout: 245 seconds]
sgnb` has quit [Remote host closed the connection]
frogfoodeater has joined #ocaml
tane has joined #ocaml
sgnb has joined #ocaml
ocp has joined #ocaml
eikke has quit [Read error: Operation timed out]
ttamttam has joined #ocaml
smerz_ has joined #ocaml
ocp has quit [Quit: Leaving.]
UncleVasya has quit [Ping timeout: 248 seconds]
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
tane has quit [Ping timeout: 252 seconds]
eikke has joined #ocaml
ggole has joined #ocaml
ollehar has joined #ocaml
ttamttam has left #ocaml []
zpe has joined #ocaml
smerz_ has quit [Read error: Operation timed out]
ttamttam has joined #ocaml
ttamttam has quit [Remote host closed the connection]
tane has joined #ocaml
zpe has quit [Ping timeout: 258 seconds]
RagingDave_ has joined #ocaml
RagingDave has quit [Ping timeout: 258 seconds]
eikke has quit [Read error: Operation timed out]
anderse has joined #ocaml
eikke has joined #ocaml
anderse has quit [Client Quit]
Yoric has quit [Ping timeout: 264 seconds]
bsrkaditya has joined #ocaml
<bsrkaditya>
is there an equivalent to haskell's fmap? specifically for option?
<adrien>
let fmap f = function Some x -> f x | None -> None
<adrien>
answer: not built-in
<bsrkaditya>
adrien: thanks. :-)
<def-lkb>
let fmap f = function Some x -> Some (f x) | None -> None :p
zpe has joined #ocaml
<adrien>
heheh, right
<adrien>
now, come fix my JS
<def-lkb>
:D… Na, don't want to get my hands dirty
bsrkaditya has left #ocaml []
bsrkaditya has joined #ocaml
<bsrkaditya>
Hi,
<bsrkaditya>
is there something like haskell's words?
<bsrkaditya>
(in ocaml)
zpe has quit [Ping timeout: 256 seconds]
<bsrkaditya>
actually forget it, there is scanf I think.
anderse has joined #ocaml
fraggle_ has joined #ocaml
<orbitz>
bsrkaditya: Not instandard library. Battaries or Core might have soemthing for you
<bsrkaditya>
orbitz: thanks!
anderse has quit [Quit: anderse]
frogfoodeater has quit [Ping timeout: 252 seconds]
RagingDave_ has quit [Quit: Ex-Chat]
kaste has joined #ocaml
Zerker has joined #ocaml
ulfdoz has joined #ocaml
mehdid has joined #ocaml
<ggole>
I've never understood why the useful option functions are not in the stdlib
<orbitz>
ggole: At this point I only use the stdlib when I want to be really really lean in an Ocaml project
<kaste>
let's say I have a type statement like type a = Foo of ... and b = Bar of ... and I want to pattern match on the names of the types instead of the Constructors. How do i do that?
<orbitz>
kaste: you don't
<kaste>
what's the idiomatic way?
<orbitz>
kaste: if you pattern match on something it has to be of a particualr type
<ggole>
kaste: polymorphic variants allow something of the kind
<orbitz>
kaste: what problem are you really trying to solve?
<ggole>
Say you have type a = [`Foo of int | `Bar of int], you may write match value with #a -> ...
<ggole>
There is no analogue of this for closed variants.
<kaste>
well a is statements and b are expressions for me (miniinterpreter) and i would dispatch interpret a into two functions specializing on statements and expressions with different signatures
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
<ggole>
Either include both in another parent type, or use polymorphic variants.
<ggole>
Although the usual approach there is to have expressions be a part of statements
<orbitz>
indeed
<kaste>
hmm I am not supposed to change the data structures I believe (I am following 'Modern compiler implementation in ML', which is probably well known) so I have to work this differently
<ggole>
So you would have type stmt = Assign of ... | If of ... | ExprStmt of expr
<ggole>
Just use whatever Appel has in his book then
<ggole>
Which I believe is similar to what I suggested (it's been a while since I read it though)
<kaste>
he did it the way I suggested above, or maybe I misunderstood something. I am new to ocaml (though I know sml and haskell)
<Cypi_>
We don't know your language, but maybe your toplevel function shouldn't be able to interpret expressions, actually, if there are statements AND expressions.
<Cypi_>
(I don't know though, just saying)
Cypi_ is now known as Cypi
<kaste>
Cypi_: he even gives the signature as interpret: stm-> unit
<kaste>
thank you all very much, I'll think about it a little more
<ggole>
I got the book off my shelf: he suggests a tree IR with expressions included in statements
<ggole>
So a tag Exp of expr. No polymorphic cleverness necessary.
<ggole>
And hmm, a weird inline cons kind of thing to have sequences of statements... odd.
Zerker has joined #ocaml
<breakds>
Just a quickquestion. Is there anything special I need to do before I can use the module "Num"?
<breakds>
I got Reference to undefined global `Num'
tane has quit [Quit: Verlassend]
<breakds>
in the toplevel
<breakds>
after "open Num;;" and string_of_num "12"
<ggole>
#load "nums.cma"
<breakds>
works, thank you!
<breakds>
why I don't need to do this for List/Array/Unix etc?
<ggole>
You can automate that if you like: the toplevel takes useful arguments, and there is .ocamlinit
<ggole>
Because those are included by default
<ggole>
Except unix?
<ggole>
(that may have changed recently)
<ggole>
It's just to keep size down afaik
bsrkaditya has left #ocaml []
<breakds>
Oh I remembered having to include unix when compiling it
<breakds>
thank you, ggole!
* ggole
nods
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
<IbnFirnas>
kaste: which exercise are you on? (I'm going through the same book now)
studybot_ has joined #ocaml
studybot_ is now known as talzeus
<kaste>
IbnFirnas: just started, takes a long time because I use it to learn ocaml mainly
<darkf>
kaste: I like that series of books, but you should probably run through learning the language a bit first before trying to implement compilers :p
<kaste>
darkf: I usually share your sentiment but figured since I know sml and haskell pretty well, I might pick it up along the way with a bit of googling and cheat sheets but you are right
<darkf>
kaste: Well, if you are already familiar with SML then I'd say it's okay - if you grasp ADTs and pattern matching (which you surely do), go ahead
walter has quit [Quit: This computer has gone to sleep]
<IbnFirnas>
kaste: so this is for the straight-line program interpreter?
<kaste>
yes
ontologiae has joined #ocaml
breakds has quit [Ping timeout: 258 seconds]
walter has joined #ocaml
breakds has joined #ocaml
SuperNoeMan has left #ocaml []
ulfdoz has quit [Ping timeout: 276 seconds]
<IbnFirnas>
kaste: so I'm trying to understand the use-case for matching on type names, can u explain?
<IbnFirnas>
kaste: because, if you think about it - if you matched a constructor - you already know what the type is, so what use would matching on the name be?
ttamttam has joined #ocaml
Anarchos has joined #ocaml
alxbl has quit [Ping timeout: 246 seconds]
chris2 has quit [Ping timeout: 252 seconds]
ontologiae has quit [Ping timeout: 246 seconds]
<ggole>
It allows something like subtypes
<ggole>
You can have a sum type with a subset of the constructors of another sum type
<ggole>
And then matching on type names reflects the question 'is it in that subset'
<IbnFirnas>
ggole: I think so as well, but I'm attempting to understand kaste's point of view :)
thomasga has joined #ocaml
eni has joined #ocaml
walter has quit [Quit: This computer has gone to sleep]
<IbnFirnas>
kaste: Generally, the key to that exercise is mutually recursive functions. You match a node from the AST and decide what function to route its datum to (which may end-up doing the same, until you get to the leaves).
iZsh has quit [Quit: Coyote finally caught me]
<IbnFirnas>
kaste: I found it helpful to think about how I would handle the leaves first, and then reducing from there.
Zerker has joined #ocaml
walter has joined #ocaml
walter|r has joined #ocaml
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
walter has quit [Ping timeout: 255 seconds]
iZsh has joined #ocaml
Zerker has joined #ocaml
<josch_>
is there a way to have an empty set as the default value for optional labeled arguments?
<Kakadu>
josch_: mmm, what is the problem?
<josch_>
like: foo ?(arg=MySet.empty) bar
<Kakadu>
syntax seems to be OK
<josch_>
the error I get is:
<josch_>
Parse error: [fun_binding] expected (in [fun_binding])
<Kakadu>
need more code
<josch_>
arg.. never mind
<josch_>
one always finds the error after asking about it
<josch_>
I wrote arg:MySet.empty and not arg=MySet.empty
<josch_>
Kakadu: thanks for your help and sorry for the bother :)
<josch_>
it's a bit confusing though that : is used when specifiyng the value of the labeld argument and = when specifying the default..
Zerker has quit [Quit: Colloquy for iPad - Timeout (10 minutes)]
<adrien>
I've been using labelled arguments for years but I regularly do mistakes with : vs. =
asmanur_ has quit [Ping timeout: 252 seconds]
asmanur has joined #ocaml
awm22 has joined #ocaml
<josch_>
good to know I'm not the only one ^^
Tobu has joined #ocaml
eni has quit [Quit: Leaving]
ggole has quit []
groovy2shoes has joined #ocaml
dsheets has joined #ocaml
tane has quit [Quit: Verlassend]
<bernardofpc>
some more ideas on the ackerman thing:
<bernardofpc>
gcc -O1 gives 2 call's
<bernardofpc>
gcc -O2 makes 1 tail call in a jump
<bernardofpc>
and gcc -O2 looks a lot like ocaml's output
<bernardofpc>
(in asm, I mean)
<bernardofpc>
but still that's almost twice as fast
walter|r has quit [Read error: Operation timed out]
chris2_ is now known as chris2
<ousado>
pippijn: ah yes felix
UncleVasya has joined #ocaml
<ousado>
in general, are there any issues with loading shared libraries from ocaml programs compiled to bytecode?
UncleVasya has quit [Quit: UncleVasya]
ontologiae has quit [Ping timeout: 276 seconds]
<ousado>
ok, nevermind, it turns out htis was related to ocaml 3.12 on ARM stuff
breakds has quit [Quit: Konversation terminated!]
<bernardofpc>
ok, final take on C -O2 : it has a codepath that makes the function return ack(1,0) = ack(0,1) = 2 without call, just in the loop
walter|rtn has quit [Read error: Connection reset by peer]
<bernardofpc>
but OCaml only returns on m = 0, which may explain why it takes almost 2 times longer
walter|r has joined #ocaml
Snark has quit [Quit: leaving]
walter|rtn has joined #ocaml
walter|r has quit [Read error: Connection reset by peer]
sysopfb has quit [Read error: Connection reset by peer]
sysopfb has joined #ocaml
Kakadu has quit []
Neros has quit [Ping timeout: 256 seconds]
chambart has joined #ocaml
ontologiae has joined #ocaml
ttamttam has left #ocaml []
Neros has joined #ocaml
Yoric has quit [Ping timeout: 245 seconds]
gautamc has left #ocaml []
dsheets has quit [Ping timeout: 245 seconds]
dsheets has joined #ocaml
redfire has quit [Quit: WeeChat 0.3.8]
Neros has quit [Ping timeout: 264 seconds]
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
alxbl has joined #ocaml
Trollkastel has quit [Quit: Brain.sys has encountered a problem and needs to close. We are sorry for the inconvenience.]
cdidd has quit [Remote host closed the connection]
<ousado>
what's the recommended path to get a native code compiler for ARM?
<ousado>
(for rpi in particular) is building on qemu faster than on the device?
thomasga has quit [Quit: Leaving.]
Trollkastel has joined #ocaml
ollehar has quit [Ping timeout: 240 seconds]
eikke has quit [Ping timeout: 258 seconds]
chambart has quit [Ping timeout: 246 seconds]
jbrown has quit [Ping timeout: 255 seconds]
<wmeyer>
ousado: so again I'll not be testing new stuff on you :-) I trust you want best solution, so the solution that actually worked for me was, to compile directly on ARM.
<ousado>
wmeyer: thanks, I'm asking on behalf of someone trying to get haxe to compile on ARM, for whatever reason.. I'll pass that info on
<ousado>
ah and it just worked for him, it seems
<wmeyer>
of course it works!
<wmeyer>
so if you want to be more really more adventorus and up to speed with a PC compiling your stuff try cross compilation patches: http://caml.inria.fr/mantis/view.php?id=5737
<wmeyer>
(provided by adrien)
<ousado>
ah right, I remember him talking about hat
<ousado>
*that
<adrien>
they won't apply on trunk I think; you either need a slightly older trunk (before a lot of whitespace changes by Doligez) or to update the patches
<adrien>
and I'll be way too busy next week, and on holidays after that :-)
<wmeyer>
of course they will not, but I'll be working trying to port them
<wmeyer>
adrien: I keep an eye, and to say, not only me (wink)
<adrien>
heh :-)
<wmeyer>
adrien: don't have to be complete, and I'll wait
<adrien>
but Doligez has reverted one of the commit; what annoys me is not that he reverted it but that I don't understand
<adrien>
it seems $(CALL ...) is only in gnu make
<wmeyer>
oh, he said that it's not compiling on BSD
<wmeyer>
no worries it seems I got a BSD machine
<adrien>
alright but I didn't invent it: I took it from other places in the ocaml build system
<wmeyer>
by his kindness :-)
<adrien>
heh :-)
<adrien>
so I don't really understand why the other occurences were not an issue