cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
shawn has quit ["This computer has gone to sleep"]
smimou has quit ["bli"]
mbishop has quit ["Leaving"]
dbueno has quit ["Leaving"]
gim has quit []
malc_ has quit ["leaving"]
Z4rd0Z has quit []
Mr_Awesome has joined #ocaml
<G>
flux-: trying to get the scaml patch to work with .9 miserably failed, but it was worth the try
mbishop has joined #ocaml
slipstream-- has joined #ocaml
slipstream has quit [Read error: 60 (Operation timed out)]
Smerdyakov has quit ["Leaving"]
shawn has joined #ocaml
svenlx has quit [Remote closed the connection]
johnnowak has joined #ocaml
benny has joined #ocaml
benny_ has quit [Read error: 110 (Connection timed out)]
zeroslug has joined #ocaml
Z4rd0Z has joined #ocaml
Mr_Awesome has quit ["...and the Awesome level drops"]
pango has quit [Remote closed the connection]
zeroslug has quit ["ERC Version 5.2 (IRC client for Emacs)"]
_JusSx_ has joined #ocaml
smimou has joined #ocaml
pango has joined #ocaml
_JusSx__ has joined #ocaml
johnnowak has quit []
_JusSx_ has quit [Read error: 113 (No route to host)]
kig has joined #ocaml
bluestorm has joined #ocaml
smimou has quit ["bli"]
Demitar_ has joined #ocaml
smimou has joined #ocaml
Demitar_ has quit ["Burn the land and boil the sea. You can't take the sky from me."]
bsmith has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
swater has joined #ocaml
Smerdyakov has joined #ocaml
ayrnieu has joined #ocaml
pango has quit [Remote closed the connection]
ikaros has quit [Read error: 110 (Connection timed out)]
svenl has quit [Remote closed the connection]
svenl has joined #ocaml
<oracle1>
the structure: let fun f = let rec tmp = function ... tmp
<oracle1>
for defining recursive functions, is this for tail recursion?
<zmdkrbou>
you don't need such thing to get tail recursion
<zmdkrbou>
(can you give an example of the structure you're talking about)
<zmdkrbou>
(+?)
<oracle1>
let flat_map f =
<oracle1>
let rec flat_map_f = function
<oracle1>
| [] -> []
<oracle1>
| x :: l -> f x @ flat_map_f l
<oracle1>
in
<oracle1>
flat_map_f
<oracle1>
a lot of code is defining recursive functions like that, with the inner recursive function call at the end.. which looks like some 'trick' for tail call optimisation? (I dont know, im guessing)
<zmdkrbou>
mmmh, you're example is not tail recursive i think
<zmdkrbou>
-'
<zmdkrbou>
mmh, need to go, sorry :\
<oracle1>
k.
<oracle1>
np
<tsuyoshi>
oracle1: that particular example is not tail recursive
<tsuyoshi>
but that particular pattern I use a lot.. I picked it up from scheme
<tsuyoshi>
in scheme it's a little easier because they have special syntax for it
<tsuyoshi>
(let loop ((i 0)) (display i) (loop))
<tsuyoshi>
versus in ocaml
<tsuyoshi>
let rec loop i = print_int i; loop i in loop 0
<bluestorm>
oracle1: but you're right, it's useful when doing tail-recursion
<bluestorm>
because you often have to add an parameter
<bluestorm>
for example
<bluestorm>
let rec length = function [] -> 0 | _::tl -> 1 + length tl
<bluestorm>
vs
<bluestorm>
let rec length n = function [] -> n | _::tl -> length (n + 1) tl
<bluestorm>
the latter is tail-rec, but there is a parameter that isn't necessary
<bluestorm>
so you'll often do
<bluestorm>
let length = let rec len n = function [] -> n | _::tl -> len (n + 1) tl in len 0
<bluestorm>
this way, you hide the parameter, and it's easier to use
<bluestorm>
(calling "len 2 ..." in another part of the code would be meaningless)
swater has quit ["Quat"]
swater has joined #ocaml
bsmith has joined #ocaml
pango has joined #ocaml
shawn has quit [SendQ exceeded]
flux has joined #ocaml
flux- has quit [Read error: 104 (Connection reset by peer)]
swater has quit ["Quat"]
Mr_Awesome has joined #ocaml
swater has joined #ocaml
swater has quit ["Quat"]
smimou has quit [Read error: 110 (Connection timed out)]
smimou has joined #ocaml
malc_ has joined #ocaml
<mrvn>
oracle1: Your example does the opposite. It hides a parameter.
<mrvn>
I assume that is so that you don't have to pass the "f" down through the recursive calls and save 4/8 bytes stack on each recursion.
<malc_>
ocaml passes stuff on stack? wow since when?
<Smerdyakov>
malc_, you know, there are more polite ways to say that.
<mbishop>
haha, a lesson in politeness from Smerdyakov
<mrvn>
Tail recursive would be: let flat_map f l =
<mrvn>
let rec flat_map_f acc = function
<mrvn>
| [] -> acc
<mrvn>
| x :: l -> flat_map_f ((f x)::acc) l
<mrvn>
in
<mrvn>
List.rev (flat_map_f [] l)
<mrvn>
malc_: since always
mbishop has quit ["Leaving"]
<mrvn>
I wish ocaml would put stack frames on the heap instead. Then one could implement callcc easily.
mbishop has joined #ocaml
<malc_>
i would suggest you to actually read the sources to see how it does not _always_ uses the stack
<malc_>
and how heap wouldn't give you anything
<Smerdyakov>
mrvn, the performance cost that adds for non-callcc code makes it a clear bad idea to me.
<mrvn>
malc_: a callcc would have to store the register set and the current "stack" frame. If the stack frames are on the heap and GC managed you can do that easily.
<mrvn>
Smerdyakov: true. would be a lot slower
<Smerdyakov>
mrvn, now the way MLton does it, storing a C-style stack on the heap, is fine. However, making stack frames linked lists doesn't work so well for performance.
<Smerdyakov>
Er, making strack frames linked list _nodes_
<mrvn>
Having a C stack on the heap brings you nothing though. Just lets you define your own stack size.
<malc_>
that would work nicely on ia64 i bet
<Smerdyakov>
Not true.
<Smerdyakov>
Most operating environments impose ridiculous size limits on "stack segments."
<malc_>
saving 256 registers would be trully magnificent
<mrvn>
malc_: and now imagine it does that on every context switch.
<Smerdyakov>
No stack overflows in MLton unless you are really out of memory!
<malc_>
problem is it doesn't do that on every context switch
<mrvn>
Smerdyakov: does it realloc the stack to grow it?
Submarine has quit ["Leaving"]
<Smerdyakov>
mrvn, yes.
mbishop has quit ["Leaving"]
<Smerdyakov>
Also works well with threads
<mrvn>
I actually found it quite difficult to set my own stack in C. You have to set a signal stack (only stack you can set in C), generate a signal and then never return.
<malc_>
Well, you are not doing it in C you are doing it via POSIX function. And since you already deviated from the good, you might as well use make/setcontext and friends (and intimate knowlege of arch you are runing on)
<mrvn>
yes, that is what I ment. posix.
<mrvn>
malc_: arch specific code sucks. I don't know enough archs.
<malc_>
just look at the languages that have callcc, they run on such a pathetic subset of archs so even your not enough is plenty given the setting
<mrvn>
malc_: I don't know enough ppc assembler
<malc_>
what's to know? just type four characters it will most likely form a valid opcode, and continue from there.
<mrvn>
rofl
bluestorm has quit ["Konversation terminated!"]
<mrvn>
Are ocaml modules thread save? Say I have a Hashtbl.t and two threads call "add" is that save?
<malc_>
save?
<malc_>
safe perhaps?
<mrvn>
save, safe. Potaito, potaato.
<malc_>
uh.. save is a verb, unless used in a sports context (which it was not)
<mrvn>
so is it safe?
<malc_>
if used as t1: Hashtbl.add t1 k v; t2: Hashtbl.add t2 k v; then yes