mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<Smerdyakov> This is an English channel. Make #ocaml.fr if necessary. :P
<grirgz> sorry :/
Tetsuo has quit ["Leaving"]
ita has quit [Read error: 110 (Connection timed out)]
pantsd has joined #ocaml
psykon has joined #ocaml
pantsd has quit [Remote closed the connection]
Demitar has quit [Read error: 113 (No route to host)]
seafoodX has joined #ocaml
pantsd has joined #ocaml
seafoodX has quit []
seafoodX has joined #ocaml
psykon has left #ocaml []
mav has joined #ocaml
<fremo> If I have 'type t = { x:...; ... } let f t x = { t with x=x }', t will not be reused ? if f is tail-rec function that loop 10000 times, then it will waste the CPU cache, right ?
<fremo> even "f x = function 0 -> x | n -> f (x+1) (n-1)" will clear the cache for f x (size of the cache in words), right ?
<fremo> then it's more efficient to use references...
<fremo> hum, not with a Less Frequently Used (LFU) cache algorithm
mav has quit ["Leaving"]
<fremo> but still, it will still copy the data back in memory...
<grirgz> mmmh, if f is tail-recursive, then it will not waste anything
<grirgz> maybe i dont understand your question
<fremo> ha, that's my question, in other words, will the parameters be free before the function call itself again ? I'll say yes...
<fremo> so, it's not the job of the GC ?
ulfdoz has quit [Read error: 60 (Operation timed out)]
<grirgz> fremo: the tail-recursive functions are translated in iterations
<fremo> yes, my doubt is just about how the parameters are freed...
<fremo> but I'll just bet on ocaml is doing it the right way :)
<fremo> I'll see :)
<grirgz> ok, i dont know, sorry, i'm just a noob =)
szsz has quit ["Leaving."]
puks has quit [Read error: 110 (Connection timed out)]
szsz has joined #ocaml
<fremo> no problem, thank you ;)
schme` has quit [Connection timed out]
<fremo> time to sleep for me.
<fremo> byr
<fremo> bye
Lectus has joined #ocaml
Lectus has left #ocaml []
buluca has joined #ocaml
Smerdyakov has quit ["Leaving"]
bluestorm has joined #ocaml
netx has quit ["Leaving"]
netx has joined #ocaml
ulfdoz has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Client Quit]
piggybox__ has joined #ocaml
piggybox_ has quit [Connection timed out]
<pango> fremo: that's about SML, and a bit old, but may interest you: ftp://ftp.cs.umass.edu/pub/osl/papers/gc-workshop93a.ps.Z
<pango> the point is that the question is being studied for a long time, and garbage collected environments can be similar to your-favorite-memory-management-language in cache friendliness
<pango> (on the other hand, it can pay off to write code that use memory efficiently... I remember a short article showing how some function (some kind of List.remove ?) could be rewritten to maximize sharing and improve both memory usage and cache friendliness)
<bluestorm> but those are not low-level consideration, are they ?
<bluestorm> i mean, sharing the nodes of the functional data structure is a known technique that can be used without advanced tools concerning cache friendliness and other things
<pango> it used physical equality, so what somewhat low-level
<bluestorm> hum
<bluestorm> could that not be mimiced by a additional "we really removed something" bool return value ?
<bluestorm> but yes it looks like a good idea
<bluestorm> hm
<bluestorm> btw
<bluestorm> would one of you have an idea of the "OCaml birthday" date ?
<bluestorm> according to the history page of caml.inria.fr, "OCaml" was created in 96/97
<bluestorm> so there may be or have been a 10 year birthday around
<pango> from what I read it has been released in '96
buluca has quit ["Leaving."]
buluca has joined #ocaml
<pango> (other papers on GC/cache interaction, same source: ftp://ftp.cs.umass.edu/pub/osl/papers/popl94.ps.Z, http://www-plan.cs.colorado.edu/diwan/tocs95.ps ... etc, etc. I think the one I remembered what the '94's paper)
G has joined #ocaml
G_ has quit [Read error: 110 (Connection timed out)]
screwt8 has joined #ocaml
ygrek has joined #ocaml
b00t has joined #ocaml
m3ga has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
grirgz has quit [Remote closed the connection]
grirgz has joined #ocaml
slipstream-- has quit [Remote closed the connection]
slipstream has joined #ocaml
screwt8 has quit ["using sirc version 2.211"]
b00t has quit [No route to host]
screwt8 has joined #ocaml
Tetsuo has joined #ocaml
screwt8 has quit [Client Quit]
screwt8 has joined #ocaml
jedai has joined #ocaml
lorty has joined #ocaml
lorty has quit [Client Quit]
lorky has joined #ocaml
Demitar has joined #ocaml
lorky has quit [Client Quit]
slipstream has quit [Remote closed the connection]
slipstream has joined #ocaml
schme has joined #ocaml
slipstream has quit [Remote closed the connection]
slipstream has joined #ocaml
ppsmimou has joined #ocaml
slipstream has quit [Remote closed the connection]
slipstream has joined #ocaml
buluca has joined #ocaml
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
piggybox__ has quit [Connection timed out]
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
schme has quit [Connection timed out]
Demitar has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
smimou has quit [Remote closed the connection]
screwt8 has quit [Remote closed the connection]
smimou has joined #ocaml
screwt8 has joined #ocaml
piggybox has joined #ocaml
G_ has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
G has joined #ocaml
G_ has quit [Read error: 110 (Connection timed out)]
m3ga has quit ["disappearing into the sunset"]
G_ has joined #ocaml
pantsd has quit [Read error: 110 (Connection timed out)]
pantsd has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
G has joined #ocaml
G_ has quit [Connection timed out]
<fremo> pango: thank you ! :)
<fremo> do you mean functions parameters are allocated on the heap and not on the stack ?
slipstream has quit [Remote closed the connection]
slipstream has joined #ocaml
<fremo> I'll do some tests with ocamlc -dinstr
|Jedai| has joined #ocaml
ita has joined #ocaml
jedai has quit [Read error: 110 (Connection timed out)]
screwt8 has quit [Remote closed the connection]
crathman has joined #ocaml
[azoic] has joined #ocaml
seafoodX has quit []
pango has quit [Remote closed the connection]
ulfdoz_ is now known as ulfdoz
Smerdyakov has joined #ocaml
pango has joined #ocaml
_bt has joined #ocaml
_bt has left #ocaml []
[azoic] has quit ["Leaving."]
seafoodX has joined #ocaml
ygrek has quit [Remote closed the connection]
seafoodX has quit [Read error: 104 (Connection reset by peer)]
ita is now known as ita|zzz
mav has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
Demitar has joined #ocaml
ygrek has joined #ocaml
buluca has joined #ocaml
tty56_ has quit [Read error: 113 (No route to host)]
Demitar has quit [No route to host]
screwt8 has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
tty56 has joined #ocaml
ygrek has quit [Remote closed the connection]
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
mav has quit [Read error: 104 (Connection reset by peer)]
Lectus has joined #ocaml
<Lectus> Hello! I just came across Ocaml. What is it good for?
<grirgz> does ocamldebug can't call object methods ? when i try "print x#cur" i get a syntax error
<bluestorm> Lectus:
<bluestorm> OCaml is good for writing compilers
<bluestorm> hm
<bluestorm> processing formal structures
<bluestorm> (i don't exactly know what do *you* mean by "formal structure", but think of a tree, for example)
<bluestorm> having fun with programming
<bluestorm> trying to mix different paradigms
<bluestorm> hm
<bluestorm> (however i won't be able to help you here, i never used ocamldebug)
<grirgz> thank you
magius_pendragon has joined #ocaml
mav has joined #ocaml
<grirgz> print * can solve my problem =)
Lectus has left #ocaml []
Demitar has joined #ocaml
<pango> fremo: I think that boxed values, like records, are always allocated on the heap
<bluestorm> hm pango, just a questoin
<bluestorm> how comes we never see the questions fremo is asking for ?
<pango> he posted that one 5 hours ago... You didn't see it at the time?
<bluestorm> (i mean, this morning i just thought "that was before i came in", but now i've been there all day and i never saw any fremo-to-you information flow)
<bluestorm> hm
<bluestorm> aah, yes
<bluestorm> grr
<bluestorm> i saw it actually, but it's lost in server messages
<bluestorm> sorry for bothering you
<bluestorm> (the idea of the cognitive link was cool :-' )
<pango> eh
xavierbot has quit [Remote closed the connection]
slipstream-- has joined #ocaml
olegfink has quit [Read error: 104 (Connection reset by peer)]
olegfink has joined #ocaml
slipstream has quit [Success]
G_ has joined #ocaml
G has quit [Connection timed out]
G has joined #ocaml
buluca has joined #ocaml
<fremo> bluestorm: /ignore #ocaml JOINS PARTS QUITS ;)
G_ has quit [Connection timed out]
ita|zzz is now known as ita
<fremo> pango: so data that are allocated on stack are just pointers and integers, floats not ? so no heap allocations when unrolling lists and assigning sublists on list ref for example ?
<fremo> it's about an interpreter main loop...
<fremo> I saw that the stack of the VM is a (value*) C table array
<fremo> -table
<pango> floats are usually boxed too
<fremo> so, references are the (dirty) key for extreme efficiency...
<pango> lists are immutable, so I'm not sure what you mean by "assigning sublists"
<fremo> f (tl list)
<fremo> r := tl list
<pango> tl requires no allocation
<fremo> yes
<pango> and references are implemented as a record of a single mutable field
<fremo> ha yes, I remember now...
<pango> you seldom see hd and tl used in idiomatic ocaml code; most often pattern matching is used for lists deconstruction
<fremo> yes, sure :)
<pango> let rec sum = function [] -> 0 | h :: q -> h + sum q ;;
<pango> etc. no references needed
<fremo> that's the way I use lists
<fremo> by the way, why is there this construction: let f hd::tl = ...
<fremo> it will generate a "pattern not exhaustive" warning
<pango> that's incorrect, maybe you mean let f (hd::tl) = ...
<pango> let does pattern matching
<fremo> ho ! yes :)
<pango> # let (a, b) = (3, "hello") ;;
<pango> val a : int = 3
<pango> val b : string = "hello"
<fremo> right
<pango> so let f (hd::tl) = ... is the same as let f l = match l with hd :: tl -> ... or let f = function hd::tl -> ...
<pango> since not all lists have a head and a tail, you get a non exhaustive matching... f [] will raise an exception
<pango> you get a warning at compile time, in case you forgot about that
<fremo> right, Not_found, thank you, I was wondering if I was missing something...
<pango> # f [] ;;
<pango> Exception: Match_failure ("", 1, 6).
<fremo> 1, 6 is something like line/char number ?
<pango> yes... Not too useful in the toplevel interpreter, like in this case...
<pango> using non exhaustive matches is poor style... for one compile-time warning should be avoided
<bluestorm> hm
<bluestorm> i sometimes use them
<fremo> booo
<fremo> :)
<bluestorm> i even wrote a "let refutable (hd::tl) = ..." syntaxe extension
<bluestorm> -e
<bluestorm> hm
<bluestorm> but the revised syntaxically ensure you don't use refutable patterns in "let"
<pango> as the number of warnings increase, you may miss important ones among the expected ones
<bluestorm> hm
jganetsk has joined #ocaml
<pango> and disabling warnings is worse than the disease ;)
<bluestorm> so a syntax extension looks like a good compromise
<jganetsk> i just entered, can you tell me what syntax extension is being talked about?
<bluestorm> a little one i wrote this summer
<jganetsk> to do what?
<bluestorm> "let refutable p = a in b" -> "match a with p -> b | _ -> assert false"
<bluestorm> to avoid the warning when doing "let (hd::tl) = ... in ..."
<jganetsk> is refutable the best name for it?
<bluestorm> maybe not
<jganetsk> let force p = a in b ?
pantsd has quit [Read error: 110 (Connection timed out)]
<jganetsk> or just
<jganetsk> force p = a in b
<bluestorm> but in the syntax, non-missable patterns are called "irrefutable"
<bluestorm> so that looked coherent
<bluestorm> pango:
<bluestorm> let [(+=); (-=); ( *=); (/=)] = let refop op ref x = ref := op !ref x in List.map refop [(+); (-); ( * ); (/)];;
<bluestorm> (haha, no xavierbot !)
<bluestorm> how would you write something like that in "good" style
<bluestorm> i don't see any non-painful translation
pantsd has joined #ocaml
<pango> what's wrong with that one?
bluestorm has quit ["Konversation terminated!"]
bluestorm has joined #ocaml
<bluestorm> hm sorry
<pango> what's wrong with that one?
<bluestorm> it's "bad style" as you say
<pango> I see no non-exhaustive matches...
<bluestorm> hm
<bluestorm> let [a;b] = ... is a non-exhaustive match
<grirgz> hey, good idea, this operators =)
<bluestorm> same as let a::b::[] = ...
<pango> ah, correct
<bluestorm> hm
<pango> the correct one is to avoid those horrible operators of course ;)
<pango> the best would be to use a tuple instead of a list...
<bluestorm> but you can't use List.map anymore
<pango> correct
<bluestorm> refop is not *that* big but it's still code bloat
<pango> let (+=), (-=), ( *=), (/=) =
<pango> let refop op ref x = ref := op !ref x in
<pango> refop (+), refop (-), refop ( *), refop (/)
<bluestorm> beeeh :p
<bluestorm> let refutable [...] sounds like a better idea :p
<bluestorm> jganetsk: concerning the syntax, I think keeping the "let" is important here
<bluestorm> and hm
<bluestorm> after having the head into the camlp4 sources for some days, "refutable" looked like a good idea
<bluestorm> in revised syntax they use the "irrefutable" term
<bluestorm> so it's common... among revised syntax users
<bluestorm> (that is to say : nobody)
|Jedai| is now known as jedai
crathman has quit [Read error: 110 (Connection timed out)]
magius_pendragon has quit ["Lost terminal"]
jeberle has joined #ocaml
Tetsuo has quit ["Leaving"]
piggybox has quit [Read error: 104 (Connection reset by peer)]