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
malc has joined #ocaml
<phubuh> haha, what a lovely side effect of o'caml
<phubuh> since identifiers starting with a capital letters are special, and since my emacs mode doesn't render things as strings until they are closed, my sql statements get decently highlighted
<phubuh> in "SELECT password FROM users WHERE id = x", the sql keywords are blue =)
<Smerdyakov> Syntax highlighting has never grown on me.
<cm> phubuh: :D
<Zadeh> it's hard to notice the value
<pattern> i love syntax highlighting
<phubuh> so do i
<pattern> it makes it so easy to see program structure, and zero-in on what you want
<cm> same here
<pattern> does vim have an ocaml syntax highlighting mode?
<pattern> i haven't tried it on ocaml yet
<whee> pattern: yes
<whee> there's also an indent file available
<phubuh> probably. you should use emacs though =)
<whee> emacs sucks :P
<phubuh> heathen
* whee runs
malc has quit ["no reason"]
<whee> I tried using emacs with viper a bit ago, but it was noticably slower and less responsive, I couldn't really stand it :|
<pattern> i guess the results of the emacs vs vi paintball match haven't reached you yet
<pattern> that proved once and for all that vi is superior!
<whee> combined with the fact that I've been using vi/vim for almost 5 years, there's no chance :)
<Smerdyakov> whee, what sort of system did you use where it was unacceptably slow?
<cm> whee :|
<whee> Smerdyakov: on my 800mhz g4, and on my 1.2ghz athlon next to me; I found them both to have a noticable delay with basic functions like moving around in files and other things of that nature
<whee> granted not huge, but distracting enough
<Smerdyakov> Well, what about that OCaml emacs replacement?
<whee> eh? I need a text editor, not whatever that is :)
<Smerdyakov> It _is_ a text editor.
<Smerdyakov> I don't remember where to find it now.
<Smerdyakov> It's emacs redone in OCaml.
<whee> if it has emacs key bindings, I won't be able to use it
<Smerdyakov> Untrue. You won't be able to use it without _learning_ something first. :P
<whee> no, I mean my hands don't bend that way.
<pattern> the keybindings aren't hard to learn... but they're just unecessarily slow to use
<whee> I get pains within minutes using emacs bindings
<cm> ctrl-x ctrl-c
<cm> nn
cm has quit ["[14:50:25] <@blutorgel> Kinoreeve: GEHE NUN TOT BIOTTE"]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
<mrvn_> one hits ctrl-x ctrl-c far too often by mistake. mellum has maped quit to ctrl-x ctrl-c ctrl-c for that reason :)
<pattern> i just use "ZZ" :)
lament has joined #ocaml
Zadeh_ has joined #ocaml
xtrm has quit [Remote closed the connection]
xtrm has joined #ocaml
Zadeh has quit [Read error: 54 (Connection reset by peer)]
asqui has quit [K-lined]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
Zadeh_ is now known as Zadeh
Kinners has left #ocaml []
rox is now known as rox|schweinfleis
rox|schweinfleis is now known as rox
rox is now known as rox|bierbauch
merriam has quit [leguin.freenode.net irc.freenode.net]
merriam has joined #ocaml
skylan has quit [Read error: 60 (Operation timed out)]
skylan has joined #ocaml
iusris has quit ["Lost terminal"]
docelic is now known as docelic|sleepo
rox|bierbauch is now known as dpkg
dpkg is now known as rox
rox is now known as DeBot
DeBot is now known as rox
rox is now known as jonka
jonka is now known as rox
rox is now known as jonka
jonka is now known as rox
polin8 has quit [Read error: 60 (Operation timed out)]
TachYon26 has joined #ocaml
Yurik has joined #ocaml
<Yurik> re
Yurik_ has joined #ocaml
Yurik has quit [Read error: 54 (Connection reset by peer)]
mattam has joined #ocaml
Yurik_ has quit [Read error: 104 (Connection reset by peer)]
Yurik_ has joined #ocaml
skylan has quit [Read error: 54 (Connection reset by peer)]
Yurik_ has quit [Read error: 104 (Connection reset by peer)]
<pattern> i have a question... i can understand the following statement:
<pattern> (function x -> function y -> 3*x + y) 4 5 ;;
mrvn has joined #ocaml
<pattern> - : int = 17
<pattern> but how is this legal? (function x -> function y -> 3*x + y) 5 ;;
<pattern> doesn't that require a second argument?
skylan has joined #ocaml
<pattern> and why does it return: - : int -> int = <fun>
<pattern> as if it's just a function definition
<pattern> what about the 5 ?
<TachYon26> 5 is assigned as x parameter
<TachYon26> and it returns function y -> 3*5+y
<TachYon26> whitch is type int -> int
<pattern> and y is unassigned, and that's ok?
<pattern> it just seems strange, because the statement seems incomplete
<TachYon26> pattern which statement
<TachYon26> you define function , apply to it integer (5), and as result get function
<pattern> (function x -> function y -> 3*x + y) 5 ;;
<pattern> why do i get a function as a result?
<TachYon26> rememeber (function x -> function y -> 3*x + y) is (function x -> (function y -> 3*x + y))
<TachYon26> pattern: you requested so
<pattern> ahh
<pattern> i think i got it
<pattern> this is weird, though :)
<mattam> not weird, functionnal pattern
<pattern> i think it disturbs me because you're simultaneously defining two functions, and feeding one a variable value, while leaving the other function's argument undefined
<mattam> partial application's great
<pattern> i'm used to seperate function and argument definitions
<pattern> and only being able to assign values to arguments after the functions are defined
<pattern> but, yeah, this is neat
<pattern> i can't wait to find some practical applications for this
<pattern> it seems like it could be really usefult
<pattern> useful
<pattern> thanks, tachyon
<mattam> let bump x = fun y -> x+y;; let succ = bump 1;; is an (int -> int)
gene9 has joined #ocaml
gene9 has quit [Client Quit]
<pattern> i don't think i know enough ocaml to understand that, mattam
<pattern> i haven't covered "is an" yet... and is "bump" a keyword?
<TachYon26> no
<TachYon26> bump is defined as function name
<pattern> if bump is a function name, what is x ?
<pattern> bump's argument?
<TachYon26> parameter
<TachYon26> yes
<pattern> oh, this is the alternate form of defining functions
mrvn_ has quit [Read error: 110 (Connection timed out)]
<pattern> now i remember that from the other tutorial i looked at... i'd forgoten that form now that i've started with the ocaml book
<pattern> so what is "is an" ?
<pattern> was that just a comment from you?
<TachYon26> I think it's mattam comment :)
<pattern> ok
<pattern> :)
<TachYon26> that new function succ
<TachYon26> is int -> int
<pattern> yes
<pattern> so could you then say: "succ 2" ?
<pattern> and get "- : int = 3" ?
<pattern> yeah, that worked :)
<pattern> i think i just need lots more practice with this before it becomes second nature
<TachYon26> nah it's ok .. for me only notation (with -> binding to right) is weird ...
rox is now known as hal
hal is now known as jonka
<pattern> binding to the right makes perfect sense to me
<pattern> i just imagine parenthesis around the terms, starting from each pair on the right
<pattern> it's returning functions that's weird
<pattern> and assigning a function to a variable, as in "let succ = bump 1;;" above
jonka is now known as rox
<TachYon26> just think of functions as same types as others ...
mellum has quit [Read error: 110 (Connection timed out)]
<pattern> yeah, that's what i'm having a hard time with
mellum has joined #ocaml
esabb has joined #ocaml
docelic|sleepo is now known as docelic
taw has joined #ocaml
<taw> how to replace all occurences of "foo" in string by "bar" ?
<emu> I guess you'll need some kind of string search/replace library
<taw> nothing in standard library ?
<taw> it seems very basic
<emu> it's not
<emu> you need a backtracking search
<emu> hmm
<taw> it's not regular expresion
<taw> just a string
<taw> you don't need any magic for i
<taw> t
<emu> so?
<taw> so it should be provided by standard library ;)
<Smerdyakov> You need some "magic" to do it efficiently, taw.
<emu> actually I may be thinking of multi string search/replace
* emu ponders
<emu> but to do it efficiently is definitely non-trivial
<taw> well ...
docelic is now known as docelic|away
<phubuh> in my interface file, i have val connection: (Poofdb.connection option) ref, but i get a syntax error on the := operator in the line "connection := None" in my implementation
<phubuh> do i need to specify the type of 'connection' in the implementation file too? if so, how?
<steele> let connection = ref None
<phubuh> oh, thanks, that worked!
<phubuh> ... huh?! i know that the getvalue method of res is int -> int -> string, but it complaind about this expression having type int: name = (res#getvalue 0 1). it's in an anonymous record construction by the way
<phubuh> i see, i had a weird assignment before it that apparently inferred it to int
<phubuh> in an expression fun i -> i, how do i specify that i has to be an int?
mattam_ has joined #ocaml
<phubuh> never mind
cm has joined #ocaml
Yurik_ has joined #ocaml
<taw> hi Yurik_
mattam has quit [Read error: 60 (Operation timed out)]
<Yurik_> taw: hi
cm has left #ocaml []
<Yurik_> taw: cool! most of words are very similar to ukranian ones :)
<taw> yes, they are very similar
<Yurik_> the most significant difference is alphabet, as I see :)
<phubuh> Poof.Forum.description looks like {id: int; name: string; description: string; shortname: string}
<phubuh> yet i get "Unbound record field label name" in 'forum.name'
<phubuh> forum is explicitly typed to Poof.Forum.description
<taw> yes
<phubuh> why is this?
rox has quit [Remote closed the connection]
Yurik_ has quit [Read error: 54 (Connection reset by peer)]
<pattern> where is the argument to the succ function in: "let succ = ( + ) 1 ;;"
<taw> hehe
<pattern> shouldn't it be something like: "let succ x = x + 1 ;;" ?
<pattern> oh, nevermind... i think i understand
<taw> ( + ) 1 x ;)
<pattern> ( + ) refers to the function +
<pattern> and the function takes two arguments...
<taw> yes ;)
<pattern> :)
<pattern> that's _so_ cool
<pattern> :D
<pattern> so is ( = ) a function too? :)
<taw> it's just broken notation
<pattern> yeah... not that i'd know what to do with it even if it was legal
<mattam_> it cannot be overloaded for new types. I think that's the main point
mattam_ is now known as mattam
<pattern> but i must say, learning ocaml is lots of fun, once i manage to wrap my brain around the new concepts
<mattam> yep, ocaml is fun, and speedy too (for both dev and performance aspects). It's not like what I learn at uni (Java(tm) for Soft. Engeneering, AI / Logic, Image processing, Network...).
<pattern> hey, ( = ) worked
<pattern> let succ = ( = ) ;;
<pattern> val succ : 'a -> 'a -> bool = <fun>
<pattern> if succ 1 1 then 2 else 3 ;;
<pattern> - : int = 2
<pattern> :)
<taw> a = b is just infix notation of (=) a b
<pattern> yeah, that makes sense
<pattern> once i learn ocaml i'm hoping to use it for genetic programming
<pattern> i don't know if there are any native ocaml genetic programming libs... if there aren't i might try to interface it with lilgp
<pattern> or maybe i'll write my own, if i'm feeling brave
<pattern> but that's far in the future... i can't even write hello world, yet :)
<mrvn> print_string "Hello world!";;
<pattern> oooh!
<pattern> :)
<pattern> now i will conquer the world!
<mrvn> You can even do let verbose_add x y = Printf.printf "%d + %d = %d" x y (x+y); print_newline ();;
<pattern> cool
<mrvn> Only thing to keep in mind with Printf.printf is that "\n" doesn't seem to flush the output but print_newline () does.
<pattern> luckily i know c, so that all makes sense :)
<mrvn> pattern: thats what i counted on. :)
<pattern> i think it's just going to be the heavy recursion that's going to be the most trouble for me
<mrvn> you mean translating for and while loops?
<mrvn> let rec loop x = if x < 10 then begin Printf.printf "%d\n"; loop (x+1); end in loop 3;; stuff
<mrvn> What you realy have to get used to is to when to use fold_left/right, map, iter or iteri functions on datastructures.
<pattern> yeah, i'd heard that ocaml has convenient features like that for iteration
polin8 has joined #ocaml
<mrvn> for i = 3 to 9 do Printf.printf "%d\n"; done;;
<mrvn> But try to sum up all numbers from 3 to 9 with a for loop and with recursion. recursion is much nicer.
<pattern> well, i'm determined to learn
Zadeh_ has joined #ocaml
Zadeh has quit [Read error: 54 (Connection reset by peer)]
<phubuh> this confuses me to no end
<phubuh> Poof.Forum.description is defined with type descrition = { ... name: string ... } (no, the ellipses aren't really there)
<phubuh> sorry, the field name is 'name'. but i get type error when I try to use forum.name in this: fun (forum: Poof.Forum.description) -> Printf.printf "%s" forum.name
taw has left #ocaml []
<mrvn> let array = Array.init 997 (fun x -> x+2);;
<mrvn> let list = Array.to_list array;;
<mrvn> let sieve l x = List.rev (List.fold_left
<mrvn> (fun res y -> if (y mod x) = 0 then res else y::res) [] l);;
<mrvn> let numbers =
<mrvn> let rec loop res = function
<mrvn> [] -> List.rev res
<mrvn> | x::l -> loop (x::res) (sieve l x)
<mrvn> in loop [] list;;
<mrvn> pattern: Guess what that does.
<pattern> i'm scared
<phubuh> =(
<pattern> there's a ton of stuff i don't understand in there
<pattern> you seem to create an array and then sort it in some fashion
<mrvn> array is an array containing the numbers from 2 to 999, list is a list of it.
<pattern> but you got me as to how... what's "res"? and "[]"? and "fold_left"?
<mrvn> Couldn't think of a shorter way to create the list.
<pattern> and i don't know the "::" operator either
<mrvn> res is just a variable and [] the empty list.
<phubuh> :: is the cons operator
<pattern> and cons means what?
<emu> cons returns a list with the first argument prepended to the second
<phubuh> 4::[1;2;3] = [1;2;3;4]
<pattern> ok
<emu> prepended, phubuh
<phubuh> i think cons means construct, it's a lispism
<mrvn> [4;1;2;3]
<phubuh> oh, yes. sorry.
<emu> pattern: do you understand the concept of a linked list?
<mrvn> # List.fold_left (fun res x -> res+x) 0 [1;2;3;];;
<mrvn> - : int = 6
<pattern> yes, i understand linked lists
<phubuh> i quite frequently do things like thinking "x! x! x!" and then, when i have to type it out or say it, i say the complete opposite
<emu> pattern: each "cons" is a node in the list
<emu> pattern: it has two slots; one for an object, and the other for the rest of the list
TachYon26 has quit [Remote closed the connection]
<mrvn> fold_left folds a list with a function f. [a;b;c;d;] gets folded into (f(f(f(f start a) b) c) d)
<emu> if you "cons" an object onto a list, you are basically creating a new node with the "object slot" set to some object and the "rest of list slot" set to that list
<pattern> makes sense, emu
<mrvn> pattern: Every time you want to do something with each element of a list and accumulate the result you fold_left or fold_right.
<emu> and the last node in a list, by convention, has [] in the "rest of list slot"
<mrvn> The "numbers" above, by the way, are all prime number.
<pattern> what does "start" mean?
<mrvn> pattern: the start element. in the example the sum of all list elements starts with 0.
<mrvn> The initial accumulator.
<pattern> mrvn, so are you saying that the fold_left function executes an arbitrary function on every element of a list?
<mrvn> pattern: no, that would be List.iter or List.map
<mrvn> folding applies the function to each element _and_ the accumulator.
<emu> does let rec not do pattern matching?
<emu> <-- not terribly familiar with ocaml syntax atm
<mrvn> emu: # let rec loop = [] -> [] | x::l -> x::(loop l);;
<mrvn> Syntax error
<mrvn> nope
<emu> I was thinking of # let rec loop [] = [] | loop (x::l) = loop l;;
<mrvn> # let rec loop [] = [] | loop (x::l) = loop l;;
<mrvn> Syntax error
<mrvn> at the |
<emu> something similar to: - fun loop [] = [] | loop (x::l) = loop l
<mrvn> # let rec loop [] = [];;
<mrvn> Warning: this pattern-matching is not exhaustive.
<mrvn> Here is an example of a value that is not matched:
<mrvn> _::_
<mrvn> val loop : 'a list -> 'b list = <fun>
<mrvn> You can pattern match, but only one case.
<pattern> ok, i think i understand fold_left
<phubuh> this is driving me _insane_. i should be able to reference a label in my record by record.label, right?
<mrvn> yes
<pattern> i would have called it "funca_list", though :)
<mrvn> Unless its in another file, i.e. Module
<phubuh> oh, it is
<steele> > x::(loop l);;
<steele> 17:48 <mrvn> Syntax error
<steele> 17:48 <mrvn> nope
<steele> 17:49 <emu> I was thinking of # let rec loop [] = [] | loop (x::l) = loop l;;
<steele> 17:49 <mrvn> # let rec loop [] = [] | loop (x::l) = loop l;;
<steele> 17:49 <mrvn> Syntax error
<steele> 17:49 <mrvn> at the |
<steele> 17:49 <emu> something similar to: - fun loop [] = [] | loop (x::l) = loop l
<steele> 17:49 <mrvn> # let rec loop [] = [];;
<phubuh> why this craziness?
<steele> 17:49 <mrvn> Warning: this pattern-matching is not exhaustive.
<steele> 17:49 <mrvn> Here is an example of a value that is not matched:
<steele> 17:49 <mrvn> _::_
<steele> 17:49 <mrvn> val loop : 'a list -> 'b list = <fun>
<mrvn> steele?
<steele> 17:49 <mrvn> You can pattern match, but only one case.
<steele> 17:52 <pattern> ok, i think i understand fold_left
<steele> 17:52 <phubuh> this is driving me _insane_. i should be able to reference a
<steele> label in my record by record.label, right?
<steele> 17:53 <mrvn> yes
<steele> 17:53 <pattern> i would have called it "funca_list", though :)
<pattern> thanks for the flashback
<emu> cut&paste sux =)
<steele> 17:53 <mrvn> Unless its in another file, i.e. Module
<steele> 17:53 <phubuh> oh, it is
<steele> oh sorry, my mouse freaked out
* steele hides
<phubuh> with that out of the way, what do i need to do to access fields in structures defined in another module?
<phubuh> and why is that a special case?
<mrvn> var.Module.label
<mrvn> phubuh: ocaml needs to find out what type var has, .Module.label tells him where to look.
<phubuh> but var is declared typed explicitly (in my case, forum: Poof.Forum.description). can't it figure it out from that?
<mrvn> Given a Module M with type foo = { foo:int; } type bla = { bla:int; }
<mrvn> Given a Module M with type foo = { foo:int; } type bla = { bla:foo; }
<mrvn> why do I need to say bar.M.bla.M.foo ?
<mrvn> phubuh: It could, it doesn't.
<mrvn> phubuh: the Grammatik says you have to allways give the full name (or use open) somewhere.
<phubuh> okay. thanks!
<mrvn> In the case where you just use foo.M.foo the M is neccessary unless the type of f is known. But ocaml doesn't get it even when you tell it what type it is.
<mrvn> Its amazing how slow the sieve is for bigger lists.
<pattern> well, linked lists aren't a particularly efficient method of storage
<pattern> it's not like an array of contiguous memory
<mrvn> But the list it has to sieve gets smaller each turn.
<mrvn> With an array a lot of array fields will be empty (not prime) and waste time.
<pattern> i don't think i understand yet what the sieve actually does
<mrvn> "sieve l x" removes all elements from l that are evenly divisible by x
<pattern> i don't think i can understand how it all comes together, yet
<pattern> the individual elements kind of make sense... but how they fit and why is a complete mystery right now
<pattern> but i'll save that snippet and have a look at it in a week :)
<mrvn> start with some simplem recursions, like n! or sum(1..n) or Prod(1..n)
<pattern> yeah, i need to practice with those
<pattern> but now i need to sleep
<pattern> thanks mrvn, and all
gene9 has joined #ocaml
gene9 has quit [Client Quit]
gene9 has joined #ocaml
gene9 has quit [Client Quit]
docelic|away is now known as docelic
rox has joined #ocaml
esabb has quit [Read error: 54 (Connection reset by peer)]
phubuh has quit [Remote closed the connection]
phubuh has joined #ocaml
<phubuh> hey guys, i need some advice on efficiency with web applications
<phubuh> i'm writing a forum, you see. i don't want to use mod_ocaml, will the overhead of using CGI be significant?
<phubuh> that overhead involves starting my process and connecting to the database
<phubuh> the web server will be apache running on linux
<Smerdyakov> I use a separate web server I have written, with Apache relaying requests to it with mod_proxy.
<Smerdyakov> I don't know how it does efficiencywise.
<mrvn> if loading the board takes time you have to write your own server and forward the requests too it.
<mrvn> But is your board going to get big?
<mrvn> And een if, won't you put the board into an sql database or so which would be running all the time and just pull data out of it via cgi?
<phubuh> for what i'm using it for, it won't, but i have no idea who else will use it
<mrvn> s/een/even/
<phubuh> yeah, all the board data is in an sql database
<mrvn> phubuh: Keep it small. There are enough solutions out there for big boards.
<mrvn> With all the problems such grand schemes bring
<phubuh> are there any free and open-source solutions for not very serious forums with 10,000 users who post a lot?
<phubuh> well, actually, only about 4000 actually post
skylan has quit [Read error: 104 (Connection reset by peer)]
skylan_ has joined #ocaml
<mrvn> miracles? veritas? Frascape?
<mrvn> ups
split^ has joined #ocaml
docelic is now known as docelic|away
gene9 has joined #ocaml
gene9 has quit [Client Quit]
docelic|away has quit ["brb"]
docelic has joined #ocaml
skylan_ has quit [Read error: 54 (Connection reset by peer)]
skylan_ has joined #ocaml
cm has joined #ocaml
det has joined #ocaml
cm has quit ["leaving"]
<pattern> i'm having a really hard time understanding this:
<pattern> # let compose f g x = f (g x) ;;
<pattern> val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
<pattern> i understand what it does, but not how it's typed
<pattern> ('a -> 'b) makes sense.. but where did 'c come from? and why 'a ?
<pattern> does 'c refer to x ?
<pattern> i'm totally confused
<whee> well, ignore the definition and look at what compose does
<pattern> it takes a function and two variables, and applies the function to the two variables
<mrvn> f g x --> f g:'a x:'b
<pattern> arguments, i mean
<mrvn> Weil irgendeinen Type muess das ja haben.
<whee> wait, the 'c just confused me too :)
<pattern> oh no!
<mrvn> dann kommt f (g x) --> g:'b->d
<mrvn> f g:'b->'d x:'b
<mrvn> f:'e g:'b->'d x:'b