Yurik changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml| Early releases of OCamlBDB and OCamlGettext are available
redcrosse has left #ocaml []
clam has joined #ocaml
<palomer> :o
<mrvn> :-P
Hellfried has quit ["Client Exiting"]
<mrvn> 4w·þø][ n¾½æ²^}¶¢ð«¨µê»³ÞÞÞÞÞÞÞÞÞÞÞÞÞûûûßßûýû߶Þý²²ß8<,i9m 5c:_?LO=U/&R$XSEYAQ"äöü
<mrvn> p98 wa.liokunbcsù¾¼½µû𶻻»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
<mrvn> ups
<Riastradh> Uh...?
<palomer> æßð-Bð-D¿-A¶¶»$-1òü-D¢$-1öò-Aøøl$-2  -A·b·b$-2  bb-Aµ$-2  -C±h-D¢-A
<emu> sorta looks like a waz3z channel
<emu> with mirc skr1pt k1dd1es
<whee> NE1 GOTZ GTA THREE ISO OR CRACK????????????????
<mrvn> Someone claimed that pressing too many keys at once would block the keyboard.
<whee> :)
<emu> and polaris IRC
<emu> with super-ANSI-code-madness
<emu> the number of question marks is an important part of the grammar
<emu> it communicates a certain inflection to the question
<emu> if you don't put enough question marks, you may not be taken seriously by the other w4r3z d00d3z
<palomer> the more the question marks the more the riches
<mrvn> Using more than 3 exlamation marks is a sure sign or madness!!!!!!!!
<emu> they know that FBI detectives would only put 1 ?, and show signs of grammar
<palomer> do not everestimate teh FIB detectives.
<palomer> how come when I bind a function to a name,say newfun, and inside that function I use another function, say oldfun, and then I change function oldfun, newfun still uses the old definition of oldfun
<palomer> like let x = fun a -> a * a;; let z = fun b -> x b;; let x = fun a -> 0;;
<emu> cuz
<emu> the name is resolved at compile time
<palomer> hrm
<emu> the hallmark of statically-typed languages
<palomer> this is being interpreted
<mrvn> palomer: because a function allways remebers the environment it was defined in.
<palomer> oh
<palomer> that's no good
clam has quit [Read error: 110 (Connection timed out)]
<mrvn> let x = 1 let f () = x let x = 2 let _ = f ();;
<palomer> do non functional values also remember the environment they were defined in?
<emu> remember
<emu> functions have a "deferred" piece of code
<emu> it doesn't get executed till later
<emu> other constructs all evaluate their parts when encountered
<emu> that's why we talk about closures over functions
<palomer> hrm
<palomer> is that why ml is called pseudo functional?
<emu> no
<emu> ML is called pseudofunctional, or better yet 'not purely' functional because it allows mutation on certain values
<palomer> whoa, I'll get to that later
<mrvn> palomer: everything remembers their environment.
<emu> of coures you could also jump in and claim that ML isn't pure lambda calculus cause it has constant values
<emu> like 1,2,3 ...
<mrvn> palomer: or rather every function call does.
<emu> every function does
<emu> that's what a closure is
<emu> a function, and the environment it was defined in
<palomer> you're right!
<emu> however, by an indirection, it is possible to have that concept and be able to redefine functions that are used, later on
<palomer> so global variables are a big nono in ocaml
<palomer> gotcha
<mrvn> Why?
<mrvn> Without global variables you cando hardly anything.
<palomer> what if you change the global variable later on in your code
<mrvn> palomer: variables can't be changed, ever
<palomer> whoa
<mrvn> and their called values.
<whee> or bindings
<palomer> I can do let x =3 ;; let z = 4;;
<palomer> erm
<mrvn> The only thing you can change are references.
<palomer> let x = 3;; let x = 4;;
<emu> you can rebind the variable
<palomer> ahh
<palomer> gotcha
<emu> shadow it
<emu> rather
<emu> I presume that's what Ocaml is doing
<mrvn> palomer: then you have 2 x, one x=3 and one x=4 that shadows the first (forever)
<emu> the binding x to 4 overshadows the binding x to 3 in all further code
<palomer> ok
<emu> if you did let x = 3 ;; let f () = x ;; let x = 4 ;;
<mrvn> emu: actually I think it will remove the first from the root set and the GC cleans it up. Hopefully.
<emu> mrvn: if no references, sure =)
<palomer> so functions called withing other functions remember their environment
<emu> I think it's better if you avoid that form of let, and use the explicitly scoped one
<emu> when talking about this
<palomer> so if you rebind a variable to another function, it doesn't affect all previous functions
<emu> let x = 3 in (let f () = x in (let x = 4 in f ()));;
<palomer> whats let f () ?
<emu> makes f a function of no arguments, I believe
<emu> well, f a function of () argument =)
<palomer> ah
<palomer> what if I want to do this:
<palomer> have a global variable that changes within the code
<palomer> and have functions use that global variable
<emu> when you make a function, the closure is created too, at that moment
<palomer> remind me what a closure is?
<emu> basically, you want to modify the binding of a global variable
<emu> closure is function + environment at time of creation of function
<emu> in my example, x = 3 is part of the environment when f () is created
<emu> therefore, whenever you invoke f (), it knows about that binding
<mrvn> palomer: try the following:
<palomer> gotcha
<Riastradh> emu, to be more precise, a closure is an expression to be evaluated and an environment; to say it's a function and an environment is kind of silly, since all functions really are closures.
<mrvn> let (inc, dec, get) = let x = ref 0 in ((fun () -> x := !x+1), (fun () -> x := !x-1), (fun () -> !x));;
<mrvn> get ();;
<mrvn> inc ();;
<mrvn> get ();;
<mrvn> dec ();;
<mrvn> x;;
<emu> Riastradh: well, actually, you can have a non-closure function =)
<emu> Riastradh: but to be even more precise
<Riastradh> emu - Ack, how?
<emu> you don't need the environment =)
<emu> Riastradh: simple; don't have it! =)
<palomer> mrvn: I don't understand that code
<emu> I'm not saying you CAN do this in Ocaml, I'm saying the concept is possible
<Riastradh> Oh, I see.
<mrvn> palomer: seen references yet?
<Riastradh> I'm referring to specifically OCaml here.
<emu> and older Lisps in fact used to distinguish this
<palomer> nope
<mrvn> palomer: just try it
<Riastradh> emu - Yeah, older Lisps sucked.
<mrvn> palomer: and then read about references
<Riastradh> dynamic scoping = blech!
<palomer> maybe I should get ahead in my ocaml reading
<emu> Riastradh: the amazing thing is, they were still far ahead of most other languages
<emu> Riastradh: dynamic scoping was the least of it
<Riastradh> emu - True...but that just says something about most other languages.
<emu> Riastradh: there were so many crazy things about them, if you read about it
<palomer> so what seems to be easier to code? scheme where everything is a reference or ocaml where you have to be explicit?
<emu> anyway dynamic scoping isn't all bad
<emu> I wouldn't want to use it, only, though
docelic|sleepo is now known as docelic
<Riastradh> I'm not against having -SOME- things have a dynamic scope.
<mrvn> global scoping realy is a bitch. You screw yourself all the time.
<emu> since when is anything a reference in scheme?
<emu> er, everything
<mrvn> And also its slower
<Riastradh> But only if they -explicitly- dynamically scoped, where things are generally statically scoped.
<emu> palomer: you might want to learn how to use closures or modules to do what you want
<palomer> is it any harder?
<emu> Riastradh: this is what CL does today, and it makes sense
<mrvn> Riastradh: -explicitly- dynamically scoped as in ref x?
<emu> palomer: remember, if you can capture an environment in a function... you can also capture that environment in a bunch of functions
<emu> mrvn: that's not dynamic scoping
<Riastradh> mrvn - I'm referring to stuff like fluids in Scheme48 or parameters in SRFI 39 (draft).
<emu> dynamic scoping is a misnomer
<palomer> im used to the idea that functions can change by simply changing the global variables within them
<emu> it means indefinite scope, and dynamic extent
<emu> Common Lisp the Language, 2nd ed, has a good discussion on the different kinds of scoping in the Scope chapter
<mrvn> Riastradh: But a ref would behave the same way?
<emu> you might want to read it
<Riastradh> mrvn - No, it wouldn't. Did I say it would?
<emu> when a special variable is bound, the binding is in scope for all subsequent code that is EXECUTED, until the binding is disestablished
<emu> special variables being "dynamically scoped"
<palomer> im used to lisp or c++ where if you do (define a 3) (define (f b) (+ a b)) (define a 4) then (f 4) is 8
<emu> that's not lisp
<emu> or c++
<palomer> scheme
<palomer> sure thats lisp!
<Riastradh> That's Scheme, where 'define' acts as 'set!' if the variable it was going to define was already defined.
<emu> nop
<emu> when you say Lisp to a Lisper, they think Common Lisp
<emu> scheme is miles different
<Riastradh> Scheme is of the Lisp family of languages.
<Riastradh> Much like OCaml is of the ML family of languages.
<emu> which is like saying that Java is in the ALGOL family of languages
<Riastradh> No, not really.
<emu> yes, really
<palomer> cl acts the same way
<palomer> in this case
<Riastradh> Merely because two languages share a similar syntax does not put them into the same family.
<emu> that's precisely the point that I am combatting
<emu> =)
<emu> I mean, agreeing with
<emu> people think Lisp and Scheme are the same because they have similar syntax
<Riastradh> 'Lisp' isn't one language, though; it is a family of languages of which Scheme is a member.
<emu> but the syntax is only similar at one level, anyway
<emu> Scheme has deviated so far from every other Lisp, that when you say Lisp, Lispers will assume you mean CL
<Riastradh> I don't think anyone would agree that CL is anywhere near the original Lisp, either.
<emu> yes, but it's the direction that the original Lisps ended up heading
<Riastradh> No, CL is just all the directions of Lisp clumped together into one giant standard.
<emu> this is a silly discussion for ocaml chan
<Riastradh> Indeed.
<palomer> yes, get back to me, MEEEE.
<Smerdyakov> You want a silly discussion?
<Smerdyakov> Why did the chicken cross the road?
<Riastradh> You saw it too?!
<emu> to get away from CMU
* Riastradh -actually- once saw a chicken crossing the road.
<Smerdyakov> No, because the road exploded.
<Riastradh> Indeed, I was in a car and the driver had to stop the car to let it cross.
<emu> Why did the chicken cross Forbes ave?
<palomer> the ml syntax is starting to grow on me
<Smerdyakov> Because Forbes Avenue exploded.
<Riastradh> After it crossed once, and we got passed, a car behind us had to stop because the chicken crossed it again.
<palomer> so scheme uses dynamic scoping
<Riastradh> No.
<emu> palomer: ACK!!! NO!!!!
<palomer> while ml is lexical?
<emu> hahaahahah
<Riastradh> Scheme is even more statically scoped than most Lisps.
<palomer> so what does scheme use?
<emu> Scheme was revolutionary in introducing lexical scope to a Lisp
<Riastradh> Scheme is -TOTALLY- statically scoped.
<palomer> hrm
<emu> this is not an issue of scope
<emu> what you want to do is modify the binding of a global variable
<Riastradh> If you had listened to what I had said, 'define' mutates the binding if it already existed.
<emu> you do not do that in ML
<palomer> when you do (define a 3) (define (f b) (+ a b))
<emu> you modify a reference value
<palomer> ahh
<palomer> gotcha
<emu> (actually you don't do that either)
<Riastradh> Avoid mutation in general.
<emu> (probably not good style)
<palomer> and why was ml made this way?
<palomer> performance?
<palomer> doesn't it complicate things?
<Smerdyakov> Stop using English to discuss programming language semantics, boys! You're sullying the channel.
<emu> cause it's FUNctional
<emu> oh right right
<Riastradh> No: mutation is what complicates things.
<palomer> ahhh
<emu> ^&$^&%$^#%^$*%^&
<emu> <-- math syntax
<emu> <-- almost like ML
<Riastradh> --->,><.>,>>-
<Riastradh> Brainf*ck syntax!
<palomer> so all functional programmnig languages do it that way?
<Riastradh> No.
<palomer> erlang, haskell and co.?
<palomer> I don't see how it adds any functionality though
<Riastradh> 'functionality' /= 'functional'
<Smerdyakov> It is easier to reason about functional programs than imperative programs.
<palomer> I mean, if I have a global variable, and then I change the global variable, I expect the new binding to be in effect in every function where it is mentioned
<Smerdyakov> You need to look at less of the code surrounding a portion of code to understand how it works and what it does.
<Smerdyakov> It generally makes compositional organization and reasoning easier, and this is one of the BIG principles of software design.
<palomer> Smerdyakov: very good point
<Riastradh> No, palomer, that's -NOT- what you're doing.
<Riastradh> What you're doing is creating a -NEW- binding that shadows the old one, making it unavailable; -not- changing the old one.
<palomer> ahh true, we had this discussion
<palomer> and in ocaml you can't change a binding inside an environment
<palomer> gotcha
<palomer> that must be a huge shock to all the non functional programmers
<palomer> when starting with ml
<palomer> and it must make the language faster at runtime
<Riastradh> Or any functional language without 'variables.'
<palomer> hrm, scheme doesn't have variables
<palomer> and I could swallow that
<Riastradh> Yes it does.
<palomer> doesn't it have symbols and values?
<Riastradh> Variables are bindings from symbols to values, yes, but that doesn't make them nonexistent.
<Riastradh> A variable is simply something that points to a value, and the thing it points to can be changed.
<Riastradh> In Scheme you can use 'set!' to change what it points to.
<palomer> so a variable is a binding within an environment
<Riastradh> One that can be mutated.
<palomer> so you can't speak of variables without mentioning the environment
<Riastradh> Its value can 'vary,' hence the name.
<Smerdyakov> A variable is simply something that itches and won't go away.
<Riastradh> Mutating variables should -REALLY- be avoided, because then you get into issues with environments and scope instead of simply values.
<palomer> hrm
<palomer> I need an ocaml book that asks me to solve problems
<Riastradh> Write a function to apply a function to each value in a list.
<Riastradh> Using List.map is cheating.
<palomer> ok
<mrvn> Can I use List.fold_left/right?
<Riastradh> No, just use 'let,' 'match,' '::,' and '[].'
<mrvn> Riastradh: Whats a List? Write a datatype that behaves like List. :)
<Riastradh> OK, that works, too.
<mrvn> Using List is cheating
<Riastradh> Write a polymorphic 'myList' first.
<palomer> let rec ria = fun a b -> match (a,b) with
<palomer> | (a,[]) -> []
<palomer> | (a,x::xo) -> (a x) :: (ria a xo);;
<mrvn> Wow, I already have 384 lines of code for the PFC-11 and I don't even make a move yet.
<pattern_> palomer, i have the same complaint about all of the tutorials i've read... none of them ask questions or pose problems appropriate to the level of information they're covering
Smerdyakov has quit ["reboot cuz windows sux"]
<mrvn> pattern_: if you match a aginst a, why match it?
<palomer> you mean palomer
<palomer> and good point
<Riastradh> palomer, no, first write your own polymorphic myList type.
<palomer> hrm
<palomer> thats tough
<mrvn> let rec ria a b = match b with [] -> [] | x::xs -> (a x) :: (ria a xs);;
<palomer> I just started doing typedefs
<mrvn> I think type is the most important thing in ocaml after simple functions.
<pattern_> mrvn, if you want to use it as a return value?
<mrvn> How can you understand match without knowing type?
<palomer> let rec ria a x = function [] -> [] | x::xs (a x) :: (ria a xs);;
<palomer> mrvn: I don't understand matching
<palomer> atleast I know how to use it a little
<mrvn> pattern_: so? why match it? Its already bound.
<palomer> mrvn: hrm?
<Riastradh> palomer, first write a polymorphic 'myList' type.
<palomer> Riastradh: I can't! I just started types
<palomer> following the oreilly book
<Riastradh> Do you know what type parameters are like?
<pattern_> mrvn, maybe you could match something else first, and match it against itself last
<mrvn> matching is a bit tricky. Its confusing that you can match against 0, 1, 2, x but not (t+1)
<palomer> let x = {foo = 2; bar = 4};;
<palomer> right?
<mrvn> pattern_: wasn't the case
<Riastradh> palomer, answer my question: do you know what type parameters are?
<palomer> Riastradh: isn't it the stuff between the curly brackets?
<Riastradh> No.
<mrvn> palomer: those are records and no
<palomer> erm
<palomer> then no
Smerdyakov has joined #ocaml
<Riastradh> type 'a x = B of 'a | C of 'a * 'a (* 'a is a type parameter. Have you seen this before? *)
<palomer> ah yes
<palomer> coming back to me
<pattern_> mrvn, can you give me an example of code i can look at that does what you're asking about?
<palomer> like match a with (a:int*int) -> ...
<Riastradh> Um, I'm not asking about the "'a * 'a" bit, but the:
<Riastradh> type 'a x = B of 'a | C of 'a * 'a
<Riastradh> ^^ ^^ ^^ ^^
<Riastradh> bits.
<palomer> aren't those constructors?
<Riastradh> Are you using a monospace font?
<palomer> nope
<palomer> B of 'a looks like a constructor
<palomer> since it's capitalized
<Riastradh> OK, then, open up a text editor or something where you can specify fonts and look at what I said in a monospace font.
<palomer> I'm using emacs
<palomer> what's the default font in emacs:o?
<Riastradh> type 'a x = B of 'a | C of 'a * 'a
<Riastradh> Can you see the underlined bits?
<palomer> yes
<Riastradh> That's a type parameter.
<palomer> thats an unspecified type
<Riastradh> It can be any type.
<palomer> ahh I see
<palomer> so thats what they are called
<palomer> which is how you use polymorphism im guessing
<Riastradh> B 42 has a type of int x, where 'int' is the parameter to x, because 42 is of the type int.
<palomer> gotcha
<Smerdyakov> What else is of the type int?
<palomer> 42 is a nice example
<Smerdyakov> I want a better one.
<palomer> taken from all 4 volumes of the hitch hiker's guide
<Riastradh> 5.
<palomer> though the fourth book is bad
<palomer> ah yes 5
<palomer> the fifth is bad
<palomer> the rest are really good
<palomer> well the first half of 5 was good
<palomer> then he just started to try and make sense
<palomer> book 4 is my favourite
<Smerdyakov> I hope you are not one of those people who only likes sci-fi!!!!!
* Riastradh likes Shakespeare and Wilde.
<palomer> reading some WWII literature right now
<palomer> quite good
<palomer> whoa, starting to understand constant constructors
<palomer> ml is really different
<Smerdyakov> Riastradh, I hope you are not one of those people who only reads books by Anglo-Saxons!!!! ;D
<Riastradh> Smerdyakov - Of course not. I also of course read Douglas Adams.
Kinners has joined #ocaml
<Smerdyakov> Hm. What's his ethnicity?
<Riastradh> Hrmph.
<palomer> adams is a brit
<Riastradh> OK, I also read Alexandre Dumas's works.
<palomer> aould huxley:o
<palomer> whats wrong with let x = function a
<palomer> |Bar n -> n;;
<palomer> ?
<Riastradh> Where's the first clause?
<palomer> hrm?
<palomer> that is the first clause!
<Riastradh> function a | Bar n -> n
<Riastradh> ^^^^^^^^^^^
<Riastradh> But nothing is done with the match 'a'.
<palomer> a is the parameter
<palomer> if it matches Bar n then you take the n
<Riastradh> No, what you want is: function (Bar n) -> n
<palomer> oh
<Smerdyakov> Riastradh, you should read some things by authors considered "existentialists."
<Riastradh> Existentialists?
<Smerdyakov> A grouping of people concerned with angst and personal freedom, in summary =)
<palomer> hrm, if I have a costant constructor defined in 2 types, which will the function choose to be typed as?
<palomer> does a constant constructor binding also shadow?
<Riastradh> You can't, probably.
<palomer> ocaml lets me:o
<Riastradh> If you put:
<Riastradh> type a = A of int
<Riastradh> type b = A of float
<Riastradh> into foo.ml and try to compile it and link it and stuff, it works?
<palomer> no, im interpreting
<palomer> I got the polymorphic mylist! check it out:
<palomer> tye mylist = Nil | int * mylist;;
<palomer> er type
<Kinners> it'd be the most recent one I think
<Riastradh> Polymorphic?
<Riastradh> Can I put floats in it?
<palomer> erm type 'a mylist = Nil | 'a * mylist;;
<Riastradh> OK, but not quite.
<Riastradh> There would preferrably be two constructors.
<palomer> isn't there 2 constructors?
<Riastradh> No, just one -- Nil.
<Riastradh> What's the second one?
<palomer> what about 'a * mylist?
<Riastradh> That's not a constructor, though.
<palomer> what is it?
<Riastradh> It's a tuple type.
<palomer> recursize tuple!
<Kinners> palomer: you want type 'a mylist = Nil | Cons of 'a * 'a mylist;; I think
<Riastradh> Hey!
<Riastradh> He was supposed to find out himself.
<palomer> ah yes! Cons!
<Smerdyakov> That is the number one danger of IRC channels for pedagogical purposes.
<Smerdyakov> You have both assholes who like to show off, and people who come into the middle of conversations not understanding how little someone asking a question has shown himself to know. =)
<palomer> btw rms is my teacher
<palomer> im sure of it
<palomer> he looks exactly like rms
<Kinners> Riastradh: he could have been finding out for a while :)
<palomer> yes
<palomer> since I didn't even know caml had cons
<Kinners> no
<Kinners> ...
<palomer> or what constructors are exactly
* Kinners should have kept his mouth shut
<palomer> for me they're just elements of a set
<palomer> elements of a type
<Smerdyakov> "didn't know caml had cons"?!
<Smerdyakov> Cons is just an arbitrary name you pick for that constructor!!
<palomer> ahh, woops
<Smerdyakov> Go read a tutorial.
<Riastradh> Read the beginning of the OCaml manual.
<palomer> im reading the ocaml book!
<palomer> but I was lamenting the fact that I they're are no exercices to do
<Kinners> the O'Reilly book has excersies at the end of the chapters
lament has joined #ocaml
<mrvn> Constructors are an block of an int followed by the actual arguments of the constructor.
<mrvn> Internally.
<mrvn> type A | B | C;; becomes 0 1 and 2
<mrvn> type myList = Nil | Cons of 'a * 'a myList; becomes 0 or 1,'a,'a myList
<Smerdyakov> This isn't a terribly helpful thing to be thinking when programming OCaml......
<mrvn> No, not realy. Unless one wants to implement marshaling
<Smerdyakov> Soooo... we generally don't bother newbies with such things :P
<mrvn> type Foo = { other : Foo };; let foo = { other = foo; };;
<mrvn> Anyone know if one can get something like that to work at all?
<Smerdyakov> Sure.
<Smerdyakov> Throw a constructor around the record.
<Smerdyakov> For the first one
<mrvn> how?
<Smerdyakov> datatype Foo = Foo of {other : Foo}
<Smerdyakov> in SML
<Smerdyakov> If you want to do goofy things like the second one....
<Smerdyakov> You'll need to fake lazyness
<Smerdyakov> Make the member really a suspension
<Smerdyakov> ..to even have a chance of doing it.
<mrvn> # type foo = { other : foo; };;
<mrvn> type foo = { other : foo; }
<Smerdyakov> I don't know why you would want to, though.
<mrvn> # let foo = { other = foo; };;
<mrvn> Unbound value foo
<mrvn> The later is the problem.
<mrvn> I need a double linked list
<Smerdyakov> Ah. Ocaml handles type definitions significantly differently than SML, then.
<Smerdyakov> Then use references.
<mrvn> and I don't want to use foo option ref
<Smerdyakov> Sorry!
<Smerdyakov> Such is the price of doing naughty things!
<mrvn> Smerdyakov: references would make it mutable but doesn't solve the problem.
<Smerdyakov> References really do solve the problem. options are just a slight help. :P
<mrvn> # type foo = { other : foo ref; };;
<mrvn> type foo = { other : foo ref; }
<mrvn> # let foo = ref { other = foo; };;
<mrvn> Unbound value foo
<Smerdyakov> You can't refer to a non-recursive binding in its definition......
<mrvn> and you can't define a plain value recursive
<Smerdyakov> type foo = { other : foo option ref; }
<Smerdyakov> let foo = ref { other = NONE }
<Smerdyakov> foo := { other = SOME foo }
<mrvn> Hmm, waita second. you can.
<mrvn> type foo = { other : foo; };; let rec foo = { other = foo; };;
<mrvn> Somehow that works now. Didn't work before.
<Smerdyakov> I have no idea how that works...
<mrvn> I allways got omething like:
<mrvn> # let rec foo = foo+1;;
<mrvn> This kind of expression is not allowed as right-hand side of `let rec'
<Smerdyakov> Well, actually, I do.
<Smerdyakov> { other = foo; } is stored boxed.
<Smerdyakov> So it can allocate the space and use the address of the space in evaluating the contents.
<mrvn> Smerdyakov: why? let rec makes the binding recursive and the "other=foo" is well defined.
<Smerdyakov> The issue is with implementation, not high level semantics....
<Smerdyakov> Anyway, bye now.
<mrvn> Implementing is easy, its the address of it, just like let ref loop () = loop ();;
<mrvn> # class foo o = object val o = o end;;
<mrvn> class foo : 'a -> object val o : 'a end
<mrvn> # let rec foo = new foo foo;;
<mrvn> This kind of expression is not allowed as right-hand side of `let rec'
<mrvn> Thats the same thing with classes instead of records and there it doesn't work :(
<palomer> :o
<palomer> hrm, should I continue with the oreilly book or start following something else?
<Kinners> palomer: why? that book seems to be pretty thorough
<palomer> just asking
<palomer> so much to learn! ocaml is huge
<mrvn> forget about objects, do them next year
mattam_ has joined #ocaml
<Kinners> mrvn: maybe you need something like type 'a dll = {mutable prev : 'a link; mutable next : 'a link; data : 'a} and 'a link = Nil | Dll of 'a dll;;
<Kinners> mrvn: but there is probably a better way of doing it
<mrvn> That would be the same as an Option
<mrvn> It works with records, just not with classes.
<Kinners> ok, I haven't got around to using options yet
<mrvn> type 'a option = None | Some of 'a
<mrvn> Thats all it is
Kinners has left #ocaml []
mattam has quit [Read error: 110 (Connection timed out)]
<palomer> HRM
<palomer> whoa, the oreilly book suddenly starts using type t1 = { v: int; u: int};;
<palomer> what does that mean:o?
<mrvn> {} are records
<palomer> ahh
<palomer> so types can have records too
<palomer> # type t1 = {u : int; v : int} ;;
<palomer> type t1 = { u: int; v: int }
<palomer> # let y = { u=2; v=3 } ;;
<palomer> how does ocaml know what type y is ?
<mrvn> you allways have to define the type for a record before using it
<mrvn> palomer: bevause you used u and v
<palomer> what if two types had records u and v?
<palomer> don't tell me that records are all bunched up in the same namespace
<mrvn> yes and no. They are all bunched into the current namespace
<mrvn> type t1 = { u : int } type t2 = { u : float }, the second u shadows the first
<palomer> ohmy!
<mrvn> That usually isn't a problem.
<palomer> so I'm guessing records isn't to be used when dealing with object properties
<palomer> what if u is from one object and v from another?
<mrvn> then it will scream
<mrvn> such things are best tried out
<palomer> ahh
<palomer> so ocaml matches record names and tries to find out the type of what you're trying to bind
<palomer> gotcha
<palomer> bbl
palomer has quit [Remote closed the connection]
mattam_ has quit ["leaving"]
palomer has joined #ocaml
<palomer> whats wrong with this:
<palomer> let rec fold_left = fun a b c -> match (a,b,c) with
<palomer> |(_,_,[]) -> []
<palomer> |(z,y,x::xs) -> (z y)::(fold_left z (z x) xs);;
docelic is now known as docelic|away
<mrvn> Why do you keep insiting to allways match all arguments of a fun?
<palomer> hrm?
<palomer> I know I could do it with an if
<palomer> but matching is really cool and I want to get the hang of it
<mrvn> no, why do you match a and b?
<palomer> how would I do it otherwise?
<palomer> you can selectively match?
<mrvn> just don't match them
<mrvn> you can match nearly anything you want
<palomer> oh, so it's match c with...
<mrvn> fun a -> match (a,a,a,a,a,a,a,a,a) with x -> x
<mrvn> if you like
<mrvn> yes, match c with
<palomer> should I name my matchings with different names(notice the xyz)
<mrvn> palomer: I tend to use the same name if it matches to the same.
<palomer> ah, ok
<palomer> any idea whats wrong with my proggy though?
<mrvn> # let rec fold_left = fun a b c -> match c with
<mrvn> | [] -> []
<mrvn> | x::xs -> (a b)::(fold_left a (a x) xs);;
<mrvn> val fold_left : ('a -> 'a) -> 'a -> 'a list -> 'a list = <fun>
<mrvn> nothing wrong, just nowhere near fold_left
<mrvn> # List.fold_left;;
<mrvn> - : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
<palomer> ahh, my interpreter was acting buggy
<palomer> is it a good idea to go hog wild on matchings?
palomer has quit [Remote closed the connection]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
<pattern_> What do you get when you cross a continuation with a monad?
<pattern_> A gonad
mattam has joined #ocaml
foxen5 has joined #ocaml
<emu> what do you get when you cross a person with C++?
<emu> A nut.
<pattern_> "I invented the term "Object-Oriented", and I can tell you I did not have C++ in mind." -- Alan Kay
lament has joined #ocaml
xxd has quit ["EOF"]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
xxd_ has joined #ocaml
TachYon26 has joined #ocaml
zack has joined #ocaml
zack has quit [Read error: 104 (Connection reset by peer)]
xtrm_ is now known as xtrm
TachYon26 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
simon- has joined #ocaml
* simon- applauses Jason Hickey's introduction!
<simon-> enlighten me, is it common to use nested functions (currying) instead of multi-argument functions?
<mellum> There are no multi-argument functions in Ocaml.
<mellum> Only curried, and those taking tuples.
docelic|away is now known as docelic
<mellum> And one commonly uses curried ones, since the compiler optimizes better for them than for tuples, unlike in SML, where I think passing tuples is common.
<steele> another advantage is that you can commute arguments when using labels
docelic is now known as docelic|away
<simon-> mellum, oh. I thought: let f x y = x + y;; was multi-argument, but I guess its just a language shortcut then?
* simon- has programmed for years but has only just recently opened up to the theory of programming, heh.
docelic|away has quit [Remote closed the connection]
<mellum> simon-: yes, it's a shortcut. Otherwise you couldn't pass (f 2) around, for example
<simon-> mellum, right.
<simon-> mellum, my question changes then: is it common practice to express your functions using this shortcut, or using the more 'correct' way of let f i -> (f j -> i + j);;, or is there no general opinion on this?
<mellum> simon-: I don't think anybody is trying to avoid it... it's more readable, after all
systems has joined #ocaml
<mellum> simon-: you probably mean let f i = fun j -> i + j;;, though
<simon-> mellum, I'm sure I do. ;)
<simon-> mellum, yeah. oh well, I have this idea people are a lot more anal about formatting than they really are.
<mellum> Huh?
systems has quit [Read error: 60 (Operation timed out)]
mrvn has quit [leguin.freenode.net irc.freenode.net]
mellum has quit [leguin.freenode.net irc.freenode.net]
Riastradh has quit [leguin.freenode.net irc.freenode.net]
rox has quit [leguin.freenode.net irc.freenode.net]
mrvn has joined #ocaml
mellum has joined #ocaml
Riastradh has joined #ocaml
rox has joined #ocaml
asqui has quit [Excess Flood]
asqui has joined #ocaml
mellum has quit [Read error: 60 (Operation timed out)]
tati has joined #ocaml
tati has quit [Client Quit]
mellum has joined #ocaml
karryall has joined #ocaml
lam has joined #ocaml
xtrm__ has joined #ocaml
lam_ has quit [Read error: 110 (Connection timed out)]
gl has quit [Read error: 60 (Operation timed out)]
xtrm has quit [Read error: 110 (Connection timed out)]
xtrm__ is now known as xtrm
<mrvn> moin
<mellum> mrvn: finished your PFC entry yet?
<mrvn> still tuning
<mellum> does it win against mine already? :)
<mrvn> might if it would compile
<mellum> it doesn't?
<mellum> works for me[tm]
<mrvn> Do you have an connected example where X wins?
<mrvn> No, mine doesn't compile.
<mellum> Ah, OK
<mellum> 2 1
<mellum> O-
<mellum> O's turn
<mrvn> No, that would be X's turn and a draw.
<mrvn> That isn't a legal board
<mellum> Hmmm. Not trivial.
palomer has joined #ocaml
<palomer> does caml have bitfields or bit-masking?
<mellum> palomer: it has bit ops, like land and lor
<mrvn> bitfields no, bitamasking yes
capflam has joined #ocaml
capflam has quit [Client Quit]
pmty has joined #ocaml
pmty has quit [Client Quit]
<palomer> does ocaml have default arguments?
<mrvn> palomer: yes
<mrvn> mellum: Somehow my undo_move has bugs.
daapp has joined #ocaml
daapp has left #ocaml []
<palomer> hrm, since side affects are frowned upon in ocaml, the only way to change a binding is with let
<palomer> so I'd have to do let a = sort a;;
<palomer> right?
<Riastradh> Why do you want to change a binding?
<palomer> erm, wait lemme get the terms right
<palomer> I'm overshadowing the binding
<palomer> there we go
<Riastradh> Shadowing the binding.
<Riastradh> But why do you want to?
<mrvn> to sort a
<Riastradh> Yes, but can't you sort a when binding it in the first place?
<mrvn> sometimes that not practical (readable)
<palomer> yhea, I want to sort A
<palomer> I've done some stuff with a and now I want to sort it
<whee> I actually can't recall a single time where I intentionally shadowed a binding
<whee> heh
karryall has quit ["bye"]
<Smerdyakov> Hm
<Smerdyakov> You must write hard to read code.
<palomer> so how would you sort a list?
<whee> not that I know of :)
<whee> palomer: in what context?
<Smerdyakov> Rebinding a variable is a nice to show clearly a process of transformation.
<Smerdyakov> s/nice/nice way
<whee> merdyakov: I suppose, but since I've started using haskell a while ago I just never see the need to do it anymore
<palomer> you have a list a that needs sorting
<whee> palomer: then I'd use List.sort.
<emu> palomer: so you generate a new list, sorted, that has all the elements of the original
<palomer> so you would do let a = List.sort a;;
<palomer> isn't that shodowing the binding?
<whee> yes, but that's not what I would do
<Riastradh> Yes, but do you really need to do that?
<whee> what I would do depends on where this sorting is taking place
<palomer> ok
<palomer> you have a function that takes 3 lists as input, and you need to sort them before processing them
<emu> feel free to compose function calls
<emu> ;)
<palomer> hrm?
<emu> frob_stuff (List.sort a, List.sort b)
<whee> I wouldn't shadow in that case, really
<palomer> so you'd create 3 new bindings?
<emu> you don't have to be dumb and create new bindings every time you get a value
<whee> well, it depends
<emu> you can just pass it right along to wherever it needs going
<whee> if the sorted values are used once, then probably no bindings
<palomer> if they're used many times
<whee> but I typically like to keep the original passed in bindings available
<whee> well, in that case I might split this function into two functions
<palomer> ahh, gotcha
<whee> let f x y z = let g x y z .... in g (sort x) (sort y) (sort z)
<palomer> wouldn't it be more readable to just do it at the start?
<whee> preferably maybe use g' y' z' for g's inputs
<palomer> saves 3 lines of code!
<palomer> a little off topic, but if :: is the operator to append to the start of the list, what's the operator to append to the end?
<whee> it's a matter of taste I guess; using haskell for a while got me into the habit of doing things that way
<palomer> haskell frowns upon shadowing bindings?
<whee> I mean, what if you want to reuse this function elsewhere
<whee> and you already have sorted lists
<whee> do you really want to force another three calls to sort?
<palomer> reuse the function? the function is lexically scoped in this case
<whee> assume that it wasn't
<palomer> so you'd have 2 versions, one for sorted and unsorted arrays?
<whee> let f x y z = g (sort x) (sort y) (sort z), and then g doing whatever it wants
<whee> just because g may require sorted lists is no reason to force it to do the sort, that's the job of the caller
<palomer> what if you need to sort using using f1 once, f2 the next, f3 for the third
<palomer> would you create three different functions?
<palomer> each time passing the 3 newly sorted lists?
<whee> eh?
<emu> palomer: you should understand that :: is not the operator to pre-pend to a list
<emu> palomer: not in the sense that append works
<emu> palomer: an appending operation would take two lists and put them together
<Riastradh> :: creates a new list with a given head and tail.
<emu> but :: takes an object, creates a new cons, with head = the new object and tail = the original list
<emu> new_object :: original_list
<palomer> let f a b c -> let a = sort f1 a and b = sort f1 b and c = sort f1 c in...... let a= sort f2 a....
<palomer> ahh
<emu> @ is the append operator
<palomer> so is there a way to add an element to the end of the list?
<whee> well you could always use optional labeled arguments in the definition of f for providing sorting functions
<emu> list1 @ list2
<emu> if you want to add a single element to the end, list1 @ [new_object]
<emu> [ ] creates a list
<emu> [new_object] is a list with one element
<palomer> gotcha
<emu> now, if you're doing this
<whee> don't use @ extensively on longer lists, though
<emu> you're probably doing something wrong
<emu> because every time you do that, you have to traverse the first list
<emu> remember, use appropriate data structures for the problem
<Smerdyakov> NO, use inappropriate.
<Smerdyakov> I DEMAND IT
<emu> right right.. this is functional programming after all
<palomer> yhea, im making a very readable n^4 insertion sort algorithm
<mrvn> such an @[x] made the difference between 20 and 800 MB ram useage for a c preprocessor parser.
<Smerdyakov> mrvn, that's not very important.... that's really a property of garbage collection parameters of the runtime system, which I'm sure you can tweak.
<emu> yeah, most of that was likely garbage
<Smerdyakov> mrvn, as long as you weren't maintaining live references to lots of old lists
<emu> but speed-wise, it's also bad
<whee> @ is still an expensive operation compared to ::
<mrvn> Smerdyakov: nope. the lists weren't dead
<Smerdyakov> How rude.
<Smerdyakov> If you reversed them in the end anyway, however, then it should have the same amount of live data, generally.
<mrvn> let rec loop res = function 0 -> res | x -> res@[x] in loop [] 1000;;
<mrvn> let rec loop res = try function 0 -> res | x -> res@[x] with _ -> [] in loop [] 1000;;
<Smerdyakov> ...?
<mrvn> s/in/;;/
<Smerdyakov> Looks like there's no recursion there.
<palomer> ok, heres a case when you need to overshadow: you have a list a and you want to add to that list
<mrvn> args, never paste tabs.
<mrvn> let rec loop res = function 0 -> res | x -> loop (res@[x]) (x-1);;
<mrvn> let rec loop res = function 0 -> res | x -> try loop (res@[x]) (x-1) with _ -> [];;
<mrvn> loop [] 10000;;
<whee> palomer: got a practical example?
<palomer> hrm
<mrvn> The second loop uses huge amounts ofmemory.
<palomer> you have a list of all the user input thus far
<palomer> so you have let a = append a (get_user_input)
<whee> I don't know if I'd do that one, either :)
<palomer> hrm
<mrvn> palomer: You would keep the list of user input in reverse order.
<palomer> you need to store the user input in an array
<palomer> mrvn: and my program needs the first input readily all the time
<mrvn> palomer: than use (start, rev_end)
<mrvn> start being the first few inputs and rev_end all others but reversed.
<palomer> getting back to the shadowing
<palomer> I can't see how theres a way to do it without shadowing
<Smerdyakov> mrvn, I don't think your "second loop" intrinsically needs more memory than the first, or with a prepend-and-reverse strategy.
<Smerdyakov> mrvn, must be a funny implementation think in OCaml.
<mrvn> palomer: you can use different names
<Smerdyakov> thing
<whee> palomer: I wouldn't append so early, myself
<mrvn> Smerdyakov: using a pair of a forward and reverse list?
<whee> grab the input, store that somewhere, append the next time you recurse through the input gathering functional
<whee> function, even
<Smerdyakov> mrvn, for what?
<whee> that instantly eliminates the need for any binding
<mrvn> Smerdyakov: to have the beginning and the end of the list at hand.
<Smerdyakov> mrvn, no. You always add to the front, and only reverse your final answer.
<palomer> whee: but when you append you need to update a binding
<palomer> unless the binding is a reference
<mrvn> Smerdyakov: if you need to look at the ends inbetween using two lists is more efficient.
<whee> not in this case
<mrvn> Smerdyakov: or for a fifo queue.
<Smerdyakov> mrvn, who said anything about doing that?
<mrvn> palomer
<Smerdyakov> mrvn, I'm just talking about the example you gave of the 'loop' functions.
<whee> let f gathered_input = let next = get_some_input in ... process some .. f (next :: gathered_input)
<whee> assume it does something reasonable to return all the gathered input, or some other useful information
<mrvn> Smerdyakov: Ahh, say so.
<mrvn> Smerdyakov: Of cause the solution was to use :: and List.rev the result.
<Smerdyakov> <Smerdyakov> mrvn, I don't think your "second loop" intrinsically needs more memory than the first, or with a prepend-and-reverse strategy.
<palomer> whee: say you need to gather a little input, do some other stuff , then get some more input etc...
<mrvn> Smerdyakov: The point was that the @ greatly increases the memory useage if the bindings don#t die during the recursion
<Smerdyakov> Yes. The bindings in your example, however, *do* die, but the conservative garbage collector doesn't figure that out.
<mrvn> Smerdyakov: So avoiding @ is not only a time thing but also a memory thing.
<whee> palomer: like?
<whee> heh
<mrvn> Smerdyakov: no, with the try they don't.
<Smerdyakov> Really? Where is the parameter res used after you create a new list that begins with its elements?
<palomer> I give up:o
<mrvn> Smerdyakov: The binding is not used in the "with" but its still alive there.
<Smerdyakov> The usual definition of 'garbage' is 'not necessary to complete execution.'
<Smerdyakov> It is garbage in that sense.
<Smerdyakov> Runtime systems use various clever but necessarily incomplete schemes to find garbage.
<Smerdyakov> The one OCaml is using does not find that piece of garbage.
<mrvn> Smerdyakov: From a theoretical point its not garbage.
<mrvn> let rec loop res = function 0 -> res | x -> try loop (res@[x]) (x-1) with _ -> res;;
<mrvn> Take this, now res surely doesn#t become garbage.
<mrvn> OCaml could see that loop doesn't throw the exception and thus it doesn't have to be catched accross recursions but it doesn't.
* whee just noticed the try
<whee> I thought it's a bad idea to put a try in a place like that, being recursive in that manner
<Smerdyakov> Hold on (phone)
mrvn_ has joined #ocaml
<mrvn_> let rec loop res = function 0 -> res | x -> try loop (res@[x]) (x-1) with _ -> res;;
<mrvn_> Take this, now res surely doesn#t become garbage.
<mrvn_> OCaml could see that loop doesn't throw the exception and thus it doesn't have to be catched accross recursions but it doesn't.
<whee> mrvn: I just wouldn't use try in the inner loop like that
<mrvn_> Its a simplified example.
<whee> still a bad idea :)
<whee> and I think that blocks the tail call too, heh
<whee> now I can't remember the details :\
<palomer> does List.fold_left f a return the same thing as f?
<whee> - : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
mrvn has quit [Read error: 60 (Operation timed out)]
<Smerdyakov> mrvn_, it can still be garbage if we know by reasoning about the program that no exceptions will be raised.
<Smerdyakov> mrvn_, the problem is that the compiler/runtime system can't do that in general.
<palomer> wow my insertion sort is ugly...and doesn't work
<mrvn_> insertion sort is not a good thing for functional languages
<whee> it's a couple short functions though
<mrvn_> try merge sort or heap sort
steele has quit ["bbl"]
<whee> and I just found insertion sort in an ocaml introduction
<whee> well, the manual to be exact
steele has joined #ocaml
<palomer> hrm, why is this returning a function:o?
<palomer> let rec insert = fun front back elem -> match front with
<palomer> | x::xs when elem < x -> front @ [elem] @ back
<palomer> | x::xs -> insert (front @ [List.hd back])(List.tl back) elem
<palomer> | _ -> front @ [elem];;
<whee> I can't even figure that out
<whee> heh
<whee> look at the insertion sort in 1.2 at http://caml.inria.fr/ocaml/htmlman/manual003.html :)
<palomer> I'm doing the problem from that book!
<whee> I think you have that one function doing a bit too much
<palomer> so I should have a function that inserts element x at position p?
<whee> well if you take the standard imperative insertion sort and break the two loops into functions, then that's what you would get
<palomer> hrm, so my function is just plain ugly?
<whee> I can't decipher it :)
<palomer> this is what it says
<palomer> take the first element from front, if it's less than x put elem between front and back
<palomer> wait, that should be elem > x...
<palomer> ill work the kinks later
<palomer> wait, this function makes no sense:o
<palomer> bbl
palomer has quit [Remote closed the connection]
<mrvn_> Is there a function that does (LIst.rev l1)@l2?
<Smerdyakov> SML has List.revAppend
<mrvn_> Wow, mergesort readable in 20 lines. Ocaml rocks.
Smerdyakov has quit []
<mrvn_> Ocaml has List.merge, cool :)
<mrvn_> That amkes merge_sort in 12 lines :)
<mellum> mrvn_: I bet in Haskell it'd be 3
<mrvn_> How do you split a list into 2 equal sized lists with a minimum of code?
<mrvn_> let split l =
<mrvn_> let rec loop res1 res2 = function
<mrvn_> [] -> (res1, res2)
<mrvn_> | x::xs -> loop res2 (x::res1) xs
<mrvn_> in loop [] [] l;;
<mrvn_> Anything better than that?
<Riastradh> Uh, doesn't 'loop' take two arguments? -- you're passing it three in: | x :: xs -> loop res2 (x :: res1) xs
<mrvn_> res1, res2 and the function arg
<Riastradh> Oh, yes.
palomer has joined #ocaml
<palomer> waimea is fun!
skylan has quit [Connection reset by peer]
skylan has joined #ocaml
palomer has quit [Remote closed the connection]
palomer has joined #ocaml
<palomer> do you guys have trouble displaying this page? http://caml.inria.fr/oreilly-book/html/book-ora020.html#toc28
<mellum> yes
<mrvn_> mellum: Ist es normal das der mtdf erstmal je nach suchtiefe flackert?
<mrvn_> -5 -5 4 -5 4 -5
Smerdyakov has joined #ocaml
<mellum> mrvn_: macht bestimmt jedes Protokoll
<mellum> mrvn_: man kann auch einfach die Suchtiefe immer um 2 erhoehen
<mrvn_> Das sollte doch das guessing ziemlich nutzlos machen wenn das flackert.
Smerdyakov has quit [Client Quit]
<mellum> Naja, nicht ganz.
<mellum> Ausserdem benutzt eh niemand MTF(f), schreibt der eine Typ ja.
<mrvn_> Sondern lieber direkt alpha_beta?
<mellum> Ja, oder NegaScout
<mellum> Aber so schlecht scheint mir MTD(f) gar nicht zu sein.
<mellum> Wobei ich die Transpositionstabelle wohl nicht haette kicken sollen.
<mrvn_> Alles viel zu langsam
<Riastradh> Ack! Deutsch...uh...war...er...confusing.
<whee> heh
<Riastradh> No, 'war' is the past tense, isn't it?
<mellum> verwirrend.
<mellum> ja :)
<mellum> Deusch *ist* verwirrend.
* Riastradh only knows one sentence in it: 'Deine Mutter war ein Hamster und dein Vater stank nach Holunderbeeren!'
<Riastradh> Er, two, now, I suppose.
<mellum> Riastradh: Wow, that's a particularly useful sentence.
<Riastradh> Indeed.
<Riastradh> You never know when you need to insult a few English kaaaaaaaniggets from the battlements of a castle full of French weirdos in Deutsch!
<mrvn_> mellum: I'm somewhat confused by this alpha_beta
<mrvn_> Whats alpha and whats beta? Is alpha the limit for me or for my oponent?
<palomer> lather hosen
<mellum> mrvn_: neither, I think
<whee> dumb question of the day: what's the best way to do a doubly linked list type structure?
<whee> I don't need random access, just a way to easily add elements to both ends and traverse back and forth
<mrvn_> whee: type 'a dlist = { next:'a dlist; prev:'a dlist; value:'a;}
<whee> that's what I thought; easy enough
<mrvn_> whee: Do you actually need a double linked list?
<mrvn_> If you just need to add/remove elements from both sides a pair of lsts is easier.
<whee> mrvn: I'd need to be able to go either direction in the structure
<mrvn_> whee: will you change the direction often?
<whee> and I'd like that to be reasonably quick
<whee> yes, quite often
<mrvn_> type 'a dlist = 'a list * 'a list;;
* Riastradh wrote a whole SRFI for doubly-linked lists!
<mrvn_> That would be the best if you don't need to add elements at the start and end
<whee> well, I need to do that too
<mrvn_> whee: while you are running around in the middle of the list?
<whee> what I want to do is be able to traverse either direction, and add elements to the ends if they don't exist
<whee> not while I'm in the middle, no
<mellum> Riastradh: Cool. Was it accepted?
<Riastradh> No, I just wrote it and never did anything with it.
<Riastradh> It actually sucks quite a lot, being far too imperative.
<Riastradh> But you can still get all the code for it if you like:
<mellum> Well, doubly linked lists seem fundamentally imperative to me
<mrvn_> whee: imagine the double linked list. Your somewhere in the middle.
<Riastradh> It also contains 'assts,' which are like silly alists. They seemed a good idea when I wrote it.
<mrvn_> whee: Now, break the list in two parts and keep the sublists from the point where you are to eigther end.
<mrvn_> whee: Moving around in the list means taking the head of one list and adding it in front of the other.
<mrvn_> whee: let next = function (x, y::ys) -> (y::x, ys);;
<mrvn_> whee: let prev = function (x::xs, y) -> (xs, x::y);;
<whee> that does sound a lot better
<whee> and I just handle the empty list as being on one of the ends
<mrvn_> let get = function (x, y::ys) -> y;;
<whee> well, one of them being empty anyway
<mrvn_> [] would be ([], [])
<mrvn_> (x, []) is when your at the end of the list and ([],y) when your at the front
<palomer> ahh
<palomer> so [] = ([],[])
<palomer> gotcha
<mrvn_> The drawback is that youcan only insert/remove elements at your current position. So adding to the end means traversing the list to the end first.
<whee> and that's all I need to be able to do, heh
<Riastradh> Which is why the structure with three elements is better: you can always maintain a reference to any link in the list.
<Riastradh> Or rather, which is one major advantage: not necessarily why it's better.
<mrvn_> Riastradh: takes up 4 times the space for simple datatypes and is a pain to work with.
<Riastradh> Indeed, and that's why I corrected myself and said it was only one advantage.
<palomer> lol, ocaml tells you when you hav ebad style
<palomer> whoa, insertion sort is blazing fast
<palomer> whew
<whee> insertion sort is decent on smaller listss
<palomer> 50000 items in less than a second
<palomer> I remember it taking 5 seconds when I did it in c++ awhile back
<emu> insertion sort is appropriate for certain kinds of problems
<emu> for instance, if you don't already have a list
<palomer> heap sort.
<emu> maybe it wasn't that one =)
<emu> anyway
<emu> ah
<palomer> insertion sort is horrible:o
<emu> priority queue
<emu> hmm
<emu> but a heap would be better
* emu scratches his head
<emu> how about: when you are leazy
<emu> lazy
<palomer> heh
<mrvn_> bubble sort
<palomer> the fastest way if you don't have a list is to binary search everytime
<palomer> which is similar, but not identical, to heapsort
<mellum> bogosort
<mrvn_> palomer: dictionary or hash search is faster
<whee> haha, I love zsh: correct ',ale' to 'make' [nyae]? y
<emu> no, ale
<mellum> Unfortunately, zsh has us keyboard layout hardcoded
* emu thinks back to the times he used insertion sort recently and decides that it really was just laziness
<palomer> hash/dictionary searh is not an implementation
<palomer> I could give you a hash function which would search in O(2^n)
<palomer> maybe youre thinking of c++'s map vs sgi's hash map
<emu> horrible person you are
<mellum> hash tables tend to assume a non-sucking hash function
<palomer> we can't assume anything!
<palomer> a hash table is just like a sort function
<palomer> we know nothing of the implementation
<palomer> if you tell me a quadratic hash function or bubble sort, then we can talk about performance
<palomer> why are all the exercices on the oreilly book screwed up:o
<palomer> I had to emerge dillo just to view them
<mellum> galeon screws them up, too
<palomer> isn't galeon based on mozilla?
<mrvn_> mellum: my alphaBeta does endless tail-recursion :(
<mellum> mrvn_: you're writing it in Ocaml?
<mellum> I think I have an Ocaml alpha beta somewhere
<mrvn_> mellum: sure
<mellum> Hm, actually, I haven't
<mellum> The O'Reilly book has some source.
<palomer> the oreilly book rocks
<palomer> I've been converted to functional programming.
<palomer> I just wish topcoder had an ocaml option
<mellum> Yeah, I'll vote for it to be bought next time it's book buying time in our working group :)
<mrvn_> mellum: I can do depth 6 search on a 5x5 board :(
<mrvn_> +only
<mellum> mrvn_: doesn't sound too bad
<mellum> mrvn_: what does my program achieve?
<mrvn_> I think alpha-beta doesn't realy work because most moves have the same score. They eigther get all cut or all tried.
<mrvn_> mellum: 7 complete and I'm advancing by 2
<mrvn_> I'm alsoonly looking at good moves.
<mellum> There are a few entries by now... do you have some script that will let them battle against each other?
<emu> 5x5 what
mrvn_ is now known as mrvn
<mrvn> mellum: I have one that works if noone makes tempfiles.
<mrvn> mellum: depth 2, 4 and 6 have the same result, 8 then differs
<mellum> mrvn: interesting.
<mellum> mrvn: where is your script?
<mrvn> mellum: src/pfc-11/is_valid + play.sh
<mellum> mrvn: thanks
<mrvn> mellum: you have to create "start.board" and play.sh will play two games with it.
<mellum> type move = [ `X | `O ] what's that?
<mrvn> mellum: a variant type
<mellum> why not just X_move | O_move?
<mrvn> To much to type
<mellum> Argh.
<mellum> type move = X' | O' would be less
<emu> emel
<mrvn> mellum: you can do function `X -> 0 | `O -> 1 | `B -> 2 and pass it a move.
<mellum> Oh well.
<pattern_> does anyone here use cameleon to develop with?
<emu> is there a font-lock mode for ocaml in emacs
<mrvn> emu: tuareg-mode
<emu> huh
<emu> is it called tuareg-mode in emacs?
<emu> oh not by default included
<mrvn> apt-get install tuareg-mode
<emu> yes
<emu> but it's not by default loaded
<emu> according to README.Debian
<emu> don't ask me why
<mellum> emu: why?
<emu> much better
<mrvn> its easy to do.
<emu> i had to put it in .emacs
<emu> don't ask me, ask Ralf Treinen
<steele> emu: there is also caml-mode
<emu> ya, but that sucks =)
<steele> tuareg didn't handle "missing" ';;' for me
<mellum> steele: works fine for me
<emu> anyway
<steele> caml-mode can send the expression you're on to the toplevel
<emu> um, can you curry arguments with 'function'?
<emu> so can tuareg-mode
<steele> without needing ';;' to see where it ends
<steele> if tuareg handles that too, maybe i'll take another look at it
<mellum> steele: Oh, I thought you were talking about indentation
<emu> just worked for me
<emu> let sum = 1C-x C-e
<mellum> I've never used interactive features. I code for three hours, then I compile :)
<emu> interactive features are really handy
<emu> now back to function =)
<emu> can you do let foo = function x y -> ..
<mellum> emu: no
<Riastradh> let foo = fun x y -> ...
<emu> argh, what if i want to pattern match on multiple clauses with multiple args?
<Riastradh> function can match but not curry; fun can curry but not match.
<Riastradh> Use 'match'.
<emu> whatever happened to convenience! =)
* Riastradh points over there.
<emu> so I have to do something like match (a,b) with (..,..) -> ..?
<Riastradh> Yes.
Smerdyakov has joined #ocaml
<emu> hey Smerdyakov
<mrvn> emu: function a -> function b ->
<Smerdyakov> Oh yeah?
Smerdyakov has quit [Client Quit]
<emu> haha
<emu> yah i was just thinking of him
<emu> i knew he'd be saying ``haha this is why you should use SML''
<Riastradh> SML doesn't have multiparameter pattern matching either.
<emu> sure it does
<Riastradh> Maybe with 'fun' to define functions but not with 'fn'.
<emu> oh yeah
<emu> well you use fun to define functions =)
<whee> oh, nuts
<whee> I love having to redesign things due to missing half of the specs
<whee> specs I wrote myself, too :)
<Riastradh> Haha.
<emu> btw, is there a built-in function like 'complement' ?
<emu> let complement f x = (not (f x));;
<whee> yes, not (f x) :)
<emu> that's not what that does
<emu> generally the usage is (complement one_argument_predicate)
<whee> thats what it looks like you typed, heh
<emu> which returns a function that is the complement of the predicate
<emu> not a big deal
* emu notes that tuareg-mode does not handle unparentesized tuples split over a linebreak gracefully
<emu> at least, in a let expression
<emu> let binding form to be specific
<Riastradh> So parenthesise them, duh!
<emu> =)
<emu> was just testin shit out
Smerdyakov has joined #ocaml
<emu> what are the technical reasons that constructors with arguments are not values?
<mrvn> emu: unparentesized tuples are BAD[tm] :)
<mrvn> emu: A constructor with arguments is a value.
<mellum> One could have made "Foo" equivalent to "fun x -> Foo x", though.
<mrvn> type foo = Foo of int;;
<mrvn> # Foo 1;;
<mrvn> - : foo = Foo 1
<mrvn> mellum: Could be hard on the pattern matching.
<mellum> mrvn: Hm.
<mrvn> type foo = Foo of int*int;;
<mrvn> let foo1 = Foo 1;;
<mrvn> let bla = let bar = function Foo x -> Foo x 1 in bar foo1;;
<mrvn> mellum: That should work then in some way.
<mellum> mrvn: there's an online Skat game that claims to be cheating proof, BTW
<mrvn> One could have made "Foo" equivalent to "fun x -> Foo x" except for pattern matching purposes.
<emu> SML allows that
<emu> datatype foo = Foo of int; Foo evalutes to int -> foo
<emu> obviously you can do (fun x -> Foo x)
<emu> but.. whatever
<emu> I don't think it's an issue with value-restriction..
<mrvn> emu: But you can't match it.
<mrvn> I thinks its so that "Foo x" can be taken as a const for matches.
<emu> you can match constructors of any kind in SML
<mrvn> emu: even partially?
<mrvn> sml has currified constructors?
<emu> Foo (a,_,b) ?
<emu> hrm, currying..
<emu> that might be it
<emu> i don't think so
<mrvn> Foo (a,_,b) is fully applied, just with a "don't care" term
<mrvn> The revised ocaml syntax has curriefied constructors. Might be worth a look what they do with matches.
<emu> I guess not, I don't think there are curried constructors
<emu> constructors can take a single argument
<emu> SML in general makes less use of currying than ocaml seems to
<emu> which is kinda annoying sometimes
<emu> it's not like it doesn't support it..
<steele> i guess SML has better optimisations for tuple allocation and ocaml for currying
<emu> SML is a piece of paper =)
engstad has joined #ocaml
<engstad> What is a type '_a, (i.e. not 'a).
<emu> a one-shot polymorphic type
<mrvn> engstad: its something but not anything
<emu> it becomes something when used
<whee> haha
* emu hopes he has that right
<mrvn> engstad: the first time you use it '_a gets fixed to that type.
<engstad> Hmm... ok.
<engstad> So, it is not (exists a. a)?
shapr has joined #ocaml
<engstad> No?
<shapr> depends on the question.
<engstad> Well, I'm coming from the Haskell world, and I don't quite understand what '_a means.
<Riastradh> Example: ('_a,'_b) Hashtbl.t (* the type of a hash table that doesn't have any elements *)
<engstad> Ok.
<Riastradh> As soon as you put a key and value into that hash table, the type turns into something else, not ('_a, '_b) Hashtbl.t.
<mellum> You can only have these types in the interpreter, I think
<Riastradh> i.e., if you put an int for a key and a string for a value, it would become: (int, string) Hashtbl.t
<engstad> So, in a way, '_a === (exists a . a)
<engstad> See, on the mailing list, the example: let i x = x in (i i);; was given.
<engstad> This gives the type: '_a -> '_a
<engstad> In Haskell, it gives the type: a->a
<Riastradh> Yeah, Haskell is much cooler.
* Riastradh dives for cover.
<engstad> ;-)
<engstad> So, I am trying to understand why Ocaml gives it an existensial type.
<Riastradh> That means that once the function is applied, its type will always be <the type of the value it was applied> -> <that same type>.
<Riastradh> I dunno.
* Riastradh doesn't know OCaml well enough to say.
* emu wonders what the point of the ocaml object system is
<emu> what does it do that modules don't?
<engstad> emu: academic adventure, buzzwordism?
* emu thinks it is the latter
<engstad> actually, it does have some uses.
<mrvn> polymorphism
<engstad> I think I get it. Because Ocaml isn't lazy, it has to provide "code" for the function: let i2 = let i x = x in (i i);;
<Riastradh> A different type of polymorphism than type parameters.
<engstad> It can't make "many" functions of that type, it can only make one.
<engstad> So, that's why it is '_a -> '_a.
<engstad> emu: What you are asking is really a difficult question. The question is "How should one develop software?" And there's two different schools of thought.
<emu> no no
<emu> I mean
<emu> the class system seems to follow the module system a lot
<engstad> Well, because of typing, one has to be pretty strict.
<engstad> Also, remember that the runtime has no concept of types (like in C++ even).
<emu> C++ has RTTI now. but lets not get into that.
<emu> still
<emu> is there a usage of the "object system" that isn't just as well done by the module system?
<steele> emu: there are some slides about objects vs classes in ocaml: http://pauillac.inria.fr/~xleroy/talks/icfp99.ps.gz
<mrvn> emu: some polymorphism.
<Riastradh> You can't 'submodule' a module.
<Riastradh> Whereas you can 'subclass' a class.
<engstad> The main problem with the OO system in ocaml I think is the lack of dynamic types, and the row-polymorphism.
<Riastradh> Thus, classes can inherit and override behaviour, while you can't do that with modules.
<emu> modules can include