Taaus changed the topic of #ocaml to: http://caml.inria.fr/oreilly-book/
kjs3 has quit [Read error: 110 (Connection timed out)]
tav`` has quit [Read error: 104 (Connection reset by peer)]
tav`` has joined #ocaml
<timmy> anyone here use zoggy?
<timmy> i don't understand the use of the ignore keyword in the example in section 2.3
scipient has quit [Read error: 104 (Connection reset by peer)]
thelema is now known as thelema|away
InfernoZero has joined #ocaml
<InfernoZero> ?
InfernoZero has left #ocaml []
puffin has quit [carter.openprojects.net irc.openprojects.net]
Yurik has quit [carter.openprojects.net irc.openprojects.net]
Taaus has quit [carter.openprojects.net irc.openprojects.net]
timmy has quit [carter.openprojects.net irc.openprojects.net]
Taaus_ has joined #ocaml
Yurik has joined #ocaml
timmy has joined #ocaml
Taaus_ is now known as Taaus
Yurik has quit ["restart X"]
owll has joined #ocaml
Yurik has joined #ocaml
tav`` has quit [Read error: 104 (Connection reset by peer)]
Yurik has quit [Remote closed the connection]
Yurik has joined #ocaml
* owll is away: 30 min away
puffin has joined #ocaml
<puffin> so this is where you all are!
<puffin> I've been in a netsplit ghetto
Yurik has quit [Read error: 104 (Connection reset by peer)]
Yurik has joined #ocaml
Yurik is now known as Peer
Peer is now known as Yurik
* owll is back (gone 01:00:08)
Miwong has joined #ocaml
<Miwong> hello
<Yurik> Miwong: hi
<Miwong> Always so quiet here?
<Yurik> well, mostly always
<Miwong> mm
<Miwong> Who are you?
<Yurik> mm... strange question. in which sense?
<Miwong> What's your occupation, where are you from, and how old are you? :)
<Yurik> i'm a programmer/analyst from Ukraine, 20 years old :)
<Miwong> You use ocaml at work?
<Yurik> no, i don't use ocaml at work
<Yurik> i use ocaml for opensource development
<Miwong> You wrote something that's publicly avaliable?
<Yurik> it WILL be publicly available
<Yurik> and in process of developemnt, it is avail at repository
<Miwong> What is it? :)
<Yurik> however, it is in rewrite now, so nothing interesting in repository currently
<Yurik> it
<Yurik> it's a project for enterprise automation framework
<Miwong> Sounds cool ;)
<Miwong> Where do I get it?
<Yurik> nothing specific on the site at the momemnt: www.openeas.org
<Yurik> we're just a small team, so quite slow and have no time to publish each item of decisions and design
<Dieb> hello
<Yurik> Dieb: hi
<Dieb> Miwong: and about you? who are you? ;)
<Miwong> Yurik: Looks nice
<Yurik> heh :)
<puffin> ooh, people! :)
<Miwong> Dieb: I'm a soldier in the Israeli army, got interested in ocalm after seeing it mentioned in some discussions on a couple of mailing lists
<Dieb> Miwong: ok.
<puffin> where did you see it mentioned, out of interest?
<Miwong> Recently on the Csound and the SmallEiffel mailing lists.
<Miwong> puffin: What are you doing with ocaml?
<puffin> Miwong: Just playing and learning, at the moment
<Dieb> i also saw some discussion about ocaml. somebody said that he saw a benchmark that placed 1° C - 2° Ocaml and 3° C++ in performance term
<Miwong> Dieb: Who are you? ;)
exa has joined #ocaml
<exa> hi
<Yurik> exa: hi
<Dieb> heu.. just a newbie in ocaml ;).
<Dieb> exa: hello
<exa> Yurik Dieb hi
<exa> oreilly book is online!
<exa> fantastic!
* exa bookmarks and reads the preface!
<Dieb> Miwong: i'm not a programmer. i just begin to learn. i work in a technical computer support
<Miwong> Dieb: ok
<Dieb> exa: it is online for a while, isn't it?
<exa> Dieb: I just noticed it!
<exa> docs on ocaml are great
<Miwong> Yurik: Is the old source of aes availiable?
<Dieb> exa: yes
<Yurik> Miwong: well, all in repository
<Yurik> and some of them only on my disk
<Miwong> Yurik: How do I get there?
<Miwong> (the repository) :)
<Miwong> thanks
<Yurik> Miwong: but here is a mistake
<Yurik> s/here/there/
<Miwong> >?
<Yurik> just 1 sec
<Yurik> instead
<Yurik> View: //depot/eas/... //{client name that you've invented}/
<Yurik> should be
<Yurik> View: //depot/... //{client name that you've invented}/
samx has joined #ocaml
<Miwong> ok
<samx> good afternoon
<puffin> http://www.bagley.org/~doug/shootout/ -- the benchmark which places ocaml second
<exa> right after C
<exa> and if you look the numbers are pretty close :)
gl has joined #ocaml
<puffin> very impressive, especially for a functional language
<samx> most modern functional languages support imperative constructs, so there's really no big reasons why they should be any slower than imperative ones
<puffin> true, as ocaml proves.
<exa> in haskell i had great pains with binary I/O :((
<puffin> historically they have tended to be slower, and I imagine that most working programmers perceive them that way
<Miwong> c'ya later
Miwong has left #ocaml []
<exa> my advisor thinks C++ is slower than C, so he tells me to implement parallel algorithms in C, which I don't :)
<puffin> hmm, does haskell exactly support imperative constructions?
<exa> puffin: through Monads
<exa> puffin: an abstraction of the state of the world basically for all IO operations
<samx> well, i don't think ML languages have even been too slow.. and for most the other type functional languages.. most of them are done as research tools, and the researchers are too busy/too uninterested in making high quality (compilation wise) implementations
<exa> puffin: and stateful objects
<exa> I want to go into ocaml now really deep
<samx> ...then there is Clean, which is a functional language quite much like Haskell.. it supports imperative constructs more straightforward than haskell
<exa> I want to eventually stop using C++
<puffin> exa: I know about monads. what are stateful objects?
<exa> puffin: I meant things like arrays that you can modify
<exa> puffin: they use monads for all sorts of things
<exa> which is way too much overhead
<exa> and btw, using tail recursion for a simple loop isn't the best way to go about those things
<exa> you can't write a damn algorithm as it should look :)
<puffin> I love monads, they always make me laugh
<exa> well
<exa> the problem with monad is that it's too simple
<exa> arrows are better, gives you much more "categorical" feel
<exa> but still i'm not sure if that's really a usable programming style, yet.
<puffin> exa: I've read _generalising monads to arrows_ - any other references for arrows?
<puffin> the "categorical" feel is my main problem with monads anyway. you're not going to be able to persuade programmers to learn category theory when they could always use a different programming language :-)
<samx> i've been playing with different functional languages for few years now, and I still can't understand what monads / arrows actually 'win' you
<puffin> equational reasoning is the big selling point isn't it?
<puffin> you can do quasi-imperative programming, but still reason equationally at the end of it all
<samx> e.g. compared to ml type imperative io constructs.. sure you can claim that monadic io is 'pure', but as far as i can see, they will make the programs as hard to understand if you just used imperative io..
<samx> yes, maybe they will win something for mathematical reasoning, but i'm more of a practical programmer, and i can't see that mathematical reasoning about programming is reality yet, nor will it be for years/decades to come
gl has quit [No route to host]
<puffin> samx: indeed
gl has joined #ocaml
<exa> maybe arrows can
<exa> but monads hardly
<exa> because monads just specify a dumb form of sequential code
<exa> which isn't interesting
<exa> puffin: a monad has a single object, and arrows from this object unto itself....
<exa> puffin: arrows are more general
<exa> that's all i remember from my category theory textbook hahaha
<exa> arrow isn't of course a good name for anything prolly
<exa> because it's not the same thing as "arrow" in category theory I think.......
<exa> it can't be :)
<puffin> exa: you sure you aren't confusing monad and monoid?
<puffin> I haven't got quite as far as monads in MacLane yet, so I can't be too sure... ;)
<exa> nah sure I am
<exa> :)
<samx> i've tried to look into category theory a few times, but i slept through too many of my calculus lectures when i still was in university, to be able to understand it easily enough :-(
<exa> okay
<exa> let's go concrete
<exa> a monad is something like:
* exa looks up an example
<samx> ..and using a week to figure some small thing out, just to realize it was totally trivial, and non understandable only because i wasn't familiar with the notation was kind of depressing :-)
<exa> readSessionList :: Handle -> IO [Session]
<exa> readSessionList h =
<exa> do session <- readSession h
<exa> case session of
<exa> Nothing -> return []
<exa> Just s -> do rest <- readSessionList h
<exa> return (s:rest)
<exa> This is how you basically use monads in haskell
<exa> " IO a" type is a monadic thingie here
<exa> It allows you to use the syntactic sugar called "do"
<exa> and <- operator
<exa> that allows you to write in a semi-imperative style
<samx> i do know how to use monads in haskell.. i just don't understand what they in reality buy you over ml type io..
<exa> because it's free of side effects
<exa> there aren't any side effects here if you don't use such dangereous functions :P
<exa> but it's not a that big win
<exa> because programming like that is PITA
<samx> only in mathematical sense.. they still cause side effects outside of the haskell environment.. pushing all dirty stuff 'outside' doesn't in my opinion solve any problems
<exa> so better not to do any IO? ;)
<puffin> even Haskell has its "unsafePerformIO", though they like to keep quiet about it :-)
<exa> this stuff is "type-safe assignment" so it's good
<exa> I mean you could argue that this would be useful in a high level programming environment
<exa> But for simple shit like that you don't need it :)
<exa> It took 2 whole days for me to port a binary database reader from C++ to haskell
jemfinch has joined #ocaml
<samx> hi jem, long time no see
<jemfinch> is anyone here who knows SML? (this is the only ML-related channel on this server :))
<jemfinch> samx: yeah, it's been a long time...school's been tough on me :)
<samx> no it's not, i'm on smlnj and sml ;-)
<jemfinch> well, we might as well talk here if we're going to be the only ones on those channels :)
<samx> hey, we used to be the only ones in this one too, almost :-)
<samx> what's your problem with sml? i likely don't know how to help, but i'd like to hear it anyway :-)
<jemfinch> I'm just figuring out some of the syntax, writing a more complicated higher-order function until I get it right :)
<jemfinch> also trying to get the exception-catching code right.
<jemfinch> let bracket
<jemfinch> (before : 'a -> 'b)
<jemfinch> (after : 'b -> unit)
<jemfinch> (f : 'b -> 'c)
<jemfinch> (init : 'a) =
<jemfinch> let x = before init in
<jemfinch> let res =
<jemfinch> try f x with exn -> after x; raise exn
<jemfinch> in
<jemfinch> after x;
<jemfinch> res
<jemfinch> I'm translating that into SML.
<samx> sorry, but can't help you with that.. i'm just changing from ocaml to smlnj myself, and not familiar enough with the syntax yet
<Yurik> samx: why are you changing ocaml to smlnj?
<Yurik> samx: just curios
<Yurik> samx: just curious
<exa> heh
<exa> or is SML better? ;)
* jemfinch likes it better.
<samx> yurik, it has some nice features ocaml doesn't have (works other way too), but i just find the way ocaml development group treats (=ignores) the developer community very offputting
<Yurik> samx: does smlnj has native code compilation?
<samx> yurik, yes
<jemfinch> samx: can SML catch any exception? I mean, can I have something like, "handle exn => ..." which catches all exceptions?
<Yurik> samx: how efficient comparable to ocaml?
<exa> what's better about SML in a nutshell?
<jemfinch> Yurik: smlnj doesn't have anything but native compilation :)
<jemfinch> Yurik: it's not quite as fast as O'Caml, I think.
<samx> jem: yes it can.. a sec and i'll try to figure the syntax
<jemfinch> exa: I like the SML's namingScheme better than O'Caml's naming_scheme, I like that SML uses an option type as a return value most of the time instead of raising an exception like O'Caml does, I like that SML focuses a bit more on safety than O'Caml does, etc.
<samx> yurik: it produces efficient code, maybe a bit slower than ocaml (though not sure anymore - they have lately been working on optimizations).. but then again they have continuations, which i'm sure takes a bit of possible efficience away compared to ocaml
<jemfinch> I like that SML has the ability to execute arbitrary code...
<jemfinch> I like SML's continuations, and CML, its concurrency library.
<samx> ...SML also has a 'compilation manager', instead of having to use make, like ocaml.. although i don't really know much about it :-)
<jemfinch> samx: did you know that? That you can use exportML and then, inside your program, use Compiler.Interact to evaluate arbitrary strings?
<samx> jem, no i did not
<exa> so what are continuations good for, in practical sense?
<jemfinch> samx: it's typesafe because the type of the expression evaluated has to be unit, but it can still do stuff like call functions with side effects and things like that.
<jemfinch> exa: everything.
<exa> jemfinch: what's the prototypical example for their in SML?
<exa> their use in
<Yurik> and what about libs for SMLnj?
<jemfinch> Continuations can be used to implement almost everything you've seen in programming languages. Especially, though, they're useful for implementing lightweight threads, coroutines, and generators.
<jemfinch> samx: have you fit your head around property lists in SML yet?
<samx> jem, i'm sorry, you are way beyond me :-)
<jemfinch> I can write the bracket function without the exception handling, but I can't figure it out with the exceptions handling.
<samx> fun foo x = x + 1 handle _ => 10;
<samx> fun foo x = x + 1 handle Foo => 10 | _ => 11
<jemfinch> but I need to catch any exception and re-raise it.
<samx> fun foo x = x + 1 handle e => raise e
<jemfinch> - fun bracket pre post f init = let
<jemfinch> = val x = pre init
<jemfinch> = val ret = f x
<jemfinch> = val () = post x
<jemfinch> = in
<jemfinch> = ret
<jemfinch> = end;;
<jemfinch> val bracket = fn : ('a -> 'b) -> ('b -> unit) -> ('b -> 'c) -> 'a -> 'c
<jemfinch> that one works...
<jemfinch> this one doesn't:
<jemfinch> - fun bracket pre post f init = let
<jemfinch> = val x = pre init
<jemfinch> = val ret = f x handle e => post x; raise e
<jemfinch> = val () = post x
<jemfinch> = in
<jemfinch> = ret
<jemfinch> = end;;
<jemfinch> stdIn:129.37-130.6 Error: syntax error: deleting RAISE ID VAL
<jemfinch> stdIn:130.7-130.11 Error: syntax error: deleting LPAREN RPAREN EQUALOP
<jemfinch> stdIn:130.12-131.3 Error: syntax error: deleting ID ID IN
<samx> you need: (post x; raise e)
<jemfinch> ah, good :)
<jemfinch> I want to write a testing module for SML, and have been looking a bit at Fort.
<samx> is there any smlnj users mailing list?
<samx> or sml users mailing list for that matter?
<jemfinch> no, I haven't seen one. There's comp.lang.functional, though.
<samx> ...and comp.lang.ml but that one is pretty quiet
* jemfinch has an appointment, he'll have to chat later :)
<samx> cya
<jemfinch> samx: I'm glad to see I won't be alone in my SML switch :)
exa has quit ["using sirc version 2.211+KSIRC/1.2.1"]
exa has joined #ocaml
<exa> re
<Yurik> exa: wb
owll has quit ["Client Exiting"]
exa is now known as exa-cooking
exa-cooking is now known as puts
puts is now known as exa
<timmy> anyone here use lablgtk in ocaml and know how i can hide a window? i only see a show function
<smkl> perhaps misc#hide ?
<timmy> This expression has type GWindow.window
<timmy> It has no method hide
<samx> it should inherit GObj.widget through window_skel and container.. and widget has misc, which has hide method
<timmy> ohhhh
* Yurik is away: wine!
<timmy> so my_window#misc#hide () ?
<samx> yeah
<timmy> ok it works
<timmy> thanks
<Dieb> i've a pb : a function fill a list, another put all the list in a vector, element by element. this work fine. However when i modify the vector, the list is also modified! and i've no function whixh do this behaviour! is there a simple raison?
<Taaus> Hmm... Sounds as if the vector isn't a deep copy of the list... I don't know enough about O'Caml to tell you how to get around that, though :/
exa has quit ["using sirc version 2.211+KSIRC/1.2.1"]
<samx> can you cut&paste some of the code?
<Dieb> yes :
<Dieb> (* Donne la taille d'une liste en nb d'elements
<Dieb> Return the size of a list in nb of elements *)
<Dieb> let rec size_list liste = match liste with
<Dieb> [] -> 0
<Dieb> | _::tail_list -> 1 + (size_list tail_list) ;;
<Dieb> (* Remplis le vecteur de manière récursive a partir d'une liste
<Dieb> Fill vect recursively from a list *)
<Dieb> let rec fill_vect liste vector vector_ind =
<Dieb> vector.(vector_ind) <- (head_list liste);
<Dieb> if (size_list liste) > 1 then fill_vect (tail_list liste) vector (vector_ind + 1);;
<Dieb> (* Définit et rempli un tableau équivalent a la liste des taches
<Dieb> Define and fill an array image of the task list *)
<Dieb>
<Dieb> let const_array tasks_list = let tasks_vect = make_vect (size_list tasks_list) null_task in
<Dieb> fill_vect tasks_list tasks_vect 0;
<Dieb> tasks_vect;;
<Dieb> type tasks = {name: string; mutable prev_task: string list; cost: int; mutable executed: bool};; (for understanding if necessary)
<Taaus> Hmm.. How is head_list defined? (And why are you using size_list instead of List.length? :)
<samx> if you want referencial transparency, you should make copies of the records, now the list and array will just refer to the same instances of the records
gl has quit [No route to host]
<Dieb> Taaus: because when i began i didn't know this functino
<Dieb> samx: how can i do this?
<Taaus> Dieb: Ah :)
<samx> let task = { name = "foo" .... } in let task2 = { task with name = task.name } in ... should do it at least, i think
<samx> anyway, dinner on the table, need to go
<Dieb> well, thanks... but i don't know the length of the list, entered by user.. so the copy is made in a loop
<Dieb> in fact i need to convert a task list in a task vect, since i don't know in advance the data length entredre by user
<Dieb> is there another way to put any value in a vect, than " <- "?
<timmy> i have a Unix.Unix_error that i don't understand that has to do with sockets: Transport endpoint is not connected: error from recv() function
<Dieb> timmy: sorry. i don't know.
<timmy> np
<Dieb> timmy: do you know how can i copy an entire undefined size list to a vector?
<timmy> vector is not an array type?
<Dieb> yes i beleive
<timmy> then i dunno
<Dieb> ok it doesn't matter, thanks.
<Taaus> val of_list : 'a list -> 'a array
<Taaus> Array.of_list l returns a fresh array containing the elements of l.
<Taaus> If that helps :)
<Dieb> thx, i will check
<Taaus> Hmm... Actually, I'm not even sure that helps...
malc has joined #ocaml