flux__ changed the topic of #ocaml to: OCaml 3.09.2 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
metaperl has joined #ocaml
MisterC has joined #ocaml
Skal has quit [Read error: 110 (Connection timed out)]
mikeX has quit ["zzz"]
love-pingoo has joined #ocaml
mikeX has joined #ocaml
mrpingoo has joined #ocaml
love-pingoo has quit [Read error: 110 (Connection timed out)]
hikozaemon has joined #ocaml
sidewinder has quit [Read error: 110 (Connection timed out)]
khaladan has joined #ocaml
sidewinder has joined #ocaml
Smerdyakov has quit ["Leaving"]
uglala has joined #ocaml
<uglala> (** Build ['b list] by [('a -> 'a -> 'b)] on adjacent pairs of ['a list]. *)
<uglala> let rec map_pairs f = function
<uglala> | a :: b :: tail -> f a b :: map_pairs f (b :: tail)
<uglala> | _ -> []
<uglala> any ideas on making this tail recursive?
<uglala> i'm getting stack overflows.
<uglala> or is there an idiomatic way to do that thing.
<uglala> hey, i'm not a studetn.
<danly> Just checking :)
<uglala> just wondering if anyone is bored enough to amuse me here.
<mrpingoo> uglala: you can always use continuations to make something tail rec
<mrpingoo> in that case I would pass a as an argument to some map_pairs_aux
* mrpingoo was bored enough
<uglala> i'll play with that.
<uglala> let map_pairs f =
<uglala> let rec aux l = function
<uglala> | a :: b :: tl -> aux (f a b :: l) (b :: tl)
<uglala> | _ -> l
<uglala> in aux []
<uglala> that seems to work. thanks.
<uglala> a subtle art, this functional programming.
<uglala> (except it reverses the list...)
<uglala> (l @ [f a b]) fixed that.
<uglala> oops. that makes it orders of magnitude slower.
<uglala> what a minefield.
mikeX has quit ["zzz"]
dvorak_ has joined #ocaml
pingouin has joined #ocaml
<flux__> :)
<flux__> with accumulation buffers you'll want to reverse the list in the final step
<uglala> i guess so.
mrpingoo has quit [Read error: 110 (Connection timed out)]
dvorak has quit [Read error: 110 (Connection timed out)]
rillig has quit ["exit(EXIT_SUCCESS)"]
pingouin has quit ["Connection reset by by pear"]
Snark has joined #ocaml
slipstream has joined #ocaml
<pango> uglala: by matching with | a :: (b :: _) as tl -> you don't have to rebuild b :: tl
slipstream-- has quit [Read error: 110 (Connection timed out)]
pango is now known as pangoafk
shawn has joined #ocaml
pangoafk is now known as pango
<uglala> pango: neat, thanks.
<uglala> | a :: ((b :: _) as tl) -> , though.
<uglala> negligible performance improvement, btw. but cleaner.
<uglala> | a :: (b :: _ as tl) -> in fact
<pango> ok ;)
uglala has left #ocaml []
jip has quit ["Leaving"]
hikozaemon has quit ["Leaving..."]
sidewinder has quit [Read error: 110 (Connection timed out)]
metaperl has quit ["KVIrc 3.2.1 Anomalies http://www.kvirc.net/"]
metaperl has joined #ocaml
Revision17 has quit [Connection timed out]
jbramley is now known as Lob-Sogular
pwned_ has joined #ocaml
pwned has quit [Nick collision from services.]
pwned_ is now known as pwned
shawn_ has joined #ocaml
pwned_ has joined #ocaml
shawn has quit [Read error: 104 (Connection reset by peer)]
Tachyon76 has joined #ocaml
pwned has quit [Read error: 110 (Connection timed out)]
mikeX has joined #ocaml
pwned_ is now known as pwned
nahsor has joined #ocaml
love-pingoo has joined #ocaml
<mikeX> the error message is one line off btw, I can't figure out what's the problem with this one, i'm hardly acquainted with camlp4
<ketty> mikeX: you use the new version of camlp4?
<mikeX> I doubt that, I saw the mailing list post as well, but I don't think that one is in debian sid already
<ketty> ok
<mikeX> 3.09.1
<mikeX> that's the version
<ketty> try change loc to _loc
<mikeX> actually, I haven't written this, maybe the one that did is ?
<ketty> i think it used to be called loc a while ago, but than it changed into _loc
<mikeX> wow that works, thanks ketty :)
<ketty> np :)
<mikeX> I didn't realize it was a reserved word
<ketty> i think the new version does this in a more clean way...
<ketty> at least they said it doesn't polute the global namespace anymore :)
<mikeX> i hope it's more simple than the previous version
* ketty hopes so too :)
nahsor has left #ocaml []
pango has quit [Read error: 145 (Connection timed out)]
Revision17 has joined #ocaml
cmeme has quit [Remote closed the connection]
pango has joined #ocaml
love-pingoo has quit ["Connection reset by by pear"]
Revision17 has quit [Connection timed out]
cmeme has joined #ocaml
finelemon has joined #ocaml
smimou has joined #ocaml
Tachyon76 has quit ["Leaving"]
finelemo1 has quit [Read error: 110 (Connection timed out)]
finelemon has quit [Read error: 110 (Connection timed out)]
finelemon has joined #ocaml
khaladan has quit [Read error: 104 (Connection reset by peer)]
vincenz has joined #ocaml
gim__ has joined #ocaml
pwned has quit ["back to the past"]
<flux__> loc or _loc aren't reserved words, but because the compiler nowadays complains about unused identifiers (which loc often is), the behavior was changed to generate references to _loc instad of loc
<flux__> that can be changed with a camlp4-parameter too
Boojum has joined #ocaml
Snark has quit [Read error: 110 (Connection timed out)]
Smerdyakov has joined #ocaml
pango is now known as pangoafk
pangoafk is now known as pango
chessguy has joined #ocaml
pinupgeek has joined #ocaml
pinupgeek has quit []
Boojum is now known as Snark
<flux__> is it more gc-efficient to use streams instead of lists (for a task where lists can be replaced with streams)?
<flux__> I'm thinking that because streams have a limitation of not being able to pull the same value out of the stream twice, there might be an optimization..
<flux__> I mean, otherwise, why bother with that? (maybe there's a deeper reason)
<pattern> can anyone recommend a good book on type theory? preferably one that uses *ml for examples... :)
<vincenz> pattern: TAPLL
<vincenz> tapl even
<vincenz> by Bruce Pierce
<pattern> Types and Programming Languages by Benjamin C. Pierce ?
<vincenz> yep
<vincenz> err Benjamin
* vincenz coughs
<pattern> thanks... i'll check that out
<vincenz> it's the std for type theory afaik
<pattern> yeah, i think i've heard it mentioned before... but i couldn't remember the name
kral has joined #ocaml
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <-"]
lodewijk has joined #ocaml
lodewijk has quit [Client Quit]
lodewijk has joined #ocaml
<metaperl> I'm having problems following this diagram. In particular, I think the first column is not correct: http://caml.inria.fr/pub/docs/oreilly-book/html/book-ora019.html#fig-ex-transit
<metaperl> you have to scroll up a little bit from the link
<ketty> yeah, the first column looks kind of weird, doesn't it? :)
<metaperl> yes
<ketty> but the other columns are fine, right?
<metaperl> well...
<metaperl> below that is says "We assume that the current state is the quadruplet (a,b,Å,d):"
<metaperl> but they never explicitly define a, b, A or d do they?
<ketty> they do define state thou...
<pango> metaperl: try the PDF versions http://caml.inria.fr/pub/docs/oreilly-book/pdf/chap2.pdf, p. 60
<metaperl> oh ok hold
multani has joined #ocaml
<metaperl> pango: I'm sorry but 3+21*2 should not at any time show 24
<metaperl> that should evaluate as 3+42 then 45
<ketty> hehe :)
<ketty> yes, it is a stupid calculator
<metaperl> the PDF is no better
<metaperl> but thanks for the help
<ketty> but you know those simple calculators that only can display one number at the time?
<ketty> those would interpret "3+21*2" as "(3+21)*2"
<pango> yes, since state does not contain any stack, that's to be expected
<pango> some "emulations" like gcalctool behave exactly like that too, unless you use parenthesis
rillig has joined #ocaml
<metaperl> actually upon reading the code, the calculator does just what their state diagram mandates
<metaperl> it may not be mathematically sound, but it does do what it is supposed to
<ketty> :)
Snark has left #ocaml []
* ketty gives a calculator that says "2+2=5" to metaperl
<metaperl> hey, digits dont have to map to our common concepts of quantity
<metaperl> it's all a matter of the postulates that make up the system
<ketty> yes, indeed.. :)
lodewijk has quit [Client Quit]
khaladan has joined #ocaml
mikeX has quit ["reboot"]
<metaperl> I have a couple ofquestions on tries typed up here I would appreciate help with: http://ocaml.metaperl.com/ora-book/lextree.ml
<ketty> metaperl: you need parentesis..
<metaperl> hmm
<ketty> Letter ('f', false, [])
<metaperl> but I dont see how the the f gets connected to 'a' and 'r' ... how would you code that?
<ketty> 'a' and 'r' ?
<metaperl> oh I think I know... each of those would be in the list a the end
<ketty> yeah, i guess... ^^
kral has quit ["Live fast, die young."]
<metaperl> [ Letter('f', false, [ Letter ('a', true, [ bla blah] ), Letter ('r', false, [blah blah]) ] ) ] ;;
<metaperl> because the diagram shows 'a' and 'r' and children of 'f'
<ketty> ok
dark_light has joined #ocaml
multani has quit ["Parti"]
<metaperl> my attempt to connect 2 letters is not quite working: [ Letter('f', false, [ Letter ('a', true, [ bla blah] ), Letter ('r', false, [blah blah]) ] ) ] ;;
<metaperl> oops
<metaperl> wrong thing
<metaperl> let connect lettera letterb = match lettera with
<metaperl> Letter (c, b, ls) = Letter (c, b, letterb::ls) ;;
<metaperl> can I in-place modify lettera?
<ketty> no, i don't think so..
* ketty is a bit confused...
<ketty> you can only modify mutable stuff...
<ketty> does that even complie?
<ketty> the syntax of a match is not like that
<ketty> in general, you don't in place modify stuff...
<metaperl> no, it does not compile
<metaperl> how would I syntax match that
<ketty> what you wan't to do is to return the connected letters
<metaperl> no
<ketty> not try to modify things :)
<metaperl> do you see the graph?
<ketty> no :)
<metaperl> yes... not modify
<metaperl> however earlier there was an in-place modification in the calculator I think
<ketty> yes, but we don't like that :)
<ketty> match [expression] with [pattern] -> [expression]
<ketty> match stuff with Letter (c, b, ls) -> Letter (c, b, letterb::ls)
<ketty> i think
<ketty> and then "Letter (c, b, letterb::ls)" is returned by the whole expression
<Lob-Sogular> anyone know if it's possible to use bound parameters with the ocaml postgresql library?
* ketty hasn't used that library...
<metaperl> ketty: look at this code please: [15:27:22] ketty is a bit confused...
<metaperl> this is in-place modification - { st with lka=ky; vpr=st.vpr*10+n }
<metaperl> isn't it?
<ketty> no
<ketty> it isn't :)
<ketty> a new record is returned
<ketty> with some fields shared with st
<ketty> and some fields with different values
<metaperl> shared... meaning?
<metaperl> physically shared?
<ketty> same value...
<ketty> yes probably physacally
<metaperl> I see
<ketty> but since they are not mutable, it does not matter that much to us
<ketty> except when we are conserned about memory...
<ketty> heh.. "physacally" looks like a funky word :)
<metaperl> I connected 'a' and the 'r' to the 'f' - http://ocaml.metaperl.com/ora-book/lextree.ml
mikeX has joined #ocaml
rillig has quit ["exit(EXIT_SUCCESS)"]
<pango> flux__: a relation is an equivalence if it's reflexive, transitive, and symetric. That's why equality is an equivalence
smimou has quit ["bli"]
<metaperl> my nested list is not very attractive when formatted in XEmacs... any suggestions for reformatting it: http://ocaml.metaperl.com/ora-book/lextree.ml
MisterC has quit [Remote closed the connection]
<ketty> metaperl: hmm...
<ketty> if you want readable formatting it is usually a good idea to use an itermediate type that is easier to format...
<metaperl> I'm getting a compiler error when I call my connect function.. please help: http://ocaml.metaperl.com/ora-book/lextree.ml
<ketty> ....
<ketty> it says that it gets to many arguments...
<ketty> in this case you give it 4
<ketty> notice that there is no difference between: Letter (a,b,c) and Letter(a,b,c)
<ketty> it is infact an application...
<metaperl> I'm lost
<metaperl> I think I'm giving it 2 args
<ketty> you are giving it two type-constructors and two tuples...
<metaperl> oh
<metaperl> so parenthesize each call to Letter()?
<ketty> yes
<metaperl> any prettier way?
<ketty> hmm...
<ketty> depends...
<ketty> normaly you wont call connect with literal values..
<ketty> but you will use variables...
<ketty> but if you are going to use literal values alot
<ketty> you can define connect to only take two tuples
<ketty> and then apply the type-constructor inside of connect
<ketty> (which you are allready doing by the way)
Revision17 has joined #ocaml
<metaperl> is there a comment character other than (* *)