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
<Riastradh> Yes, but it isn't quite the same thing: if you have a 2D point module with type 't' that describes 2D points, and a 3D point that includes the 2D points and has a type 't' that describes 3D points, are 3D points still 2D points? Can you call a function 'getPointX' on 3D points if it was originally defined on 2D points?
<emu> have a functor like MakePointOperations
<Riastradh> Wouldn't it just be easier to have a class?
<emu> module 3DPointOperations = MakePointOperations (3DPoint)
lament has joined #ocaml
asqui has quit [Read error: 54 (Connection reset by peer)]
asqui has joined #ocaml
emu_ has joined #ocaml
emu has quit [Read error: 60 (Operation timed out)]
skylan has quit [Read error: 60 (Operation timed out)]
skylan has joined #ocaml
async_ has quit [Read error: 60 (Operation timed out)]
async has joined #ocaml
mattam has quit [leguin.freenode.net irc.freenode.net]
mattam has joined #ocaml
emu_ is now known as emu
mattam has quit [Read error: 110 (Connection timed out)]
shapr has left #ocaml []
adamc has joined #ocaml
adamc has left #ocaml []
<mrvn> emu: some polymorphism.mellum: ping
<mrvn> mellum: ping
Kinners has joined #ocaml
<pattern_> Str.string_match ( Str.regexp "\\(.+\\)," ) line 0
<pattern_> ocaml tells me that str.string_match "is applied to too many arguments"
<pattern_> why? if the docs say it should be: regexp -> string -> int -> bool = "str_string_match"
<whee> looks good to me
<whee> I suggest you'll find the answer on the next line
<pattern_> ahh :)
<pattern_> stupid semicolons
<whee> whatever's on the next line is also being passed to string_match
<whee> heh
<pattern_> i'm just confused by the inconsistent use of semicolons in ocaml
<pattern_> some lines have them, some not
<whee> they're only used when dealing with sequences
<pattern_> it sucks
<whee> either something between begin and end, or in a do {... } block
<pattern_> now, for the same line, i'm getting "Warning: this expression should have type unit."
<pattern_> how can i just throw away the result of that line?
<whee> why would you want to?
<pattern_> do i need to do a "let x ="?'
<whee> # ignore;
<whee> - : 'a -> unit = <fun>
<pattern_> cool :)
<pattern_> i'm going to ignore it because i'll be using Str.match_group
<whee> yes, but why do that match at all if you're going to ignore it
<pattern_> that uses the results of the last Str.string_match
<pattern_> but it doesn't need to be passed those results as an argument
<whee> you still probably want to check if it matched at all
<pattern_> good point
<pattern_> before i start on that, i'm getting a linking error
<pattern_> Error while linking read-data.cmo: Reference to undefined global `Str'
<pattern_> how do i link in this module?
<pattern_> -lStr ?
<whee> you need to include str.cma when doing the final linking
<pattern_> ok... don't know how to do that.. but i'll dig in to the docs and read up on this rather important aspect of the language :)
<pattern_> gotta run now... bbl
<whee> just add it to the command line
<pattern_> btw, thanks, whee!
<mrvn> *freu* my pfc-11 entry seems to be ready for release.
skylan has quit [Read error: 60 (Operation timed out)]
skylan has joined #ocaml
<pattern_> i have a list of strings which i'm trying to concatenate in to a comma-delimited string, so i tried fold_right:
<pattern_> let comma first_field second_field =
<pattern_> "," ^ first_field ^ second_field
<pattern_> let parse_fields fields =
<pattern_> print_string ( List.fold_right comma fields "" )
<pattern_> ("fields" is my list of strings) ...and it's working, except that i have an extra comma at the head of the resulting string
<pattern_> is there a more efficient/idiomatic way to do this? or am i going to have to lop the comma off the head of the list manually in a post-processing step?
<mrvn> pattern_: String.concat "," string_list
<pattern_> ahhh :)
<pattern_> i knew there must be something
<mrvn> Allways read the Modules docs for such functions
<pattern_> i'll use String.concat, then... but how would i do it if it didn't exist?
<pattern_> yes, i was looking in the "str" module... but didn't check the "string" module
<pattern_> and i looked in the "list" module too
<mrvn> let rec loop = function [] -> "" | x::[] -> x | x::xs -> x ^ "," ^ (loop xs)
<mrvn> Or better: sum up the number of strings - 1 and the length of each string. Create a big string of that size.
<pattern_> cool :)
<mrvn> Then copy all strings into the big strings with "," inbetween
<pattern_> i can also probably look in the source of the String module
<mrvn> Do that and tell us how they did it.
<pattern_> i will
<pattern_> but i have a question about your 2nd solution
<pattern_> you'd have to also add in the number of commas to that total, right? and then you'd still be stuck with handling the extra comma, right?
<pattern_> oh, nevermind... the number of strings - 1 is the number of commas
<mrvn> yep
<pattern_> hmmm... String.concat is a little verbose: http://www.rafb.net/paste/results/we475723.html
Kinners has left #ocaml []
<pattern_> i like your solution, mrvn... a pattern for each of the corner cases, and recursion on the rest
mattam has joined #ocaml
skylan has quit ["O_O"]
foxen has joined #ocaml
foxen5 has quit [Read error: 104 (Connection reset by peer)]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
skylan has joined #ocaml
<pattern_> in the code that calls my function "parse_file" i get a compilation error: "This expression has type unit but is here used with type day list list"
<pattern_> let parse_file filename =
<pattern_> let input_file = open_in filename in
<pattern_> let days = parse_channel input_file in
<pattern_> close_in input_file ;;
<pattern_> now, parse_file should be returning a unit, because close_in returns a unit, right?
<pattern_> but it looks like parse_file is returning "day list list", which is the return value of parse_channel... why?
<pattern_> i think i may have figured it out: the problem isn't really with parse_file, but with another line that calls parse_channel
whee has quit ["Leaving"]
<pattern_> though i'm not sure, because i'm now getting syntax errors elsewhere :(
<pattern_> here is something else i am puzzled by:
<pattern_> let foo = "a" in
<pattern_> if foo = "a" then begin
<pattern_> let baz = "b"
<pattern_> print_newline ()
<pattern_> end
<pattern_> this gives me a syntax error, but if i omit the "let baz" line, it compiles fine... it seems like i can't use "let" in a begin ... end construct
<pattern_> is that right?
<pattern_> hmm... think i figured it out: the "let baz" line needs an "in"
rox has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
TachYon26 has joined #ocaml
xkb has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
smkl has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
rox has joined #ocaml
smkl has joined #ocaml
mellum has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
mellum has joined #ocaml
emu has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
emu has joined #ocaml
Kinners has joined #ocaml
Yurik has joined #ocaml
mellum has quit [Read error: 110 (Connection timed out)]
mellum has joined #ocaml
TachYon26 has quit [Remote closed the connection]
xxd_ has quit ["ircII EPIC4-1.1.10 -- Are we there yet?"]
Yurik has quit [Read error: 104 (Connection reset by peer)]
xxd_ has joined #ocaml
Kinners has left #ocaml []
jcore has joined #ocaml
<palomer> when I do List.fold_right insert ls.l { l = [];ord_fn = ls.ord.fn;is_in_order = true} how does ocaml know how to iterate through that type?
<mellum> palomer: I don't think that would work at all
<palomer> it's the code at oreilly's
<palomer> ah wait, nm
<palomer> I get it
<palomer> ocaml is twisting my brain!
<pattern_> isn't it great? :)
<mellum> Fold rules.
<mellum> (although fold_right should be avoided)
<palomer> really?
<palomer> why?
<mellum> Because it's not tail recursive.
<palomer> so it's slow?
<palomer> gotcha
<palomer> btw what does type word = string mean?
<mellum> It also takes stack memory
<palomer> I've only seen consructors and records, and that looks like neither
<mellum> palomer: it introduces a new type, which is in this case just an alias for string
<mellum> like typedef in C
<palomer> so each time ocaml sees a string it'll thing it's a word?
<mellum> Huh? no.
<palomer> s/thing/think
<palomer> so whats the use of typedefing a type?
<mellum> You can define functions that take and return "word". Then later you can change the type to, say, char array, without breaking the interface.
<palomer> but if I hadn't typedef'd, I would have returned a string instead
<palomer> which can also type to a char array
<palomer> unless you have things like (a:word), I don't see the use
<mellum> right.
<palomer> man ocaml is huge
<palomer> it's bigger than c++!
<palomer> whats the norm when specifying parameters?
<palomer> elements firsts in the list or lists firsts?
<palomer> what about functions, do they go before everyone else?
<mellum> Heh, Ocaml certainly isn't as huge as C++
<mellum> The C++ standard has 776 pages
<mellum> Arguments are usually orderd so currying is more useful
<palomer> currying is parameter order dependant?
<mellum> So the more fundamental, less changing arguments come first
<palomer> let x = fun a b c -> match c with...
<mellum> sure
<palomer> so functions functions first, lists second. and elements third
<palomer> gotcha
<palomer> hrm, why is bad style to do (a,b) when a = b ... | (a,b) when a<b ... | (a,b) when b > a?
<mellum> An if yould seem clearer here
<palomer> hrm?
<palomer> the compiler is telling me it's bad style
<palomer> Warning: Bad style, all clauses in this pattern-matching are guarded.
<palomer> ...................match (a,b) with
<palomer> (a,b) when a = b -> b
<palomer> | (a,b) when a < b -> a
<palomer> | (a,b) when a > b -> b+a..
<palomer> val x : int -> int -> int = <fun>
<pattern_> why do i get a syntax error on line 7 here -> http://www.rafb.net/paste/results/WF770076.html
<emu> there's an ocaml standard?
<Riastradh> http://www.ocaml.org/ -> The O'Caml Manual
<Riastradh> Or something like that.
Smerdyakov has quit []
<mrvn> Unbound value input_file
<palomer> how do I avoid super nested if statements?
<palomer> seems that I have no choice in ocaml
<mrvn> palomer: (a=0)&&(b=0) instead of if (a=0) then if (b=0) ...
<mrvn> or subfunctions
<Riastradh> I don't see why that's 'bad style.'
<palomer> isn't there a case construct or something
<palomer> like the when statements that's a bad style:o
<palomer> that would make my code much more readable
<palomer> mrvn: will the compiler optimize it?
<Riastradh> There's nothing like a 'cond' expression in OCaml except for 'match,' so it would be your only choice if you didn't use multitudes of 'if' expressions, which I would say are worse style.
<emu> eh oh, not quite a standard =)
<palomer> hrm
<Riastradh> emu, it's as close to a standard as there is.
<palomer> the reason my if statements are super nested is because I'm forced to return something in my else statement
<palomer> it won't let me just follow through
<palomer> time for a competition!
<palomer> who can code the most elegant binary search, heres my entry
<palomer> let bin_search = fun ls elem ->
<palomer> let rec bin_search_rec = fun start finish -> match (start,finish,(start+finish)/2) with
<palomer> (s,f,_) when s = f - 1 -> if nth ls s = elem then true else false
<palomer> | (s,f,_) when s > f - 1 -> false
<palomer> | (s,f,mid) when s < f - 1 && nth ls mid = elem -> true
<palomer> | (s,f,mid) when s < f - 1 && nth ls mid < elem -> bin_search_rec mid f
<palomer> | (s,_,mid) -> bin_search_rec s mid
<palomer> in
<palomer> bin_search_rec 0 (list_length ls);;
<palomer> I don't know the ocaml std function for list_length or nth so I made my own
<palomer> which means my function runs in n * ln n
<palomer> but don't let that bother you:o
<emu> wha
<emu> why are you using anything like nth
<emu> arrays!
<emu> List.length;;
<emu> # (Array.make 3 1).(1);;
<mattam> dichotomic search is binary search ?
<palomer> binary search is a kind of dichotomic search, though others exist im sure
<palomer> so is my binary searh pretty?
<palomer> oc can it be done in a more elegant fashion?
<emu> someone should fix ocaml.org so that it redirects to www.ocaml.org
<mattam> yes, pretty, although you could have 'let bin_search ls elem = ...' and 'when s = f - 1 -> nth ls s = elem'
<mattam> also using arrays to reduce time complexity to ln n
<palomer> binary search on lists is pretty useless:o
Smerdyakov has joined #ocaml
whee has joined #ocaml
mrvn_ has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
xxd_ has quit ["EOF"]
xxd has joined #ocaml
mrvn_ is now known as mrvn
<palomer> hrm
TimFreeman has joined #ocaml
<palomer> hrm
<palomer> I'm having trouble understanding recursive types
<whee> like?
<palomer> type int_or_char_list =
<palomer> Nil
<palomer> | Int_cons of int * int_or_char_list
<palomer> | Char_cons of char * int_or_char_list ;;
<palomer> Int_cons is a constructor...
<palomer> hrm, I guess that makes sense...
<palomer> Seems so different though
<palomer> why would you want to do that!?
<whee> as an example, heh
<whee> you can get a list of ints or chars with something like that
<Riastradh> A variant of it would be useful in the 'Banana' protocol.
<palomer> is it really a list?
<palomer> looks like a super tuple
<Riastradh> Yes, it is really a list: it is a collection of linked pairs.
<mrvn> palomer: lists are tuples of 'a * 'a list
<mrvn> palomer: or []
<palomer> so it would be let 'a list = Nil | 'a * 'a list ?
<whee> need a constructor for that second part
<mrvn> type 'a list = Nil | Cons of 'a * 'a list
<Riastradh> Pseudo-code: type 'a list = [] | 'a :: 'a list
<palomer> and can constructors do anymore then give the ability to differentiate between elements of a type?
<palomer> or help in matching
<mrvn> palomer: The Constructor is there to differentiate. It becomes an int in the implementation.
TimFreeman has left #ocaml []
<mrvn> In C that would be like enum list_type = {NIL, CONS}; struct 'a list { list_type type; ['a val; 'a *next;] }, let [] only beeing present for CONS
<mrvn> You have to allays use the constructor so ocaml knows that to fill in or match against for the list_type
<palomer> gotcha
<palomer> so constructors are there for matching
* emu masters functors!
<emu> you can compare C's union type as a very unsafe version of ML's sum/disjoint types
<emu> plus you have to implement tagging yourself in a union
<emu> or just assume you know what you're doing
<emu> (your program won't, and will crash =)
<emu> now to take over the world
<emu> so now i'm supposed to do something interesting...
<whee> heh
<palomer> functors in c++
<palomer> ?
<palomer> or functors in mathematics?
<palomer> so lemme get this straight, lists are pairs of pairs of pairs of pairs... ?
<emu> functors in OCAML
<Riastradh> Not necessarily.
<emu> but I was talking about something different the next line
<palomer> yhea
<Riastradh> X lists are pairs of X and X lists, which are pairs of X and X lists, etc., or nil.
<palomer> ohhh
<emu> lists are built up out of little structures named conses which have a place for an item and a place for the "next" cons
<palomer> so they're pairs of pairs of pairs
<palomer> of pairs
<palomer> ...
<Riastradh> No.
<palomer> lists are pairs of X and X lists, and X lists are pairs of X lists
<Riastradh> 'Pairs of pairs' indicates, where 'Pair' is a function that creates a pair of its two arguments, 'Pair(<some pair>, <some other pair>)'.
<palomer> ah
<emu> (1 . (2 . (3 . ()))) == 1 :: (2 :: (3 :: []))
<palomer> I was talking in english!
<Riastradh> Note the 'pairs of X _and_ X lists.'
<emu> (Pair 1 (Pair 2 (Pair 3 [])))
<palomer> thats a pair of a pair of a pair
<palomer> Pair 3, [] is a pair
<emu> type 'a PAIR = First of 'a | Rest of 'a PAIR
<Riastradh> Uh, no. That's a pair of an integer and a pair.
<Riastradh> A pair of an integer _AND_ a pair.
<palomer> ah yes ,there is a distinction
<emu> oops
* emu goes disjoint
<palomer> does that mean I can pass 2,(3,(4,Nil)) insead of a list if I wish to?
<emu> you use 2 :: 3 :: 4 :: []
<emu> in OCAML
<Riastradh> Sure, that has a type: int * (int * (int * 'a list))
<emu> alternatively [2;3;4]
<Riastradh> It's rather silly when compared to lists, though.
<emu> oh wait, are we teaching him about tuples or lists?
<emu> hehe
<palomer> the equivalence of it
<emu> there is no equivalence
<emu> they are different data types
<palomer> a list is a pair
<emu> this gets a little confusing due to some terminology conflation
<emu> some people call conses pairs
<emu> other people call 2-element tuples pairs
<emu> they aren't the same
<palomer> yhea, ocaml won't let me pass a pair to a function that needs a list
<emu> stop using the word pair
<emu> and just use 'cons' or 'tuple', for clarity
<emu> =)
<palomer> ok
<emu> so which do you mean?
<palomer> from now on pair=2 element tuple
<emu> so (1, 2)
<palomer> yes
<whee> marklar: marklar use marklar for marklar and marklar to avoid marklar with marklar and marklar.
<emu> obviously
<emu> tuples are not lists
<palomer> but a list is a tuple!
<emu> no it is NOT
<emu> not in Ocaml
<palomer> ah
<palomer> gotcha
<whee> you can represent a list using a bunch of tuples, but they're not that way here
<palomer> so it's a built in
<emu> lists are a built-in type
<emu> [] is a list
<emu> it is the empty list
<emu> 1 :: [] is a list
<emu> it is a list with one element
<emu> now keep building from there =)
<palomer> ahh
<emu> x :: a_list is a list
<emu> if x has type t, then a_list must have type t list
<palomer> gotcha
<palomer> so we can't define a list type as such
<emu> well
<palomer> type 'a list = Nil | 'a * 'a list;;
<emu> you can make your own 'list type' but it won't inter-operate with the normal lists
<emu> not quite
<emu> type 'a list = Nil | Cons of 'a * 'a list;;
<palomer> ah yes
<emu> need to have a constructor for disjoint types
<palomer> Disjoint types?
<emu> yes
<palomer> hrm?
<emu> because a variable of a disjoint type can only have one of the possibilities at any one time
<emu> it's either Nil, or it's Cons ..., not both
<palomer> ahh
<palomer> gotcha
<palomer> so that's what constructors do!!
<palomer> they should change the name to differentiators
<palomer> what would happen if we left out the constructor?
<emu> they're also called variant types I think too
<emu> it wouldn't work
<whee> yes, those things are called variants
<palomer> from now on they're variants
<palomer> no more constructor pishposh
<emu> seems that OCAML manual refers to them as variant types
<palomer> stupid oreilly!
<whee> there's also polymorphic variants, which are neat
<palomer> eeek
<palomer> polymorphism!
<palomer> does polymorphism incure a performance hit?
<whee> it can
<whee> but the compiler handles most of that, so not always
<mrvn> For example if you have a game with fileds of NIL, X and O and the player `X and `O
<mrvn> palomer: polymorphism doesn't cost any time. But non polymorphic methods could be implemented fasterby making them static
<palomer> ah, gotcha
<emu> all is resolved at compile-time anyway
<emu> polymorphism is parametric only in ML
<mrvn> class foo = object method foo = () end
<mrvn> If you call foo#foo it has to lookup the foo method in the virtual table for the object. In C++ the function would be static and you would just jump to the address.
<mrvn> emu: all oject methods are resolved at runtime thorugh the virtual table.
<palomer> ahh, so things aren't static by default
<palomer> mrvn: how does the comiler know which method to call?
<whee> mrvn: emu's referring to a different polymorphism
<mrvn> afaik ocaml doesn't have a static keyword. Could be that making methods private makes them static too.
det has joined #ocaml
<palomer> what exactly is ()?
<emu> unit
<emu> the only value of the unit type
<palomer> is that like void?
<palomer> or is it like Object:o
det has quit [Client Quit]
<Riastradh> Yes, it's what OCaml uses in the place of C's 'void.'
<mrvn> Its more like NULL
<mrvn> Its a value, not a type
<palomer> NULL is an int
<mrvn> type unit = ()
<palomer> it's 0
<mrvn> same a type bla = Foo
<palomer> hrm?
<steele> i would say the equivalent of NULL is None in the option type
<mrvn> yeah, C++ doesn't have ()
<Riastradh> Where C would return void, OCaml would return unit.
<mrvn> () is the void in int foo(void)
<Riastradh> Where C functions would take a void number of arguments, OCaml functions would take a unit argument.
<palomer> so what does let () = print_string "BRAVO" mean?
<emu> but unit has one value
<emu> whereas a true void 0-type would not
<mrvn> () is used to basically say "this is a function that takes no parameters" or "returns no value"
<steele> you don't need it in c because returning values is explicit
<emu> but it is used when nothing else is needed, yes
<Riastradh> Yes, emu, that's why I said 'what OCaml uses in the place of,' not 'OCaml's "void."'
<emu> and one of my speakers died. argh.
<palomer> why not just do print_string "BRAVO"?
<mrvn> palomer: same as type foo = Foo let foo () = Foo let Foo = foo ()
<Riastradh> 'let () = print_string "BRAVO"' shouldn't work.
<mrvn> Riastradh: why? print_string "BRAVO" is evaluated and the result matched against ()
<palomer> so every value returned has to be matched?
<Riastradh> Oh, I suppose it does...hm.
<emu> no, you could simply let it go
<palomer> so why didn't they?
<mrvn> palomer: theoretically yes. In praxis thats mostly a NOP.
<whee> the compiler will give a warning if something returns something other than unit and you ignore it
<emu> who is they?
<emu> get your ocaml toplevel running now, and type print_string "HI";;
<mrvn> # print_string "BRAVO";;
<mrvn> BRAVO- : unit = ()
<mrvn> # let () = print_string "BRAVO";;
<mrvn> BRAVO#
<mrvn> emu: See the difference?
<emu> why u telling me?
<simon-> are unions generally used in OCaml?
<mrvn> just so
<mrvn> simon-: all the time and not at all
<steele> palomer: some people use it because they like to make impure parts of the code stand out
<palomer> is it possible to have a sequence of expressions? like lisp's progn?
<simon-> mrvn, I'm trying to compare it to C where unions are often not used at all.
<mrvn> simon-: type Foo = Nil | Bla of int;; Nil would be size 4, Bla size 8
<mrvn> simon-: In C++ both would be size 8
<steele> palomer: that's what you use ';' for or do { ..; ..} in revised syntax
<palomer> ahh
<palomer> how come I don't see it used much
<emu> cuz ocaml ppl like to program 'functionally'
<emu> if you see ; used, it's probably not functional
<mrvn> palomer: let _ = a in let _ = b in let _ = c in ===> a; b; c; (if they return unit)
<mellum> emu: it's definitely not functional :)
<mrvn> emu: ; is less to type than let () = or let _ =
<palomer> ok, so using do {...;...} is a big nono
<emu> mrvn: when did I ask anythng?
<palomer> so in functional programming you're encouraged to split everything up in functions
<mrvn> palomer: sometimes its just easier to do
<emu> mrvn: do you mean to tell palomer this?
<mrvn> 23:12 < emu> if you see ; used, it's probably not functional
<mrvn> emu: just commenting
<emu> palomer: basically, and you would never have to use ; because you always compose operations, or make new bindings with let
<palomer> this is a totally different way of thinking:o
<steele> palomer: read http://www.bagley.org/~doug/ocaml/Notes/okoans.shtml The Koan of Side Effects =)
<palomer> HOF
<palomer> but algorithms need for loops and such
<palomer> it's natural!
<whee> no, they don't 'need' for loops
<emu> iteration is a special case of recursion
<whee> they need repetition, perhaps, but that's easily done with recursion
<emu> where the recursive call is the last thing done
<emu> this is referred to as 'tail-recursion' and any compiler worth its salt can optimize this so that new stack frames are NOT generated
<emu> essentially, all iteration constructs are syntactic sugar
<Riastradh> And thus unnecessary in a language with macros, or in the case of OCaml, a decent preprocessor.
<emu> i thought camlp4 was deprecated, what happened?
<whee> emu: daniel left the project, but it's being maintained by the otherse now
<Riastradh> Camlp4 is deprecated? When did this happen?
<whee> others, even
<whee> it was never deprecated
<mellum> Hm, I've never really needed it...
<mellum> Might be nice, but I don't see why it might be required
<whee> I used revised syntax for everything, and have my own extensions for little things
<Riastradh> More syntactic sugar.
* emu wants to know where this student of Garrigue ate okonomiyaki. or perhaps they were not in the states..
<Riastradh> List comprehensions, for example, could probably be implemented with Camlp4.
<whee> someone already has, but that was a while ago
<whee> I don't know what happened to that code :\
<mellum> Well, such stuff is nice, but makes your program harder to read for outsiders.
<mellum> But it certainly is great for job security :)
<emu> syntax extensions should be made in order to make code clearer
<Riastradh> Can you imagine trying to emulate list comprehensions by just calling functions?
<emu> i like the Koan about Lazy Evaluation
<whee> a syntax extension is no different than coming up with some other design pattern
<whee> as long as it's obvious what it does, it's no problem for a programmer picking up teh code
<emu> the static typing one is dumb though
<palomer> if I was to make a cross platform graphical whizz-bang text editor, which library set would I use for the graphical part?
<emu> Markus should've picked up a gun and shot himself in the foot
<emu> thereby teaching both of them a lesson
<whee> palomer: gtk, qt, whatever
<palomer> which one is better itegrated with ocaml?
<palomer> which conforms better to the ocaml philosophy
<whee> neither
<whee> they're just bindings that you can go grab somewhere, heh
<steele> are there even qt bindings for ocaml?
<palomer> so the interface is the same?
<whee> of course not
<palomer> I keep hearing about how qt is so nice to program with
<whee> meh, and Idon't see qt bindings anyway
<whee> thought there were :\
<palomer> so it's gtk?
<whee> look around here: http://caml.inria.fr/humps/index.html
<jcore> is anyone porting O'Caml to MacOS Classic?
<whee> jcore: I sure hope not
<jcore> :(
<whee> classic is long gone
<jcore> I still use it though
<Riastradh> Weirdo!
<whee> indeed
<palomer> ocamldoc looks nice
<palomer> looks very nice:o!!
<palomer> con you add doc strings to your let bindings?
<palomer> or would the performance hit be too great:o
<steele> most of the time you add them to your interface (mli) files
<palomer> ahh, I'll have to learn about that...
<palomer> ocaml is huge!!
<whee> ocamldoc reads comments from files
<whee> which don't do anything to performance
<palomer> I mean being able to retrieve documentation at run time
<emu> ahahaha
<emu> I found a bug in the koans!!!
<emu> in the answer for Imperative/Declarative, the second qsort function, uses an undefined variable h
* emu skips around
<Riastradh> palomer, what is 'huge' about OCaml?
<emu> camels are huge
<emu> you don't want to be kicked by one either
<palomer> all this stuff!
<palomer> imperative object oriented functional
<emu> aww
<emu> poor palomer
<whee> haha
<palomer> I'm surprised they didn't include logical:o
<emu> he feels if he doesn't use all these features in a 5 line program, he's coding wrong
<whee> go learn that, and complain that ocaml contains too many paradigms :)
<palomer> oz is freaky
<palomer> hrm
<palomer> simplicity is always best!
<whee> the idea is to use the design that fits the problem best
<emu> tell me palomer
<emu> do you want to use a language that you have to do everything yourself in?
<emu> or would you prefer to have features available when you need them?
<Riastradh> Or a language where the semantics are simple, but with a huge library?
<Riastradh> Er, a language that is by itself very simple, rather.
<emu> what's a library?
<emu> =)
<Riastradh> Bloody Common Lisp programmer.
<emu> hehehe
<palomer> :o
<emu> look, just cuz we can extend the language with more ease than C programmers can write libraries...
lament has joined #ocaml
<emu> no reason to get all prickly :-P
<Riastradh> 'Extend the language?' You mean add more to the standard?
<Riastradh> Or do you mean just make use of a very extensible language?
<emu> well
<emu> since you can extend the language in a standard way...
<Riastradh> i.e., one with a full MOP, for example.
<emu> you don't need MOP to have extensibility
<emu> it just would be nice if that was standard too, sigh
<Riastradh> Yes, but it helps.
<emu> in any case
<palomer> MOP? HOF?
<emu> the main point was that you only use what you need
<Riastradh> MOP = MetaObject Protocol
<palomer> hrm
<Riastradh> In CLOS, classes are really instances of the class 'standard-class,' which is an instance of itself.
<emu> so a large language is no detriment to use
<Riastradh> You can subclass 'standard-class' to extend CLOS.
<palomer> isn't ml the meta language, and doesn't that imply it has everything meta?
<emu> palomer: no, it was the meta language of some odd theorem prover way back
<Riastradh> No, it was just designed to implement compilers.
<palomer> oh
<emu> the name stuck
<palomer> a mathemitician actually proved his theorems in ml?
<palomer> Riastradh: so it's good for compiler design?
<Riastradh> palomer, the OCaml compiler is, last I checked, written in OCaml.
<emu> most decent compilers are self-hosted
<palomer> Riastradh: whoa, no wonder it kicks ass
<emu> admittedly, I wouldn't want to write a C compiler in C
<palomer> how does it boot strap?
<emu> but there are people who do..
<emu> a couple of ways
<palomer> gcc is written in C
<emu> i don't remember how ocaml does it
<emu> i think ocaml builds a mini-compiler which compilers the rest
<Riastradh> There's probably a minimal binary distribution, or a tiny compiler written in C.
<emu> I seem to recall 3 stages
<steele> the bytecode interpreter is written in C
<emu> I once compiled the debian source package
<emu> gcc bootstraps off of the host's C compiler by building a mini-C compiler with that
<palomer> hrm, there should be a single compilable programming language and all the other programming languages just transform themselves into that programming language to be compiled
<emu> cmucl bootstraps off of prior versions of cmucl. sbcl is attempting to be buildable by any ANSI CL.
<Riastradh> It's called 'assembly language,' except it varies from platform to platform.
<emu> JVM attempted too
<palomer> hrm
<emu> JVM is a piece of crap
<lament> palomer: yes!
<palomer> we should do it in stages
<lament> palomer: there should be one single language
<emu> it does not handle langauges with decent semantics well
<palomer> like have assembly, then c, then all the rest
<lament> the .NET bytecode
<lament> ;)
<emu> .NET bytecode suffers all the same problems because MS ripped off Java without even bothering to improve
<palomer> so that all the optimizations need only be from c to assembly
<steele> palomer: www.cminusminus.org, at least they try that
<emu> implementing call-with-current-continuation on JVM or .NET ... I don't think anyone did it yet.
<Riastradh> call/cc would be rather difficult to implement.
<lament> the obvious solution is to get rid of call/cc
<lament> there is no universal language to which all other languages are easy to compile
<Riastradh> But then you'd have no more cool puzzles like the yin yang puzzle!
<lament> for example, befunge is hard to compile for pretty much everything
<emu> it is?
<palomer> we'll call it common palomer++
<lament> yes, it is
<emu> I thought it was hard to write to
<lament> emu: no, it's easy to write to
<palomer> it'll be the be all end all programming language
<lament> emu: and it's almost impossible to compile
<lament> emu: except by packing the interpreter and the program together in the executable
<emu> =)
<lament> emu: that was the goal of befunge, actually
<palomer> visual common palomer++.net
<emu> nah
<emu> Visual P++.NET
<emu> that's the MSization
<emu> Visual P++ Studio .NET
<emu> Enterprise
xxd has quit ["EOF"]
xxd_ has joined #ocaml
det has joined #ocaml
<det> to access a value of a class must you make a accessor method ?
<Riastradh> Yes.
<det> even from within itself ?
<Riastradh> No.
<mrvn> Riastradh: What about inherited values?
<whee> that'd be a no as well
<Riastradh> I don't know, but apparently whee does.
<whee> well, now I lost track :|
<whee> ocaml has no concept of public/private, right?
<whee> oh, it does. nevermind
<whee> in that case I guess you would need to use the superclass's accessors to get access to its private data
<mrvn> whee: I sure hope so
<mrvn> does ocaml have protected and friend?
<whee> I don't really use the OO things in ocaml much, heh
<det> can ocaml use printf to infer types ?
<mrvn> yes
<det> it seemed to infer a string from: method draw = Printf.printf "I'm a %s foo!\n" color
<det> neat
<mrvn> # Printf.printf "%d";;
<mrvn> - : int -> unit = <fun>
<mrvn> Otherwise it wouldn't be typesave.
<det> so Printf.printf is done at compile time ?
<det> it doesnt actually parse the string at execution ?
<mellum> yes, you can't use a non-constant format string
<mrvn> det: yep. Thats why it must be a const string
<mrvn> a literal
<det> ohh, yay efficiency :)
<det> it seems noone here is really interested in ocaml's OO stuff
<det> if I wanted to write some kind of game where future type could be added (so I couldn't use variants) that supported some kind of "draw" function, OO is the only way to go in ocaml ?
<det> s/type/types/
<det> like keep a bunch of items in a list of different, unknown types, and then "draw" them all
<whee> OO would make sense there
<det> but is it possible to do in any other way ?
<whee> with modules and functors probably
lament has quit [Remote closed the connection]
<det> so, does this look about right http://www.twistedmatrix.com/users/chris/test.ml ?
<det> any (style) hints ?
<det> one more thing, this compiles to 173056 bytes (using opt), is most of that a one-time ocaml overhead (GC etc.. of maybe~150 k) and not that this compiled a huge binary for what there is ?
<whee> yeah, most of that is the basics
<whee> if not all
<det> ahh, thanks
det has quit ["ircII EPIC4-1.1.2 -- Are we there yet?"]
det has joined #ocaml
<det> argh, computer died
<det> is there any way to put all that "basic stuff" in a shared library so I dont have to pay a "binary tax" if I include several binaries with a distribution ?
simon- has quit [Remote closed the connection]
<mrvn> What basic stuff?
<mrvn> and what tax?