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
<asqui> whee: I really should be able to do this stuff in my ehad though :p
<asqui> Its not A or B
<palomer> whats wrong with this: let myinc j = \\ let x = 4 in \\ j + x;; ?
<whee> sure?
<whee> looks like not A to me
<mellum> palomer: missing in's?
<palomer> where?
<phubuh> do the \\s mean newlines?
<palomer> yup
<mellum> Or is that a whole expression? Then it should work
<phubuh> # myinc 4;;
<phubuh> - : int = 8
<phubuh> it seems to work, as it should.
<palomer> erm, yhea, must have made a mistake
<palomer> ok here it is:
<palomer> let x = 5 in
<palomer> let myinc j =
<palomer> x + j;;
<whee> something like let myinc = let x = 4 in (+) x would also work
<whee> which may or may not be esaier to understand, but shorter :)
<palomer> why wouldn't the last one work?
<whee> the one you just pasted doesn;t work?
<mellum> whee: might be less efficient, though
<palomer> yup
<whee> well I don't think you'd want the in after "let x = 5" if you were doing it that way
<palomer> hrm, doesn't the in say that the scope of the variable is valid only in the next block?
<whee> yes
<palomer> and isn't x evaluated only when the function is defined?
<whee> if you wanted x to be valid only in the scope of myinc, you'd put it inwide myinc
<whee> inside, even
<palomer> but I could also make it valid in many functions this way
<palomer> like let x = 5 in .... and .....
<palomer> right?
<whee> I iknow what you want to do, but I can't remember the right way to do it
<palomer> I'm just testing the language right now
<palomer> just to see what you can and cannot do
<whee> basically have some variable defined for only some set of functions, and have it remain constant during multiple calls to those functions
<phubuh> why does this give a stack overflow when passed a simple string that should match the first case?
<phubuh> let show_of_string str =
<phubuh> let elts = Str.split (Str.regexp "\\|") str in
<phubuh> match elts with
<phubuh> | i :: name :: desc :: tl -> ((interval_of_string i), name, desc)
<phubuh> | _ -> raise (Invalid_show str)
<whee> I've done it before, but now I can't remember the exact details :\
<whee> what's interval_of_string?
<phubuh> let interval_of_string s =
<mrvn_> no recursion, can't cause a stack overflow
<phubuh> let ps = Str.split (Str.regexp "-") s in
<phubuh> let a = List.hd ps
<phubuh> and b = List.hd (List.tl ps) in ((time_of_string a), (time_of_string b))
<whee> still not seeing recursion, heh
<phubuh> time_of_string is basically interval_of_string, but it uses int_of_string instead of time_of_string
<phubuh> no, there's no recursion =/
<mrvn_> Then you can't get a stack overflow
<mrvn_> No List.fold_right or something in there?
<phubuh> # show_of_string "12:00-13:00|a|b|c";;
<phubuh> Stack overflow during evaluation (looping recursion?).
<phubuh> nope. i don't know what kinds of funky stuff the Str functions do, though.
<phubuh> oh hey, i forgot all about `trace'
<mrvn_> Why don't you define a parser for it?
mrvn_ is now known as mrvn
<phubuh> it's just a simple dataset delimited by pipes, would it be worth it?
<mrvn> wouldn't be hard using camlp4
<whee> ah, hooray
<mrvn> is the time allways xx:xx?
<phubuh> yep
<palomer> thx
<phubuh> some #trace-ing shows that the Stack_overflow is raised in or under Str.split
<mrvn> whee: nice one. :)
<palomer> which tutorials do you recommend I read?
<whee> all of them :)
<mrvn> palomer: the ocaml reference manual has some example.
<phubuh> ... and indeed, Str.split (Str.regexp "\\|") "foo|bar|baz";; consistently causes stack overflows.
<whee> or at least the o'reilly book and the manual
<mrvn> Shouldn't it be "\|" ?
<palomer> is the o'reilly book free?
<mrvn> "\\|" is \ or epsilon
<whee> yes, it's online
<whee> what I linked to is a section of it
malc has joined #ocaml
<palomer> is it a good book?
<whee> yes
<phubuh> mrvn: epsilon?
<phubuh> ... oh, Str.regexp "|" generates a working regexp
<mrvn> the empty regexp
<phubuh> how come? shouldn't the | be interpreted as an Or?
<whee> check the docs :P
<mrvn> I think its a special case for when | is the first char
<whee> \| (infix) alternative between two expressions
<phubuh> oh, hah
<phubuh> that's silly :-)
redcrosse has quit []
<palomer> hrm, theres like 2 million ways to define a function, which way is considered the best?
<whee> whatever fits the situation
<whee> if you're going and writing a function like let blah x = match x with ..., then you should probably do a let blah = function ...
<whee> but with more than one argument, it's normally easier to follow currying
<palomer> whats the differecnce between let foo j = j + 1 or let foo = fun j -> j + 1 ?
<phubuh> let f x = ... when you define a named function, fun x -> ... for lambdas, function | 0 -> "zero" | 1 -> "one" for matchers
<whee> palomer: nothing, really
<phubuh> palomer: technically, probably none.
<palomer> so which is better to use?
<palomer> oreilly says the latter is legacy
<phubuh> for named functions, the former
<whee> it doesn't matter, they're the same thing in the end
<whee> if you've got a function dealing with one argument, it's usually easier to use the function syntax
<Riastradh> If you're learning OCaml you should probably use the 'fun x -> blah', just to remind yourself that functions are ordinary values just like anything else.
<phubuh> yeah, you won't see any impact at all on the performance, behavior, heck, it'll probably generate the exact same code in both ways.
<palomer> but the latter is shorter to write:o
<whee> not always
<Riastradh> The latter can be shorter, but when you're learning, it's better to learn the fundamentals and not syntactic sugar.
<palomer> :o
<whee> let blah x y = x + y is also let blah = function x -> function y -> x + y
<whee> it depends on what you want to do with the arguments as to which is easier
<Riastradh> With 'function' you have to display the currying, while with 'fun' you can just do: fun x y -> x + y , right?
<mrvn> The proper[tm] functional way is let foo = function j -> j + 1
<mrvn> fun x y -> ... is a shortcut for function x -> function y ->
<Riastradh> OK, that's what I thought.
<mrvn> and let foo x y is a shortcut for let foo = fun x y ->
<mrvn> But thats only defined that way with ocaml
<Riastradh> So, when you're learning, it's best to use 'function' and not 'fun' and definitely not 'let f g h = blah'.
<mrvn> Riastradh: nah, that takes all the fun out of it
<Riastradh> mrvn - Arrgh!
<mrvn> .oO( not the word play on "fun" :)
<Riastradh> No?
<pattern_> there's a book coming out called "the fun of programming", about functional programming :)
<mrvn> s/not/note/
<Riastradh> Ah!
<Riastradh> Yes, that's what I was saying 'Arrgh' about.
<mrvn> My university professor said that ocaml is a lot of "fun", we would soon see that.
<palomer> hrm
<palomer> my university doesn't even teach lisp
<mattam> mine neither, it's Java(tm)(r)(c) everywher
* Riastradh will be teaching a Scheme course next month.
<mellum> Grrr. Argh.
<palomer> lukily my school doesn't teach java either
<Riastradh> Grrr? Argh?
<mattam> but I still know how to have fun while programming :)
<Riastradh> palomer - What, do they teach C++?
<mellum> Riastradh: Oh, I'm just suffering a Buffy the Vampire Slayer overdose.
<mattam> palomer: COBOL ?
<palomer> C++
<mrvn> mellum: One can suffer from that?
<palomer> they don't teach cobol either, neither fortran
<Riastradh> Hah! I don't have a TV, so I can't overdose on it.
<Riastradh> palomer - Gaaack! You'll have to stab the person who thought to teach C++ only for me, ok?
<mrvn> Riastradh: TV only has the german dubed Buffy, which sucks.
<palomer> hrm, actually they teach some java in our operating systems class
<mellum> Riastradh: me neither :)
<mrvn> Long live the internet
<palomer> Riastradh: it's better than java/cobol/fortran/C
<Riastradh> palomer - Stab the guy who thought of teaching Java for operating systems, too.
<mrvn> palomer: Java and OS? That doesn't realy go well together
<palomer> it doesn't
<palomer> the teacher has some serious issues
<mrvn> palomer: not at all
<Riastradh> C++ is a better language than C when learning CS?!?
<phubuh> JavaOS is the future!
<mattam> palomer: for OS ? you mean you learn about Java OS ?
<mrvn> phubuh: Java is inherent unsafe.
<palomer> no, we learn basic OS concepts
<Riastradh> Stab that guy several times, ok?
<mrvn> phubuh: How do you want to write an OS if some user code someone wants to run later can do anything it wants?
<palomer> hrm, many things don't make sense in my school, but the people are nice
<mattam> yeah, I learn basics in AI using Java too :(
<palomer> mattam: casting must've drove you nuts
<Riastradh> mattam - Arrgh! Stab that guy, too!
<gl> hum
<mrvn> Worst of all is casting in pascal.
<mattam> it's a choice from the CS department in its entirerty I think
<mrvn> I had to add inline asm to cast a pointer. The asm just did a RST.
<Riastradh> What universities are these?
<gl> the past year they used Prolog for AI :)
<palomer> mrvn: poor you
<palomer> concordia
<palomer> it's not a bad university, just a screwed up OS teacher
<palomer> and C++ isn't that bad of a programming language
* Riastradh pokes mattam -- what university are you at?
<mattam> gl: damn you
<palomer> heck you can even do functional programming in it
<Riastradh> Ack!
<gl> Orsay, Riastradh
<gl> Paris-XI
<mattam> Paris
<palomer> onzieme:o
<mrvn> short main[1] = { 0x4e75 };
* Riastradh feels lucky to live in the vicinity of MIT.
<mrvn> sometimes I love C
<mattam> They're out of money ATM, so we had one week more of holidays :)
<palomer> Riastradh: is MIT all it's cracked up to be?
<Riastradh> palomer - To some extent.
<Riastradh> The hacks at MIT definitely are.
<palomer> I mean most of us do our learning by ourselves
<palomer> hacks?
<Riastradh> Yes.
<palomer> what hacks?
<mattam> mrvn: what does it do ? a jump at startup ?
<palomer> im thinking of doing phd there
<phubuh> C can be fun to write code in
<phubuh> just like Brainfuck
<Riastradh> No, no, Unlambda is far more fun.
<phubuh> not for me it isn't, i think i'm far too dumb for it
<phubuh> what's the best way to get the current date in granularity of days?
<phubuh> using the Unix library feels icky
<palomer> c++ code can be fun!
<palomer> not as fun as ocaml or scheme maybe
<gl> and painful
<whee> I try to use cyclone when I feel like torturing myself with C
<whee> that or objective-C
<palomer> hacks look like fun
<Riastradh> Objective-C is torturous?
<palomer> noone understands the beauty of c++
<whee> no, it's less painful than plain C :)
<palomer> quicksort is 4 lines in c++
<whee> palomer: one line in languages supporting list comprehensions
<whee> well, I guess another for the base case
<palomer> 4 readable lines
<phubuh> qsort in haskell is so amazingly elegant
<mattam> phubuh: the only time functions are there (gmtime (gettimeofday ())).tm_day
<mattam> Riastradh: robots protesting... have you so much free time ?
<phubuh> qsort x :: xs = (qsort [lt <- xs, lt < x]) ++ (qsort [gte <- xs, gt >= x])
<phubuh> or something like that
<phubuh> mattam: okay, thanks
<phubuh> i guess those functions exist on pretty much every platform anyway
<gl> with camlp4 you can do the same :)
<Riastradh> mattam - Apparently the hackers do.
<Riastradh> They painted a giant ring around the great dome!
<whee> gah, my paste is screwy
<whee> but that's entirely wrong syntax phubuh :)
<phubuh> i never said that was haskell! it is in fact my own language that automatically adjusts itself to my typing errors
<Riastradh> Heh.
<whee> quicksort (x:xs) = quicksort [ y | y <- xs, y < x] ++ [x] ++ quicksort [y | y <- xs, y >= x]
<mattam> the function is at the beggining of the introduction on haskell.org IIRC
<Riastradh> Wouldn't that quicksort be somewhat slow?
<whee> it's a shame ocaml has no list comprehension sugar :\
<whee> Riastradh: yes, of course
<mattam> they show the optimisation in C after
<whee> but it's really easy to understand
<palomer> hrm
<palomer> I think that comparison is unfair
<palomer> they should have shown the recursive C version
mellum has quit [Excess Flood]
<palomer> which is much more elegant
mellum has joined #ocaml
<whee> still, it's C :)
<whee> the haskell version will sort anything that's Ord
<whee> not limited to integers, or whatever
<mattam> the point was to show that making it more efficient is possible but not very useful for your functions, especially considering readability and safety
<palomer> and thats where c++ comes in
<whee> meh, c++ is overkill
<palomer> mattam: I think the point was to convince people that haskell is better
<mattam> that is the correct conclusion, yes
<palomer> what does List.tl do?
<mattam> tail
<mattam> head::tail
<gl> return the list without the head..
<Riastradh> List.tl [1; 2; 3] (* --> [2; 3] *)
<palomer> ah
<palomer> so it's like cdr
<Riastradh> Yes.
<palomer> the oreilly book just slams you right away with lists without warning
* Riastradh read the introduction in the manual.
asqui has quit [Read error: 60 (Operation timed out)]
malc has quit ["no reason"]
det has quit [Remote closed the connection]
rox is now known as rox|verbreiten
<phubuh> hee hee
<phubuh> let tod = (Unix.localtime (Unix.gettimeofday ())) in
<phubuh> let date = tod.Unix.tm_hour * 60 + tod.Unix.tm_min in
<phubuh> (List.filter (function ((s,e),n,d) -> s <= date && e > date) (List.flatten (List.map (fun ch -> get_shows_on_channel ch) [Svt1; Svt2; Tv3; Tv4; Kanal5; Ztv])))
<phubuh> hooray for readability
<mrvn> Are you parsing some online TV programm?
<phubuh> yeah
<mattam> open List
det has joined #ocaml
<mattam> open Unix too
<mrvn> Why? open sucks. That pollutes the namespace
<mattam> not so much for List
<mrvn> So what if you have List and Array?
<mattam> you've got to choose
<mrvn> I prefer the Module name.
<det> Any idea why Unix.set_nonblock on win32 uses threads when win32 supports blocking on sockets ?
<mattam> usually I open List since I know i'll have lots of map's and filter's and iter's
<det> (not sure if that was a repeat, my irc client is screwing up)
<Riastradh> Ack.
<gl> I never open modules.
<det> s/blocking/ Non-blocking/
<mattam> that's harder to read when you have lots of List. on one line
* Riastradh hrms at the Tuareg mode.
<Riastradh> Or, better, at Emacs.
<whee> it'd be nice if there were a local version of open
<mattam> there is, but not in 3.06
<whee> where you could open modules for some scope, and only there
<whee> it's in cvs?
<mattam> not sure, it's on alain frish's homepage
<whee> never saw it in changes, wonder when that one made it D:
<whee> oh, heh
<mattam> Riastradh: what's this hrm ?
<Riastradh> It isn't recognising .ml files as Caml files.
<Riastradh> In my .emacs I've got:
<Riastradh> (push (expand-file-name "~/elisp/tuareg-mode") load-path ; that's where the Tuareg mode files are
<Riastradh> (require 'tuareg)
<Riastradh> (require 'camldebug)
<Riastradh> (push '("\\.ml\\w?$" . tuareg-mode) auto-mode-alist)
<mattam> same re, that's weird
<Riastradh> Indeed.
<mattam> isn't it masked by another module ?
<Riastradh> ?
<mattam> a mode that's set to hook on any file type for example
<mrvn> I just have (load "append-tuareg")
<Riastradh> Still doesn't work.
<mattam> and it happened suddenly ?
<mrvn> (setq load-path (cons "/home/hueffner/src/tuareg-mode-1.40.4" load-path))
<mrvn> (setq auto-mode-alist (cons '("\\.ml\\w?" . tuareg-mode) auto-mode-alist))
<mrvn> (autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
<mrvn> (autoload 'camldebug "camldebug" "Run the Caml debugger" t)
<Riastradh> No, it just occurred to me suddenly.
<Riastradh> Previously I had been writing all my code on another computer.
<mrvn> Does that help?
<mattam> k
<Riastradh> No, mrvn; I've already got something like that in my .emacs.
<mrvn> the autoload too?
<phubuh> does M-x tuareg-mode work?
<Riastradh> I've tried it with 'require', with 'autoload', et cetera.
<mrvn> strange
<Riastradh> Yes, phubuh, but it doesn't automatically recognise .ml files.
<mrvn> any sml mode or orther *ml match defined later?
<Riastradh> Even stranger, it works perfectly fine on my other computer.
<Riastradh> Nope.
<phubuh> that's weird indeed
<Riastradh> It works perfectly fine with Haskell and .hs files.
<mrvn> n8
<Riastradh> It works perfectly fine with ILISP.
<Riastradh> It works perfectly fine with Dylan.
<palomer> :o
<phubuh> This expression has type ((int * int) * string * string * channel) list
<phubuh> but is here used with type ((int * int) * string * string * channel) list
<phubuh> ... ?!
<whee> heh
<det> how do I access an element of a record ?
<mattam> :)
<whee> does that type structure represent something that you defined?
<phubuh> channel does, yeah
<phubuh> it's just a simple enumeration, i.e., type channel = Tv1 | Tv2 | Tv3 | ...
<Riastradh> det - recordInstance.field, if record is defined as: type record = { field : someOtherType; ... }
<whee> perhaps you've defined it twice, and it's really Mod1.channel and Mod2.channel
<whee> which is where the conflict is
<palomer> im guessing the :: operator is for concatenation, right?
<det> # addr.h_addr_list;;
<det> Characters 0-16:
<det> addr.h_addr_list;;
<det> ^^^^^^^^^^^^^^^^
<det> Unbound record field label h_addr_list
<phubuh> this is all in one module
<whee> palomer: it adds an item to the head of a list, yes
<phubuh> palomer: 1 :: [2; 3] = [1; 2; 3]
<det> yet, the Unix module documentation defines it as
<det> type host_entry = {
<det> h_name : string;
<det> h_aliases : string array;
<det> h_addrtype : socket_domain;
<det> h_addr_list : inet_addr array;
<det> }
<phubuh> addr.Unix.h_addr_list, unless you've `load'-ed Unix
<Riastradh> `load'-ed? Don't you mean `open'-ed?
<det> oh, that is strange
<phubuh> blurgh, of course :-)
<whee> heh
<det> now, how do I get the first elemnt of the array ?
<det> :)
* Riastradh just writes records as: type record = Record of type * type * type and uses match to get the fields.
<whee> meh, the second ocaml has list comprehensions and local opens, it's having my kids
<Riastradh> array.(0)
<whee> however painful that may be.
phubuh has quit [Read error: 54 (Connection reset by peer)]
<Riastradh> whee - ?
phubuh has joined #ocaml
<phubuh> oops, emacs didn't like that
<palomer> is it just be or is iteration going out of style?
<Riastradh> 'Iteration?'
<palomer> in place of recursion
<Riastradh> In the sense of going through each element of a list?
<Riastradh> 'Iteration' is a very broad term.
<Riastradh> 'Recursion' has an entirely different meaning.
<Riastradh> 'Recursion' is simply when a binding references itself in that binding's value.
<Riastradh> i.e., in a recursive function, the function calls itself.
<Riastradh> 'Iteration' is a process whereby something is done to every element in a collection.
<det> now if connect requires a sockaddr where a sockaddr is something | ADDR_INET of inet_addr * int, how do I construct that ?
<Riastradh> Unix.ADDR_INET(myInet_addr, myInt)
<det> Unix.ADDR_INET theinetaddr 80 ?
<det> must it be witht he pareens and comma ?
<Riastradh> foo * bar is the type of a tuple that can be (someInstanceOfFoo, someInstanceOfBar).
<Riastradh> The comma, most certainly; the parens, I'm not sure.
<det> oh, a tuple, I understand
<emu> toopal
<Riastradh> Eek! Now the Tuareg mode doesn't work on my other box, either.
<Riastradh> Oh, oops.
<det> let addr = Unix.ADDR_INET((Unix.gethostbyname "www.google.com").Unix.h_addr_list.(0), 80);;
<emu> let there = light;;
<det> was I stupi to think sockets in ocaml would be less painful than C ? :)
<emu> no, you weren't stupid to think that. just use a higher-level interface.
<det> does one exist
<det> or am I writing that myself ?
* emu lets more knowledgeable people answer that one
<phubuh> let open_tv_connection = Unix.open_connection (Unix.ADDR_INET,
<phubuh> ((Unix.inet_addr_of_string "195.43.36.28"), 80))
<emu> at the very least, it's much easier than dealing with the annoyances of allocating structs and etc
<det> phubuh: neat, but it doesnt give me a chance to set it non_blocking (which might I add uses threads on win32 when win32 easily suport non-blocking sockets :( )
<det> oh, Unix.inet_addr_of_string is perfect
<det> thanks
<phubuh> haha, my TV viewing program thingy takes about three seconds to download, parse, and output the swedish TV listings, while the official client takes like half a minute just to download it
<phubuh> my evil plan is to make this thing easily used from the shell, and then make some glue in elisp
<emu> wow, your program must have a better inet connection
<det> This expression has type int -> Unix.file_descr but is here used with type
<det> Unix.file_descr
<det> that makes a lot of sense
<Riastradh> Uh, yes, it does. It takes a function that takes an int and returns a Unix.file_descr, but is passed instead a Unix.file_descr.
<det> oh, partial application woes
* Riastradh curses at Emacs.
<det> val send : file_descr -> string -> int -> int -> msg_flag list -> int
<det> any idea how to use that ?
<whee> what do the docs say :P
<det> they don't say :/
<Riastradh> send <some file descr> <some string> <some int> <some int> <some msg_flag list>
<det> they dont say what the 2 ints are for
<whee> I agree with that one
<whee> heh
<det> all they say is "send some data over a socket"
<whee> sounds good to me!
<whee> but I believe the first int is offset and the second is length
<det> pfft, they should just String.length :)
<whee> it may be easier to get a channel out of the file descriptors and deal with that
<det> ohh
<det> oh do you "write" to a channel ?
<det> s/oh/oh, how/
<whee> you't use the output functions
<whee> check docs for Pervasives for channel functions
<det> - : out_channel -> string -> int -> int -> unit = <fun>
<det> heh heh, there are those 2 ints again :)
<whee> there's output_string :P
<det> great :)
<mattam> do someone ever used the sendto and recvto primitives in C or caml ?
<Riastradh> Weird.
<Riastradh> Now it works.
<det> recvfrom
<whee> Riastradh: You probfably weren't holding your mouth right.
<det> the Unix module supports them
<whee> and I can't type :(
<mattam> I don't exactly understand how it works (In analogy to TCP connections)
<mattam> det: right
<palomer> :o
<whee> sendto's for tcp?
<mattam> I thought I call accept, keep getting clients in a list and sendto each one every time I write... something. But now each client is a connection and I don't see what connection-less mean
<palomer> whats wrong with : let imply v = match v with
<palomer> (true,x) -> x
<palomer> | (false,x) -> true;;
<palomer> val imply : bool * bool -> bool = <fun>
<palomer> erm wait that one is good
<whee> mattam: I'd guess sendto is for UDP only
<whee> it really doesn't mmake sense for TCP to have that, as it's a connectionless function
<mattam> whee: no, I know how to work with TCP, i'd like to use UDP
<palomer> I meant # let equal c = match c with
<palomer> (x,x) -> true
<palomer> | (x,y) -> false;;
<Riastradh> (x,x) -- x is being bound twice.
<palomer> ahh I see
<mattam> whee: my question is : 'why have sendto having a client argument althought it is really connection-less'
<palomer> and theres no way of knowing if x is equal to x
<det> mattam, recvfrom is just like recv except the last 2 arguments get filled in with the source address and the size of the source address (in C)
<Riastradh> x == x is pointer equality, isn't it?
<Riastradh> Er, (==), rather.
<whee> Riastradh: yes, for the most part
<whee> palomer: you might want to look into the "when" construct
<mattam> det: and sendto ?
<Riastradh> palomer - Then: match someTuple with (x,y) -> x == y
<palomer> does haskell have pattern matching?
<whee> or do that, heh
<Riastradh> Of course it does.
<det> mattam, it seems like in ocaml recvfrom just returns an sockarrd instead of passing 2 argumens as pointers
<det> mattam sendto is like send except you also sepcify an address to send it to
<mattam> a client ?
<mattam> ok
<det> well, the destination :)
<det> if you are a server, then yes, a client :)
<mattam> but you have to accept () them before, don't you ?
<det> nope
<det> that is tcp
<mattam> ok
<mattam> the picture is clear now
<det> well, generally TCP, just connection oriented sockets
<whee> with udp you would probably use recvfrom, which may block
<whee> but I don't know
<whee> it probably doesn't block :|
<det> yes, recvfrom can block with UDP
<det> I don't think it can block with sendto
<palomer> is ml gaining clout?
<Smerdyakov> Dude, ML has had hella clout for years now.
<mattam> clout ?
<whee> get a dictionary :)
<mattam> i'm french and have loosed the wonderful webster's plugin of gnome :)
<palomer> losed
<whee> lost
<palomer> lol
<det> why does Unix.recvfrom require a string ?
<mattam> right
<palomer> vive la france
<whee> heh
<mattam> he
<det> does it mutate the string ?
<mattam> probably
<palomer> is it possible to have multiple parameters when matching?
<whee> I believe it does
<whee> palomer: multiple parameters?
<whee> let blah x y = match (x, y) with (.., ..) -> ...
<mattam> hmmm, someone try this url on my server "GET /MSOffice/cltreq.asp?UL=1&ACT=4&BUILD=3124&STRMVER=4&CAPREQ=0 HTTP/1.1" what does MSOffice do here ?
<whee> looks like a standard get request
<whee> heh
<whee> doot doot, hot on the trail of the magical cltreq.asp, which is no doubt another MS security hole waiting to happen
<palomer> ahh
<palomer> so thats how
<whee> palomer: the tuple used in the match is not really constructed, so there's no performance hit or anything
<palomer> is it possible to do it with function notation?
<Riastradh> let blah =
<palomer> let blah = function (a,b) -> dosmotheng;;
<Riastradh> fun Point(x, y) ->
<Riastradh> blah
<Riastradh>
<Riastradh> Er.
<palomer> so it knows I'm trying to pass 2 parameters
<Riastradh> | _ -> foobar
<Riastradh> 'So it knows you're trying to pass 2 parameters?'
<Riastradh> Hrm?
<det> O-M-G, this is pure evil:
<det> # Unix.sendto client_sock "Hello World!" 0 12 [] client_addr ;;
<det> - : int = 12
<det> # let string = "123456789012" ;;
<det> val string : string = "123456789012"
<det> # Unix.recvfrom server_sock string 0 12 [] ;;
<det> - : int * Unix.sockaddr = (12, Unix.ADDR_INET (<abstr>, 3117))
<det> # string;;
<det> - : string = "Hello World!"
foxster has quit []
<whee> heh, don't you love the crap that C drags with it :)
<palomer> what I mean is how does it know how many parameters you passed?
<Riastradh> Technically, you can only pass one parameter.
<whee> palomer: the types would have to match up
<Riastradh> (fun x y -> (x, y)) 5 (* one parameter was passed *)
<Riastradh> (fun x y -> (x, y)) 5 3 (* one parameter was passed, the result of which was applied to the second parameter *)
<mrvn> palomer: match allways takes one parameter and matches that
<det> whee, no! ocaml should just return string!
<mrvn> palomer: (x, y) is actually one thing and not two
<palomer> ahh
<whee> det: write a function that wraps recvfrom to do that
<palomer> hrm
<palomer> ocalm isn't like anything else is it
<Riastradh> Sure it is.
<whee> it's like the other 300 functional languages :)
<Smerdyakov> What is _that_ supposed to mean?
<Riastradh> That kind of function application is called 'currying.'
<det> whee, but I still _know_ of the evil
<Riastradh> It is, as whee said, very common in functional languages.
<det> whee, I want ocaml to shelter me
<whee> det: use java
<mrvn> det: IO has sideeffects, live with it
<whee> ;)
<whee> heh
<whee> mrvn brings up a point, you could go and implement monads in ocaml
<det> mrvn, side effect yes, but those neccesary side effects have nothing to do with mutating a string :(
<Riastradh> That would still be side effectual, whee.
<whee> Riastradh: yes, but it'd technically be purely functional
<det> whee, monads are unrelated to the poor Unix.recv* design!
<Riastradh> (side effectual? Side effective? ...?)
<whee> det: recvfrom is probably a direct interface to the C version
<whee> and the C version most likely behaves the same way
<det> yeah, it is pretty close
<mrvn> det: Use functional strings and rewite the Unix module.
<mattam> side affection i'd say Riastradh
<det> but it changes some things for the sake of ocamlism
<det> and yet it strill mutates a string :/
<whee> it's probably quicker, or something
<mrvn> det: modifying a string is what C does and its way faster
<Smerdyakov> I don't think there's much of a point in making a structure called Unix functional.
<Smerdyakov> Rather, create a separate standardized structure for pretty-boy functions, like Socket in some SML compilers.
<det> but the binding could just create a new string of given length, and pass that to recvfrom and then return that
<det> to create the illusion of functional
<det> same speed
<mrvn> det: That would allocate memory.
<palomer> isn't pattern matching slower?
<mattam> palomer: than what ?
<whee> palomer: than what?
<palomer> not pattern matching:o
<mattam> :)
<mrvn> palomer: most of it is done at compile time
<palomer> for example is:
<det> mrvn, well, unless you use the same string for every recvfrom, you need to allocate memory anyways
<mrvn> palomer: And the other stuff is just neccessary and slower without matching
<mrvn> det: But you probably would use the same string for every recv
<mrvn> det: or a buffer
<palomer> leh blah = function 0-> false | _ -> true slower than let blah = function x if x = 0 false else true ?
<det> mrvn, for udp maybe
<det> doubtful for tcp
<mrvn> palomer: the first is faster, let bla = function x -> x<>0 is even better.
<mrvn> palomer: But any halfway decent compiler should generate equla code for all three.
<palomer> hrm
<palomer> so pattern matching isn't slower than by hand comparisons?
<whee> palomer: you could run ocaml -dlambda and try both expressions, to get an idea of what it's turning into
<whee> roughly, anyway
<mrvn> palomer: function x -> already is pattern matching
<palomer> I guess I need to get the hang of it
<palomer> pattern matching seems to be very powerful
<palomer> I still don't get how to pattern match several parameters not in a tuple though
<mrvn> Also I wouldn't call function 0 -> true | _ -> false pattern matching. Its not a pattern but values that are matched here.
<mrvn> palomer: you can't.
<palomer> hah
<palomer> erm ahh
<palomer> so you need to decompose it into two different functions
<mrvn> Only tuple, constructors and ::
<mattam> night all
<mrvn> palomer: You generate an temporary tuple and hope the compiler optimises it away.
<whee> which it does
mattam has quit ["zZz"]
<palomer> but the tuple has to be generated before you pass it
<palomer> like (some_fun (a,b))
<whee> no, it doesn't
<whee> let blah x y = match (x, y) with ..
<mrvn> palomer: syntactically yes, but thats just for parsing
<palomer> oh
<palomer> is it possible to do it with function syntax
<mrvn> palomer: nope
<palomer> let blah = function | (a,b) ->...
<palomer> ah ok
<palomer> so there is a use for match
<mrvn> Since (a,b) is one parameter of type tuple you would create a function taking a tuple.
<palomer> whew, alot of stuff is gonna sink in tonight
Hellfried has quit ["Client Exiting"]
<palomer> whats wrong with let rec size = function
<palomer> [] -> 0
<palomer> | (_ as rest)-> (size (List.tl rest));;
<palomer> ?
<palomer> ahh woops
<palomer> nm
<mrvn> _ as rest doesn't realy make sense.
<mrvn> | x::xs -> 1 + (size xs)
<palomer> whats xs stand for?
<Riastradh> But that's not a great function either: it's not tail recursive.
<Riastradh> And thus it will probably at some point cause a stack overflow.
<mrvn> let size l = let rec loop s = function [] -> s | x::xs -> loop (s+1) xs in loop 0 l
<Riastradh> Zigackly.
<mrvn> palomer: xs stands for xs.
<palomer> it's not a tail recursion?
<Riastradh> (x :: xs) is a generic convention for matching the head and the tail of a list.
<mrvn> palomer: call it hd::tl if you like or head::tail or something::other
<mrvn> palomer: your function was tail recursive but allways results in 0
<Riastradh> mrvn's modification of it (| x :: xs -> 1 + (size xs)) worked, but isn't tail recursive.
<palomer> it isn't?
<Riastradh> No: the call of size wasn't in a tail position.
<mrvn> palomer: let let size = List.fold_left (fun x _ -> succ x) 0;;
<Riastradh> It's a recursive function, but not tail recursive.
<Riastradh> let let?
<mrvn> palomer: 1 + (size xs) first evaluates (size xs) and then comes back to do the +
<whee> mrvn: that one has the problem of not working on lists of more than one type
<whee> err, phrased that one bad
<whee> it'll work for size [1; 2; 3], but then you can't go use it for size ["a"; "b"; "c"]
<palomer> why?
<whee> the type can't be generalized until the first call
<mrvn> # let size = List.fold_left (fun x _ -> succ x) 0;;
<mrvn> val size : '_a list -> int = <fun>
<mrvn> # let size l = List.fold_left (fun x _ -> succ x) 0 l;;
<mrvn> val size : 'a list -> int = <fun>
<mrvn> Why?
<palomer> why.
<whee> meh, I don'[t know :)
<Riastradh> It somehow doesn't work.
<palomer> works fine for me
<palomer> my version of size anyways
<palomer> the question was for wee
<whee> you have to explicitly put the list in like mrvn did in the second one
<mrvn> palomer: The '_a is not realy polymorphic. Once you used size on an int list its stuck with '_a == int
<mrvn> But why does it get '_a list -> int?
<Riastradh> # let size = List.fold_left (fun x _ -> succ x);;
<Riastradh> val size : int -> '_a list -> int = <fun>
<Riastradh> # size ['a'; 'b'; 'c'];;
<Riastradh> Characters 5-20:
<Riastradh> size ['a', 'b', 'c'];;
<mrvn> you forgot the 0
<whee> you forgot the 0
<Riastradh> Oops.
<whee> haha
<Riastradh> Haha!
<palomer> nuff ocaml for today
<palomer> hrm, my ambition is to make camlmacs
<Riastradh> camlmacs?
<palomer> caml emacs
<palomer> it's gonna be fun!
<Riastradh> Will I be able to run an HTCPCP server in it?
<palomer> HTCPCP?
<Riastradh> HyperText Coffee Pot Control Protocol.
<Riastradh> Someone -actually- wrote a server for it in elisp!
<whee> palomer: RFC 2324, for reference :)
<palomer> anything you can do in ocaml will be able to be done in camlmacs
<Riastradh> Yes, but I want to be able to control it and moniter it and all that stuff in camlmacs.
<palomer> then write a camlmode
<whee> also I want camlmacs to have vim bindings and the same behavior as vim as an option, because I dislike emacs
<palomer> whee: I dislike the emacs bindings too
<Riastradh> But...but...what about us who -like- Emacs?
<Riastradh> And its key bindings.
<palomer> the emacs key bindings are going to be the default
<palomer> the vim keybindings will be loaded via a mode
<palomer> whats nice about ocaml is that I can use an already existing interpreter and I don't have to write exterior functions to make it fast enough
<palomer> im off!
palomer has quit [Remote closed the connection]
docelic has joined #ocaml
<det> would it be possible to mix native code and byte code in a program, for example to make a console for an application that ran what ever you typed into it ?
<det> or is there maybe a better way to do that ?>
xxd has quit ["EOF"]
merriam has joined #ocaml
xxd has joined #ocaml
<whee> I don't think there's an easy way to do that
<whee> other than defining your own language and handling things
<whee> there's no way to eval ocaml code within ocaml; you could use dynlink or whatever to load at runtime, but I don't know other than that
<whee> or reimplement the toplevel heh
<mrvn> bytecode can eval
<mrvn> And you can probably implement a non optimizing ocaml compiler with camlp4 in a day (without type inference)
<mrvn> a ocaml -> cps compiler and then eval the cps.
<whee> well seeing as camlp4 already does all the parsing, it couldn't be that bad
<mrvn> or implement a scheme interpreter in ocaml :)
<whee> or some interface with an existing scripting language structure
<whee> a scheme interpreter would probably be a good idea; easy for someone to figure out
<mrvn> Also very easy to parse and implement
<det> hrmm
<det> I guess I could define my own language
<det> really simple
det has quit ["*poof*"]
foxen5 has joined #ocaml
docelic is now known as docelic|away
gl has quit [Read error: 113 (No route to host)]
mattam has joined #ocaml
polin8 has quit [Read error: 54 (Connection reset by peer)]
polin8 has joined #ocaml
lament has joined #ocaml
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
xxd is now known as xxd_
foxen5 has quit [Read error: 104 (Connection reset by peer)]
foxen has joined #ocaml
TachYon has joined #ocaml
Yurik has joined #ocaml
<Yurik> re
TachYon has quit ["Client Exiting"]
Yurik_ has joined #ocaml
Yurik has quit [Read error: 54 (Connection reset by peer)]
Yurik_ is now known as Yurik
Yurik has quit [Read error: 54 (Connection reset by peer)]
gl has joined #ocaml
asqui has joined #ocaml
<merriam> [09:39:59] <minra> what is ocaml's reason-for-existence?
<merriam> [09:40:07] <minra> what were they trying to do/solve with it?
<merriam> any pointers?
<pattern_> i think ocaml was created to take over the world
<pattern_> :)
<xtrm> :)
<pattern_> "Objective Caml belongs to the ML family of programming languages and has been implemented at INRIA Rocquencourt within the ``Cristal project'' group. Since ML's inception in the late seventies, there has been a continuous line of research at INRIA devoted to implementations and improvements of ML"
xtrm_ has joined #ocaml
lam_ has joined #ocaml
<merriam> i see :)
<pattern_> there might be more here http://www.ocaml.org/ or here http://caml.inria.fr/
<phubuh> hee hee, i love this thing
<phubuh> # List.iter (fun s -> print_string (string_of_show s);print_newline ()) (all_shows_satisfying (open_connection ()) (fun (i,_,_,_) -> interval_spans_time i (current_point_in_time ())));;
<phubuh> 12:10-12:40 SVT 1: Packat & klart
<phubuh> Text-tv 199. Repris från 16/2. Även textat i SVT2 23/2.
<phubuh> 12:05-13:00 TV3: Lois & Clark
<phubuh> Amerikansk dramaserie. Repris från 18/2.
<phubuh> 11:50-12:20 TV4: Det ligger i luften
<phubuh> Australisk dramaserie från 1999.
<phubuh> 12:15-14:55 ZTV: Hitparad
<phubuh> Gamla, nya och kommande hits.
<phubuh> i really don't understand this though:
<phubuh> This expression has type channel but is here used with type channel
<phubuh> i really don't see anything wrong with my code, and hell, even the error message just seems to confirm that my code is, in fact, correct
lam has quit [Read error: 110 (Connection timed out)]
xtrm has quit [Read error: 110 (Connection timed out)]
<phubuh> =( =( =(
<phubuh> haha
<phubuh> i had written a function F, and then i had written a function G. i thought G was more generalized, so I rewrote F in terms of G. a few seconds ago, i realized that G was defined in terms of F
phubuh has quit [Remote closed the connection]
xxd_ has quit [Read error: 101 (Network is unreachable)]
xxd_ has joined #ocaml
systems has joined #ocaml
systems has quit ["Client Exiting"]
TachYon26 has joined #ocaml
phubuh has joined #ocaml
<phubuh> hmm
<phubuh> i keep getting "file tvlang.cmo is not up-to-date with respect to interface Tvlang"
<phubuh> does anyone know what's wrong and/or how to resolve it?
<phubuh> my compile procedure involves cleaning out all binaries, so outdated binaries aren't the problem
<mrvn> phubuh: maybe the two depend on each other and you have no .mli files
rox|verbreiten is now known as rox
<phubuh> hmm, what do you mean by the two?
<mrvn> dunno, whats your commandline?
mellum has quit [Read error: 60 (Operation timed out)]
Hellfried has joined #ocaml
mellum has joined #ocaml
esabb has joined #ocaml
<mellum> Is there some way to import record labels from another module? So I don't have to write foo.Module.x?
esabb has quit ["Client Exiting"]
skylan has quit ["Reconnecting"]
skylan has joined #ocaml
palomer has joined #ocaml
esabb has joined #ocaml
systems has joined #ocaml
<palomer> hrm, I forget how to match to parameters as a pair
<Riastradh> match v with
<Riastradh> x :: xs -> blah
<Riastradh> | ...
<palomer> I would have to match a b
<Riastradh> ?
<mrvn> (a,b)
<palomer> like function a b match (a,b) with...
<Riastradh> fun a b ->
<Riastradh> match (a,b) with
<Riastradh> (1,2) -> blah
<Riastradh> | ...
<palomer> so I can't do it with function notation?
<Riastradh> 'function' doesn't automatically curry the function for you.
<mrvn> function a -> function b -> match
<palomer> so whats the diffence between fun and function?
<Riastradh> 'fun' automatically curries it.
<mrvn> palomer: fun is less to type
<Riastradh> fun is more fun!
<palomer> ahh
<palomer> erm
<mrvn> you only ever need function if you have function [] -> 0 | _ -> 1
<mrvn> fun has no matching
<palomer> so function eliminates the match ..with
<palomer> and fun lets you specify multiple arguments
<mrvn> yes
<palomer> so there is a slight disctinction
<palomer> I see...
<palomer> time for some graph theory
* palomer kills self
systems has quit [Read error: 60 (Operation timed out)]
redcrosse has joined #ocaml
TachYon26 has quit [Remote closed the connection]
TachYon26 has joined #ocaml
coolduck has joined #ocaml
* Riastradh pokes palomer.
<pattern_> # let z = "hello world!";;
<pattern_> val z : string = "hello world!"
<pattern_> # z.[4] <- ' ';;
<pattern_> - : unit = ()
<pattern_> # z;;
<pattern_> - : string = "hell world!"
<pattern_> if variables are immutable in ocaml, why was i able to do that?
<pattern_> i didn't specify that z was a reference... shouldn't it be immutable?
<Riastradh> 'Variables' aren't a concept in OCaml, first of all.
<pattern_> what term should i use?
<Riastradh> Instead there are 'bindings' -- a name points to a specific value.
<Smerdyakov> I guess strings are references in OCaml.
<Riastradh> (at least, I think the term is 'binding')
<pattern_> ok
<Smerdyakov> We call them 'variables' in Standard ML. I don't know about OCaml.
<Riastradh> Strings, being simply arrays of characters, and arrays being mutable, are most likely mutable.
<mrvn> pattern_: strings and arrays are mutable
<pattern_> i see
<Riastradh> You mutated a value, not the environment in which 'z' continued to point to the same value.
<pattern_> thanks for clearing that up, guys :)
<pattern_> # let mylist = 1 :: [] ;;
<pattern_> val mylist : int list = [1]
<pattern_> # let mylist = 2 :: mylist ;;
<pattern_> val mylist : int list = [2; 1]
<Riastradh> You're shadowing the 'mylist' binding.
<pattern_> and here, is the list mutable? or that a new list called mylist?
<pattern_> yes, shadowing, that's the term
<Riastradh> It's not mutating.
<pattern_> isn't shadowing effectively making bindings mutable?
<Riastradh> Nope.
<Riastradh> A binding of mylist to [1] still exists, but you just can't get to it.
<pattern_> well, if i can't get to it, then i can act as if it's mutable, right?
<pattern_> it doesn't matter to me that somewhere i can't get to there's an original mylist, does it?
<Smerdyakov> Your point is not worthwhile.
<Smerdyakov> The "new" binding could just as well be of a new name.
<mattam> but you could retrieve it latter pattern_
<Smerdyakov> The effect is the same.
<pattern_> how could i retrieve it later? i thought i couldn't get to it
<Smerdyakov> It doesn't make sense to "retrieve" a binding. mattam is being odd =)
<mattam> in your example, no, but let mylist = [1;2] in let ... let mylist = mylist :: [1;2] shadows only in a limited scope
<Smerdyakov> But the data to which it points lives on, sinse it's "in" the new list.
<mattam> unmask if you prefer
<Smerdyakov> mattam, that doesn't make sense either
* mattam goes buying shoes
<Smerdyakov> mattam, I think you are confusing names and actual data in the heap
<pattern_> mattam, yes, i understand that if shadowed a binding in a local scope then i would be able to use the original binding when i got back to the global scope
<Smerdyakov> ... unless you weren't talking about pattern_'s particular example
<pattern_> smerdyakov, he was talking about a different, similar, example
<Smerdyakov> Oh, I see it.
<Smerdyakov> I still think you've missed the point if you're worrying about this. =)
<pattern_> i'm not really worrying about it, because it only seems to really apply in the toploop
<Smerdyakov> How so?
<pattern_> well, it's only in the toploop that i can shadow bindings like that, because every binding declaration is implicitly in a new, inner scope, no?
<Smerdyakov> No, rebinding a variable is a common practice for writing clear code in complicated functions.
<pattern_> oh
<pattern_> hmm
<pattern_> then i'm not sure i see the value of maintaining that bindings are immutable
<Smerdyakov> Like I said, the names of bindings are unimportant.
<Smerdyakov> You can change each new bound name to bindingN for the next available N and suitably replace all uses of it.
<Smerdyakov> The fact that you use the same name twice in your code is irrelevant.
<pattern_> i kind of see your point... in c, for example, something may have changed the value of a memory location via a pointer, and you might not be aware of it
<pattern_> in ocaml that can't happen, right? is that the point?
<Smerdyakov> That's not really relevant.
<Smerdyakov> Or maybe it is.
<Smerdyakov> The pure functional fragment of OCaml has no such issues, at least.
<whee> I much prefer not using mutable structures, it's just easier to reason about
<mrvn> pattern_: Unless something is a mutable it can never change in ocaml.
<pattern_> ok, then can you give me an example where having a binding be mutable would have screwed me over, to make clear how having the binding be immutable is advantageous?
<Smerdyakov> You can "save old bindings" in closures.
<mrvn> pattern_: let id x = x let foo x = let id x = 1 in id x
<mrvn> pattern_: if that would mutate id you would be screwed.
<mrvn> let rec fac = function 0 -> 1 | x -> x*(fac (x-1))
<mrvn> let fac x = let y = fac x in Printf.printf "fac(%d)=%d\n" x y; y
<mrvn> pattern_: That also wouldn't work if binding where mutable.
<Smerdyakov> Are you a newcomer to functional languages, pattern_?
<pattern_> smerdyakov, yes... ocaml is my first functional language
<Smerdyakov> Then perhaps a canonical example would be helpful.
<Smerdyakov> let makeConstant n = function _ -> n
<Smerdyakov> The n binding is saved inside the closure for the function that makeConstant returns.
<Smerdyakov> Nothing can ever change it afterwards, for each individual call has a separate version.
<Smerdyakov> Is it clear?
<pattern_> smerdyakov, yes, i understand that nothing could change n... but what would have tried to change n and, were n mutable, have messed something up?
<Smerdyakov> How about this?
<mrvn> pattern_: let const1 = makeConstant 1 and const2 = makeConstant 2
<mrvn> pattern_: in C const2 would mutate const1 to also return 2.
<Smerdyakov> let n = 1 let const1 = function _ -> n let n = 2 let const2 = function _ -> n
<Smerdyakov> If that doesn't show you how this works, nothing will. =)
<mrvn> tcw: echt
<mrvn> ups
<pattern_> hmmm... i thought i had understood your earlier example, but now i'm not so sure... does "let makeConstant n = function _ -> n" mean: "makeConstant takes an argument n, which returns a function that takes an argument _, which returns n"?
<Smerdyakov> Yes. The _ means the value of the argument is ignored.
<mrvn> pattern_: yes
<mrvn> I would write function () -> n
<Smerdyakov> makeConstant 1 () ==> 1
<pattern_> mrvn, if that's the case, then why do you say "let const1 = makeConstant 1" ? shouldn't there be a 2nd argument? or are you doing that for partial evaluation? and why?
<Smerdyakov> It's not really "partial evaluation" in any fancy sense, pattern_.
<Smerdyakov> Every function takes exactly one parameter and returns exactly one value.
<mrvn> pattern_: const1/2 would be functions that allways return some constant.
<mrvn> 1 and 2 in this case
<pattern_> mrvn, yes, right, i'm with you now
<pattern_> still struggling with that concept, as you can see :)
<Smerdyakov> Struggling with what part of it?
<mrvn> pattern_: you need something like that in e.g. Array.init 42 (makeConstant 23)
<mrvn> But you could use Array.make 42 23 there instead
<pattern_> i'm not struggling anymore with the partial evaluation thing, not that you guys went through it step by step with me :) but, as you can see, i did have a problem with it earlier
<Smerdyakov> OK. Is there something in particular that you don't understand now?
<pattern_> yes
<pattern_> back to the following:
<pattern_> let makeConstant n = function _ -> n
<pattern_> <mrvn> pattern_: let const1 = makeConstant 1 and const2 = makeConstant 2
<pattern_> <mrvn> pattern_: in C const2 would mutate const1 to also return 2.
<pattern_> here, isn't "n" effectively a binding in local scope?
<Smerdyakov> That's just a weird statement from mrvn, since C doesn't have closures =)
<Smerdyakov> That's right, pattern_. My second example illustrates things more clearly.
<pattern_> so "let const1 = makeConstant 1 and const2 = makeConstant 2" wouldn't be a problem even for c, right?
<pattern_> because in c that would be like calling a function with two differnt arguments... or am i missing something?
<pattern_> rather, i know i am missing something... what is it? :)
<Smerdyakov> C doesn't have closures.
<Smerdyakov> The question is meaningless.
<pattern_> hmm
<Smerdyakov> Really, you should ignore mrvn's explanation. It is nonsensical. =)
<pattern_> ok
<pattern_> let me try yours
<pattern_> <Smerdyakov> let n = 1 let const1 = function _ -> n let n = 2 let const2 = function _ -> n
<pattern_> so you're saying that here, "let n = 2" does not change const1, right?
<Smerdyakov> Correct
<pattern_> :)
<pattern_> so we didn't even need the "const2 = function _ -> n" part
<Smerdyakov> Eh? I want to use both const1 and const2 in the code that follows.
<pattern_> oh
<Riastradh> May I try to explain?
<pattern_> sure, riastradh.. but i think i get it now
<pattern_> i'm always up for a different perspective, though :)
<Riastradh> let n = 1 in
<Riastradh> let const1 = function _ -> n in
<Riastradh> let n = 2 in
<Riastradh> let const2 = function _ -> n in
<Riastradh> insert code that does stuff with both const1 and const2
<Riastradh> In that code, calling const1 will return 1, always: in const1's environment, n is bound to 1.
<pattern_> yep, i see that now
<Riastradh> In that code, calling const2 will return 2, always: in const2's environment, a new n binding shadows the original (which is n = 1), and n is in that environment bound to 2.
<pattern_> right
<coolduck> but why would one need const1 and const2 as functions?
<pattern_> makes perfect sense now :)
<whee> coolduck: easy way to demonstrate closures
<pattern_> now, i have another question... in the above code, riastradh, do you need all the "in"s ?
<coolduck> whee: and that would be another thing I haven't gotten yet, closures is that like scope?
<Riastradh> pattern, yes, because the bindings are all done sequentially.
<pattern_> what would happen if you didn't use the "in"s ?
<Riastradh> Well...it might work without the 'in's, but using 'in's makes it more blatant that it's done sequentially.
<coolduck> meaning that a closure is the closed space of a function for instance?
<Riastradh> A 'closure' is a function that captures its lexical environment, i.e., 'closes around' the bindings in its lexical environment.
<pattern_> the way i understand it a closure is the function, plus the enviornment that was active when it was declared (includes the "let n = 1" for const1 above)
<Riastradh> Yes, exactly.
<coolduck> ahh, ok
<pattern_> but const2 has a different closure... a closure that has n bound to 2
<Riastradh> Yes.
<pattern_> neat functional language property :)
<Riastradh> The 'n' binding was shadowed in the creation of const2, so const2's lexical environment had 'n' being 2, and so const2 is a function returning 2.
<coolduck> also a hard thing to remember being used to impirative lang.
<Riastradh> Very neat: you can implement any sort of record type you like with it, even without a 'type' declaration or anything.
<Riastradh> It's especially useful in Scheme, where there is no standard 'define-type' or 'define-record' or anything.
<coolduck> meaning one could use a function to "emulate" a record (in lack of better word)
<coolduck> or am i missing the point?
<Riastradh> Yes, that's how.
<pattern_> i'm interested in how you would do that, as well, riastradh
<Riastradh> Do you know any Scheme?
<pattern_> nope... i was referring to your first statement, that you could implement a record without a type declaration
<Riastradh> OK, whatever. I'll just write it in OCaml:
<Riastradh> let makePoint x y =
<Riastradh> Er.
<Riastradh> let pointTag = ["point"] (* some unique tag *)
<Riastradh> let makePoint x y =
<Riastradh> (pointTag,
<Riastradh> fun selector args ->
<Riastradh> match selector with
<Smerdyakov> let makePoint x y = let getX () = x in getY () = y in setX x = makePoint x y in setY y = makePoint x y in (getX, getY, setX, setY)
<Riastradh> Bah!
<Smerdyakov> Which uses what I'm making, but ;-)
<pattern_> one at a time! :)
<Smerdyakov> And needs a rec at the start
<Riastradh> let rec makePoint x y =
<Riastradh> let getX () = x in
<Riastradh> let getY () = y in
<Riastradh> let move dx dy = makePoint (x + dx) (y + dy) in
<Riastradh> (pointTag, getX, getY, move)
<Riastradh> ...would be much better.
<Smerdyakov> "Much better"? =D
<mellum> If I have let loop =... if foo then loop bla else loop blub, will the compiler be clever enough to make it tail recusive?
<Smerdyakov> mellum, tail recursiveness is a property of your code
<Riastradh> mellum, if <cond> then <tail position> else <tail position>
<Smerdyakov> mellum, if you're asking if the compiler will do this without growing the stack, yes.
<Riastradh> Note the placement of <tail position>.
<mellum> Smerdyakov: fine
<Riastradh> If your calling of 'loop' is right in that position, then it is tail recursive.
* Riastradh curses, and goes out to shovel some more snow.
<pattern_> thanks for your help, riastradh!
<pattern_> and yours too, smerdyakov
<pattern_> now i need some time to digest your code :)
<Smerdyakov> One thing to point out is that this "clever record stuff" is entirely syntactic sugar, since it depends on already having tuples.
<Smerdyakov> Tuples are a special kind of record with labels forced to be consecutive naturals starting at 1.
<Smerdyakov> And you can quite well map your labels to such a range in your head.
<Smerdyakov> We could get around this circularity by returning a single function that dispatches on the particular method you want based on some parameter.
<emu> aren't the natural numbers so grooovy
<emu> you can talk in terms of them, and then it's just 123...
<Smerdyakov> Hit me on the web at www.shutup
<emu> excellent idea for a site!
Hellfried has quit [Read error: 104 (Connection reset by peer)]
TachYon26 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
mrvn_ has joined #ocaml
mrvn has quit [Killed (NickServ (Ghost: mrvn_!mrvn@pD95198E5.dip.t-dialin.net))]
mrvn_ is now known as mrvn
<mrvn> re
<mrvn> You can do functional tuples or records:
<mrvn> type ('a,'b) tuple_res = First of 'a | Second of 'b;;
<mrvn> let tuple x y = function 0 -> First x | 1 -> Second y;;
<mrvn> let tupple_first t = let First x = t 0 in x;;
<mrvn> let tupple_second t = let Second x = t 1 in x;;
<emu> tupple-ware
<whee> hhe
<whee> tewpalwhere!
<mellum> Does anybody know whether ocamlopt does inlining across modules?
<mrvn> How could it?
<mellum> What would keep it?
<mrvn> ocamlopt only looks at the one ml file and then mli files.
<mrvn> The other sources files could be missing alltogether.
<mellum> It could do that at link time.
<mrvn> probably could, but I doubt it
<mellum> Or look whether a .cmx or whats it called is present/.
<mellum> I guess I should just try :)
<mrvn> mellum: Do you have a cpp grammar that keeps indentation infos?
<mellum> cpp grammar?
<mrvn> c preprocessor
<mellum> not really
bubba1034 has joined #ocaml
<bubba1034> Can anyone point me to an upto date web page on using SWIG and OCaml?
bubba1034 has left #ocaml []
esabb has quit ["Client Exiting"]
<pattern_> mrvn, i have a question about the example you posted earlier:
<pattern_> type ('a,'b) tuple_res = First of 'a | Second of 'b;;
<pattern_> let tuple x y = function 0 -> First x | 1 -> Second y;;
<mrvn> yes?
<pattern_> what binding is being matched in the tuple function? x or y?
<mrvn> neigther
<mrvn> let tuple x y = function z -> match z with 0 -> First x | 1 -> Second y;;
<pattern_> i see!
<pattern_> that makes much more sense
<pattern_> :)
<mrvn> The z is implizit when doing matching with the function keyword
<pattern_> so you'd use that by saying: "tuple (1,2) (3,4) 0" ?
<mrvn> let my_tuple = tuple 1 2
<mrvn> That would be a functional tuple of the two ints 1 and 2.
<mrvn> A tuple is then a function int -> tuple_res
<mrvn> The tuple_res is needed to make tuples of different types.
<mrvn> let my_tuple = tuple "Hallo" 1.0
<pattern_> hmm... but ocaml tells me that:
<pattern_> val tuple : 'a -> 'b -> int -> ('a, 'b) tuple_res = <fun>
<pattern_> doesn't there have to be a third argument, "z"?
<mrvn> yes and no.
<mrvn> The third argument is used later to access eigther the first or the second part of the tuple.
<pattern_> oh, i see
<pattern_> ok, i'm with you now
<mrvn> The z can be called a selector.
<pattern_> sorry i'm so slow
<mrvn> Its unfamiliar to have functions as the return value of something.
<pattern_> definately
<Riastradh> Defin_I_tely.
<mrvn> The look like they still need another argument but thats on purpose often.
<pattern_> my habits keep insisting that all functions be called with full arguments... somehow, i keep forgetting that you can do partial evaluation :)
<pattern_> thanks, riastradh :)
<mrvn> I allways wonder i there would be a way to somehow show the (nonexisting) difference in the type.
<mrvn> # let foo a = function () -> a;;
<mrvn> val foo : 'a -> unit -> 'a = <fun>
<mrvn> val foo : 'a -> (unit -> 'a) = <fun> might be more to my liking.
<mrvn> That would more clearly show that foo takes one argument and returns a function.
<Riastradh> The problem with that is that with curried functions, functions of 'multiple arguments' are -EXACTLY- the same as functions that take one argument and return another function.
<pattern_> why would you use "function ()" ? and how could a "function ()" outpu an "a" ?
<Riastradh> mrvn, 'foo' then returns a function that returns the argument to 'foo'.
<mrvn> pattern_: () has type unit. It like any other thing. Just like function 1 -> or function _ ->
<Riastradh> Didn't we go over closures with you already?
<mrvn> Riastradh: the difference is just the intention of the programmer.
<pattern_> oh, nevermind... i was just confused
<Riastradh> mrvn - Zigackly, so we need to write mind-reading compilers.
<pattern_> i think i understand now
<Riastradh> mrvn, although, you could just write it as: val foo : 'a -> (unit -> 'a) in the .mli file.
<mrvn> Riastradh: let foo a () = a could be val foo : 'a -> unit -> 'a = <fun>
<mrvn> let foo a = function () -> a could be val foo : 'a -> (unit -> 'a) = <fun>
<mrvn> Both types are equal so it wouldn't harm if the compiler guesses wrong.
<mrvn> Riastradh: When I write types somewhere I actually do that.
<pattern_> type ('a,'b) tuple_res = First of 'a | Second of 'b;;
<pattern_> let tupple_first t = let First x = t 0 in x;;
<pattern_> mrvn, could i impose on you to explain this second line to me?
<pattern_> how would i use tupple_first?
<pattern_> tupple_first 1 (1,2) ?
<pattern_> i'm completely confused
<mrvn> let my_tuple = tuple "Hallo" ['H';'A';'L';'L';'O']
<pattern_> yes, i see that that my_tuple would now be ready to be called with a single int argument, which, if 0 would return "Hallo" and, if 1 would return "['H';'A';'L';'L';'O']", right?
<mrvn> tuple_first my_tuple 0
<pattern_> why would you need tuple_first? couldn't you just say: "my_tuple 0" to get "Hallo" ?
<mrvn> No, First "Hallo"
<pattern_> i don't follow
<mrvn> # let my_tuple = tuple "Hallo" ['H';'A';'L';'L';'O'];;
<mrvn> val my_tuple : int -> (string, char list) tuple_res = <fun>
<mrvn> # my_tuple 0;;
<mrvn> - : (string, char list) tuple_res = First "Hallo"
<mrvn> # tuple_first my_tuple;;
<mrvn> - : string = "Hallo"
<pattern_> so what is First "Hallo"?
<pattern_> i know you defined it as a type
<pattern_> but i'm not getting it... it can't be a true tuple, because it's not in the form ('a,'b)
<mrvn> Its the result of the constructor First with argument "Hallo"
<mrvn> pattern_: Imagine you don#t have tuples. Thats how you can make something equivalent.
<mrvn> And with an untypes functional language you can even omit the type.
<mrvn> s/untypes/untyped/
<pattern_> right... so that in the type statement ('a,'b) didn't represent a true tuple but what? just two arbitrary types seperated by a comma and in parenthesis?
<pattern_> i thought i'd understood how types worked... but i guess now i'm all confused again :(
<pattern_> i should go back and reread the type section in the tutorial
<mrvn> pattern_: Thats actually a tuple in the type but thats because its a typed language.
<mrvn> pattern_: you can't get around tuples alltogether in a typed language.
<mrvn> type ('a,'b) tuple_res would be a meta-tuple
<Riastradh> It's just a way to apply multiple type parameters to tuple_res.
asqui has quit [Read error: 104 (Connection reset by peer)]
<pattern_> ok, i think i almost got it
<mrvn> pattern_: In untyped languages you just write
<pattern_> i'm this --> <-- close
<mrvn> let tuple a b = function true -> a | false -> b;;
<mrvn> or 0/1 if you like that more
asqui has joined #ocaml
<pattern_> so the type statement means that something in the form of a tuple, gets the first part, 'a, converted to a "First 'a", etc.. and "First 'a" is just syntax from which tuple_first can extract the 'a
<mrvn> pattern_: When you hear a lecture about functional programming they usually start of with just function. From that you can build yourself an "if", tuples, lists, arrays, ...
<mrvn> pattern_: The type is just there so that tuple a b has a proper type.
<mrvn> pattern_: # let tuple a b = function true -> a | false -> b;;
<mrvn> val tuple : 'a -> 'a -> bool -> 'a = <fun>
<mrvn> Without the type you could only create tuples of equal types, like int*int or char*char. But no float*string tuples.
<pattern_> oh, i see
<pattern_> no, wait, i thought normal tuples could be made up of elements of different types in ocaml, without your special type difinition, no?
<pattern_> it was only lists that had to be made up of elements of the same type, right?
<mrvn> pattern_: (a, b) can be different types. Thats why I made the type in "let tuple a b"
<pattern_> ok, i think i'm just getting more confused by all this
<mrvn> pattern_: just ignore it, wasn#t directed to you
TachYon has joined #ocaml
<pattern_> damn... so there go my hopes for writing a better ocaml compiler tonight
<pattern_> hehe
<pattern_> but i appreciate you taking the time to help me, mrvn
<pattern_> i think i just need to read another tutorial or something
coolduck has quit ["Client Exiting"]
<emu> tuplewar
<mattam> mrvn: arrays from functions ?
<mrvn> functional arrays or via an env variable
<mattam> that would be funny to see someone saying 'here are functionnal arrayes: function 0 -> .. | 1 -> ... ' that would surely be inneficient in practice wouldn't it ?
<mattam> an env variable ?
<mrvn> mattam: efficiency is not realy the first thing you think about talking about functional programming basics, like lambda calulus, churches numbers ...
docelic|away is now known as docelic
<mattam> sure
<mrvn> mattam: If you define numbers via lambda expressions just thing about how lsow exponentiation will be
<mrvn> mattam: and you wouldn't have pattern matching at first.
<mattam> i thought you talked about implementation, my bad :)
<mrvn> nah, way to ineficient.
<mattam> hmmm, what are churches numbers ?
<mrvn> Actually "Churchill's numbers"
<mattam> is it Winston's numbers ?
<mrvn> could be the same
<mrvn> Historically, this was first done for the lambda calculus by Alonzo Church; his so-called "Church numerals" are a set of terms whose behavior mimics that of the usual numeric constants and operators by modeling a number n as an n-fold functional composition.
<mrvn> so its actually church numerals
<mattam> k
<Riastradh> 'I am not a Church numeral; I am a free variable!'
<mrvn> rofl
<mattam> :)
docelic is now known as docelic|sleepo
* Riastradh ought to see more Prisoner episodes.
<emu> Secular calculus
malc has joined #ocaml
TachYon has quit [Remote closed the connection]