vect changed the topic of #ocaml to: OCaml 3.07 ! -- Archive of Caml Weekly News: http://pauillac.inria.fr/~aschmitt/cwn, ICFP'03 http://www.icfpcontest.org/, A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/, A free book: http://cristal.inria.fr/~remy/cours/appsem, Mailing List (best ml ever for any computer language): http://caml.inria.fr/bin/wilma/caml-list
lam has joined #ocaml
polin8 has quit [Read error: 110 (Connection timed out)]
themus_ has joined #ocaml
<Xcalibor> time for bed, see ya tomorrow
Xcalibor has quit ["Terminando cliente"]
buggs is now known as buggs|afk
themus has quit [Read error: 110 (Connection timed out)]
ez4 has quit []
brwill_work is now known as brwill
<jdrake> is there a way to receive input from console that is a single character immediately when it is pressed, not after return is pressed (like input_char does)
arty has joined #ocaml
<jdrake> hola arty
<arty> hello jdrake
<jdrake> how are you doing
<arty> alright. I'm working on a type reflector for camlp4.
<arty> you can do this with it:
<arty> genfun + =
<arty> match ty with
<arty> !> "string -> string -> string" -> ('a ^ 'b)~
<arty> | !> "int -> int -> int" -> ('a + 'b)~
<arty> | !> "float -> float -> float" -> ('a +. 'b)~
<arty> | !> "bool -> bool -> bool" -> ('a || 'b)~
<arty> | _ -> raise BadMatch
<jdrake> mm
<jdrake> what does that do exactly
<arty> It takes type output from the compiler and feeds it back to your camlp4 module. In this case, you can make a generic plus that infers types the right way.
<jdrake> i am only on my second ocaml program :-)
<arty> ahh. sorry.
<arty> Forget you saw this, then. You can break type safety with it.
<jdrake> want to get a laugh at the first version of my first program?
<arty> I won't laugh.
<jdrake> version 2 is the 'riastradhization'
<arty> your style isn't bad.
<jdrake> glad to hear ;)
<arty> CYA, dude (12:45 in chicago)
arty has quit ["arty has no reason"]
<async> fuck midterms
* jdrake doesn't have to worry of midterms
clog has quit [^C]
clog has joined #ocaml
phubuh_ has quit [Read error: 113 (No route to host)]
lus|wazze has quit ["The Ogre philosopher Gnerdel believed the purpose of life was to live as high on the food chain as possible. She refused to e]
Demitar has joined #ocaml
mattam_ has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
two-face has joined #ocaml
two-face has left #ocaml []
buggs|afk is now known as buggs
Demitar has quit [Read error: 60 (Operation timed out)]
Demitar has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]
whiskas has joined #ocaml
<whiskas> howdy
<Maddas> oh
<Maddas> jdrake: are you there?
<Maddas> jdrake: I made a version of that too! :-)
bk_ has joined #ocaml
two-face has joined #ocaml
<two-face> hi
<Maddas> hi
<two-face> ocaml 3.07 ?
<Maddas> doesn't look like it
<Maddas> wow, ocaml 3.06 is over one year back
<two-face> I suspect I've been unsubcribed from the list
<two-face> oh dear, I no longer receive messages from the list
<two-face> i missed what happened yesterday
<Maddas> caml-list?
<two-face> yes
<Maddas> ok, I'll subscribe too then!
<whiskas> I can't seem to understand ocaml :((
<Maddas> how's the volume?
<Maddas> what don't you understand?
<whiskas> everything...
<whiskas> well... the whole functional thing is extremeley baffling
<Maddas> heh.
<Maddas> How are you learning O'Caml?
<whiskas> well
<whiskas> I found a pretty nice tutorial
<Maddas> it doesn't seem to work well :)
<whiskas> yeah
<whiskas> I need a very good, with many examples tutorial to kick off
<whiskas> the I'll find my way
<Maddas> reading the SICP is a good place to learn about FP
<Maddas> although it uses Scheme, not O'Caml
<Maddas> you can try the O'Reilly book
<Maddas> but I really recommend reading the SICP sooner or later anyway :)
<bk_> i found the SICP not very helpful tbh
<Maddas> and the caltech book.pdf is nice for O'Caml, too
<whiskas> SICP?
<Maddas> google :)
<whiskas> aah, ok :)
croesus has joined #ocaml
mellum has joined #ocaml
<mellum> Is there a reason why there's no Hashset? Should I just use a hashtable that maps to unit?
<two-face> say hello to assembly boy
<mellum> hello to assembly boy
<two-face> pfff
<two-face> nevermind :P
<two-face> say hello to the assembly, boy
<mellum> Uhm. Hello.
<two-face> hashset? I don't know
phubuh__ is now known as phubuh_
arty has joined #ocaml
croesus has left #ocaml []
whiskas has quit ["Good bye, blue sky"]
two-face has left #ocaml []
<Maddas> hm, what's wrong with this line? type 'a btree = Leaf of 'a | Node of (btree * btree)
<mellum> of ('a btree * 'a btree)
<Maddas> ah, thanks
<Maddas> stupid mistake ;)
<mellum> Hm. Whoever came up with the idea to use an 'l' suffix to denote an int32 obviously never used one of these stupid Windows fonts where l looks *exactly* like 1
<Maddas> Heh :)
lus|wazze has joined #ocaml
lc has joined #ocaml
arty has left #ocaml []
Demitar has joined #ocaml
Xcalibor has joined #ocaml
<Maddas> hey Xcalibor
<Xcalibor> hiyas :)
<Maddas> been waiting for you ;)
<Xcalibor> really?
<Maddas> yeah :)
<Maddas> didn't you think about how to write an explode function for strings once?
<Xcalibor> how nice of you. thanks :-)
<Xcalibor> Maddas: we did
<Xcalibor> collective channel effort
<Xcalibor> riasthrah di dmost of hte heavystuff, anyway <g>
<Maddas> heh
<Maddas> this looks pretty good to me:
<Maddas> let explode s =
<Maddas> let rec expl i l =
<Maddas> if i < 0 then l else
<Maddas> expl (i - 1) (s.[i] :: l) in
<Xcalibor> wanna see?
<Maddas> expl (String.length s - 1) [];;
<Maddas> sure!
<Xcalibor> 2 sec...
<Xcalibor> okay, ready
<Xcalibor> let fold_right kons knil s =
<Xcalibor> let rec loop knil = function
<Xcalibor> | i when i >= String.length s -> knil
<Xcalibor> | i -> kons (String.get s i) (loop knil (i + 1))
<Xcalibor> in loop knil 0
<Xcalibor> let explode s = fold_right ( fun a b -> a :: b ) [] s
<Maddas> oh, you implemented a fold_right :)
<Xcalibor> yeah
<Xcalibor> it's nice and can go to your personal library ;-)
<Xcalibor> your solution, however, is straightfowrad and nice
TimFreeman has joined #ocaml
TimFreeman has left #ocaml []
<Xcalibor> i like it :)
<Xcalibor> do you have any ideas for an imploding function? ;-)
<Maddas> yes
<Maddas> let implode l =
<Maddas> let result = String.create (List.length l) in
<Maddas> let rec imp i = function
<Maddas> | [] -> result
<Maddas> | c :: l -> result.[i] <- c; imp (i + 1) l in
<Maddas> imp 0 l;;
<Riastradh> Bah, use fold, damnit!
<Maddas> It's from the O'Caml code collection though ;-)
<Riastradh> let implode l =
<Riastradh> let r = String.create (List.length l) in
<Maddas> Heh :-)
<Riastradh> fold (fun i c -> String.set r i c; i + 1) (List.length l) l
<Riastradh> Er, make that 'i - 1'.
<Maddas> I just stumbled upon it and thought it might be interesting, as you talked about it once.
<Xcalibor> Riastradh: we also made it like this: let implode l =
<Xcalibor> let s = String.create (List.length l) in
<Xcalibor> let rec loop i = function
<Xcalibor> [] -> s
<Xcalibor> | h :: t ->
<Xcalibor> String.set s i h;
<Xcalibor> loop (i + 1) t
<Xcalibor> in loop 0 l
<Riastradh> Er, I probably got something wrong.
<Riastradh> But you should do it with fold anyways.
<Xcalibor> is it fold or List.fold?
<phubuh_> List.fold[lr]
<phubuh_> err, List.fold_(left|right)
<Riastradh> Haskell has fold{l,r}; OCaml has fold_{left,right}; Scheme (well, SRFI 1) has FOLD and FOLD-RIGHT.
<Maddas> and Perl has map!
* Maddas mutters something unimportant
<Maddas> :)
<Riastradh> Perl has anonymous subroutines!
<Maddas> urm..yes
<Riastradh> And closures!
<Xcalibor> yes, of course... perl has full closures, map, and filter in the CORE
<Riastradh> Perl's anonymous subroutines and closures make it infinitely better than PHP or anything.
<Xcalibor> agreed...
<phubuh_> ugh, don't mention PHP again, please
<bk_> and perl is buttugly :p
<Riastradh> You can CPSify code...and then use a Queinnec/CPS style for web programming! TAKE THAT, PHP!
<phubuh_> PHP is probably the ugliest language i've ever seen, not including visual basic
<bk_> :>
<Riastradh> Obviously you haven't seen Malbolge.
* Maddas notes to talk less in feature
<Maddas> future
<Maddas> (what an ugly typo)
<phubuh_> malbolge is beautiful in its own special way. PHP is just ... mediocre.
<Maddas> I should read up on continuations and CPS
<mattam_> just a hack would be closer for PHP
mattam_ is now known as mattam
<Maddas> heh. Thanks, Riastradh
<phubuh_> a mediocre hack :-)
<Maddas> 404
<Riastradh> Oh.
<Xcalibor> perl is not ugly
<mattam> it is
<Maddas> thanks, phubuh_
<Xcalibor> it is not...
<Maddas> Xcalibor: I think it depends a lot on the eye of the viewer
<mattam> perl is a dynamic scripting language where you must identify between types in the code
<Maddas> I find it nice, but I can understand people who don't
<mattam> and the adresses denotations are a mess too
<Xcalibor> mattam: you don't identify types, you signal context...
<Xcalibor> addresses? which addresses?
<mattam> well, that's the same pratically
<Maddas> Contexts are ugly?
<mattam> %$ etc if i remember right
<Maddas> Only two contexts that I can think of, array and scalar
<mattam> i stopped learning when i saw that
<Maddas> Perl 6 will have lot more contexts though.
<Xcalibor> mattam: not quite the same... in Perl 6 it will be a data type identifier... but Perl 5 sigils signal context (either scalar ot list context)
<Maddas> oh, you mean sigils
<mattam> let me check what upset me when i tried to learn it:)
<Maddas> sigils specify return type, but they are broken when used with things other than basic data types
<Maddas> well, broken by design.
<Xcalibor> you do: my $number_of_matches = () = $variable =~ s/(pattern)/substitution/;
<Maddas> you don't need = () =
<Maddas> using a scalar imposes scalar context, an array in scalar context returns the number of elements.
<Xcalibor> not in this case... but it makes clear that you aren't assigning to an empty list
<Xcalibor> :)
<Maddas> heh
<Maddas> would your code even work?
<Xcalibor> my job is coding in perl
<Maddas> cool
<Xcalibor> and has been for the last 18 months
<Xcalibor> yup :-)
* Maddas plays around with the = () = thing
<Xcalibor> :-)
<Maddas> Heh. I thought that would just make $number_of_matches be zero, but () seems to be a special construct then :)
<phubuh_> sounds perly.
<Xcalibor> it just puts the list context, and makes it clear... :)
<Maddas> phubuh_: :)
<Maddas> Xcalibor: Yeah, I just never heard of it.
<Xcalibor> perl is a big language, enjoy exploring it ,-)
<mattam> in fact i may only be anti-interpolation and usually any type/context anotation before variable names
<mattam> is it really useful to have contexts ?
<Xcalibor> mattam: it isw
<Xcalibor> it lets you have pronouns
<Xcalibor> it makes the code cleaner and more powerful
<Maddas> mattam: yes, it is. It's not used very much in Perl 5, but if you bother reading about it, I can give you the document explaining the new contexts in Perl 6
<Maddas> Well, it's used often, but there aren't many contexts :-)
<Xcalibor> but they are used intensively :-)
<Maddas> Yes, I meant the concept could be expanded :-)
<Maddas> (and will be)
<mattam> oh, i'll let that as an advantage for perl mongers and just live without it, i just can't stand having those $ @ chars everywhere, and i know it is irrational :)
<mattam> what context do they added Maddas ?
<Maddas> Do you mean the sigils things?
<Maddas> Or the contexts as in "scalar" and "list" context :)
<mattam> scalar and list
<Maddas> I can't find the exact link right now, but
<mattam> what are sigils ?
<Maddas> They kept Scalar and List and divided them.
<Maddas> $ and @ and %
<Maddas> and & :)
<Maddas> (In Perl, that is)
<Maddas> they changed the use of sigils too, to be more intuitive.
<mattam> scallar list hash and reference right ?
<Maddas> scalar, list, hash and subroutine
<Maddas> you rather rarely need the & sigil now though
<Maddas> you do need it to create a reference to a subroutine though, for example
<mattam> yeah, it's why i said reference i think :)
<Maddas> :-)
<Maddas> In Perl 6 there will be Void context, and following Scalar contexts: Boolean context, Integer context, Numeric context, String context, Object Context; and following List contexts: Flattening list context ("true" list context), Non-flattening list context, Lazy list context, Hash list context
<Maddas> There might be more, but I'd have to look for the document describing it. I can if you want to read about it :)
<mattam> no thanks :)
<Maddas> :)
<Maddas> back to continuations.
<Maddas> is it a "standard" to call the continuation of a function f F?
<Riastradh> I dunno. I'd just say 'the continuation of a function f.'
<Maddas> hm, in the log you pointed me to, you often use uppercase letters to denote continuations
<Maddas> oh, are you caes-insensitive?
<Maddas> case, even
<Maddas> for example "Now, if you call (f (g x)), G is going to just return ordinarily and put a value into its continuation."
<Riastradh> Lisp symbols are generally written uppercase when writing them outside of a Lisp expression.
<Maddas> oh, ok :)
<Riastradh> For example: CATCH has a syntax of (catch id body)
<Riastradh> In your example there, I'd say 'the [] in (f []).'
<Maddas> heh, I see. That explains a bit (all the uppercase function names, argh!)
<Maddas> Ok, thanks :)
Demitar has quit ["Bubbles everywhere!"]
<Maddas> Does O'Caml support CPS?
<phubuh_> yes
<Maddas> ok!
<Riastradh> You can CPSify code in any language that supports anonymous and higher-order functions.
<Maddas> Mhm.
* Maddas goes back to reading
<Riastradh> Any other questions about that log?
<Maddas> No, not yet. I just know less Scheme than I thought to know
<Maddas> I'll fiddle around a bit until I get the hang of it :)
<phubuh_> let factorial n =
<phubuh_> let rec loop n cont =
<phubuh_> if n < 1 then cont 1
<phubuh_> else loop (n - 1) (fun x -> cont (x * n))
<phubuh_> in loop n (fun x -> x)
<Riastradh> You could make this even better, of course, if you had a 'sub_k' and 'mul_k':
<Riastradh> let fact n =
<Riastradh> let rec loop n k =
<Riastradh> if n < 1
<Riastradh> then k 1
<Riastradh> else sub_k n 1 (fun n' -> loop n' (fun r -> mul_k x n k))
<Riastradh> in loop n (fun x -> x)
<lc> what is the best library (let's say the easiest to use) to load an image file (bmp, jpg) and display it the graphics window ?
<phubuh_> lc, i only have experience with ocamlsdl, but i found that pretty pleasant.
<Riastradh> You could even eliminate the if given a 'gt_k':
<Riastradh> let fact n =
<Riastradh> let rec loop n k =
<Riastradh> gt_k n 1
<Riastradh> (fun () -> k 1)
<Riastradh> (fun () -> sub_k ...)
<phubuh_> what are these *_k functions?
<Riastradh> in loop n (fun x -> x)
<Riastradh> They're CPSified variants of the functions.
<Riastradh> mul_k x y k multiplies x and y and applies the result to k.
<phubuh_> ah
<Riastradh> Er, applies k to the result, rather.
lc has quit [Nick collision from services.]
lc_ has joined #ocaml
<phubuh_> gt_k x y f g applies () to f if x > y and () to g if x <= y?
<Riastradh> Now you're making the same grammatical mistake I did. You apply a function to something, not something to a function.
<phubuh_> oh, of course.
<Riastradh> In the last factorial function that I pasted, everything is a tail call.
<Riastradh> If you CPSify everything, you get call/cc for free, and you in fact don't need it!
<Maddas> Riastradh: Where can I read up on the Queinnec CPS style and how it is/can be used in webservers/for web programming?
<Maddas> oh, duh, I downloaded it and forgot to read. Thanks.
lc_ has quit [Remote closed the connection]
<mattam> Riastradh: your url seems borked
<mattam> and i'd like to read it :)
<Maddas> Sounds interesting. Maybe I should try to do something like that once.
<mattam> thx
<mattam> a french guy :)
jdrake has quit ["Snak 4.9.8 IRC For Mac - http://www.snak.com"]
buggs|afk has joined #ocaml
buggs has quit [Read error: 60 (Operation timed out)]
bk_ has quit ["I'll be back"]
bk_ has joined #ocaml
__DL__ has quit [Remote closed the connection]
bk_ is now known as headache