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
lindril has quit [Read error: 54 (Connection reset by peer)]
lindril has joined #ocaml
Kinners has joined #ocaml
asquii has joined #ocaml
asqui has quit [Read error: 110 (Connection timed out)]
asquii is now known as asqui
graydon has left #ocaml []
gehel has quit ["changing servers"]
gehel has joined #ocaml
skylan has quit [Read error: 60 (Operation timed out)]
skylan has joined #ocaml
Kinners has quit [Read error: 104 (Connection reset by peer)]
mattam has quit [Read error: 60 (Operation timed out)]
lament has joined #ocaml
matkor has quit [Read error: 60 (Operation timed out)]
iusris has left #ocaml []
docelic|sleepo is now known as docelic
uzdav has joined #ocaml
<uzdav> I have a dual cpu machine running SMP linux (RH 7.2). I configured ocaml with the -with-pthreads option, and built it. When I run my application, I see that a native thread was actually spawned (as two entries show up in "top"). The problem is that they seem to be scheduled on the same CPU, and so the program is not taking advantage of my other CPU, and takes just as long as the non-threaded version. Is there any way to get both CPUs to be us
<uzdav> ed in parallel?
<emu> is your application multi-threaded?
<uzdav> Yes.
<uzdav> When I run top, I see two entries, both taking 50% of the same CPU. My other CPU remains idle.
<emu> sounds like a kernel issue to me
<uzdav> Any idea what I should be looking for?
<uzdav> Today is the first time I've used ocaml threads, so I'm probably doing something wrong. :)
<uzdav> But you are saying that it should be possible to get "100%" usage out of both CPUs using ocaml?
<uzdav> (The documentation isn't very clear about that.)
uzdav has quit [Excess Flood]
uzdav has joined #ocaml
uzdav has quit ["[x]chat"]
uzdav has joined #ocaml
<uzdav> For anyone interested in my question, I think I found the answer to my thread question. In Xavier's own words:
<uzdav> In summary: there is no SMP support in OCaml, and it is very very
<uzdav> unlikely that there will ever be. If you're into parallelism, better
<uzdav> investigate message-passing interfaces.
<uzdav> - Xavier Leroy
<uzdav> good night.
uzdav has left #ocaml []
Kinners has joined #ocaml
polin8 has quit [Remote closed the connection]
polin8 has joined #ocaml
Kinners has left #ocaml []
mattam has joined #ocaml
docelic has quit [" owl"]
matkor has joined #ocaml
foxen5 has quit [Read error: 104 (Connection reset by peer)]
foxen5 has joined #ocaml
matkor has quit [Remote closed the connection]
docelic has joined #ocaml
karryall has joined #ocaml
foxen5 has quit [Read error: 104 (Connection reset by peer)]
foxen5 has joined #ocaml
kor has joined #ocaml
docelic has quit ["checking out something"]
esabb has joined #ocaml
TachYon26 has joined #ocaml
skylan_ has joined #ocaml
TachYon26 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
docelic has joined #ocaml
mattam_ has joined #ocaml
skylan has quit [Read error: 110 (Connection timed out)]
mrvn_ has joined #ocaml
skylan_ is now known as skylan
mattam has quit [Read error: 110 (Connection timed out)]
kor has quit ["spicy in here"]
mrvn has quit [Read error: 110 (Connection timed out)]
Yurik has joined #ocaml
Yurik_ has joined #ocaml
Yurik has quit [Read error: 54 (Connection reset by peer)]
Yurik_ is now known as Yurik
Zadeh_ has joined #ocaml
Zadeh has quit [Read error: 54 (Connection reset by peer)]
Yurik has quit [Read error: 54 (Connection reset by peer)]
docelic is now known as nudedude
clog has quit [^C]
clog has joined #ocaml
lament has quit ["<Liam> cocks || <Liam> gigantic cocks || <Liam> slapping me in the face"]
smklsmkl has joined #ocaml
smkl has quit [Remote closed the connection]
nudedude is now known as docelic
smklsmkl is now known as smkl
<kev> woohoo
* kev gets his irc bot working
<kev> okay, anyone any idea how I would work with a socket correctly?
<kev> at the moment I have a recursive function which acts on input, then calls itself again on the socket
<kev> which I presume will just fill the stack up over time
<mrvn_> Nope. should be tail recursive.
mrvn_ is now known as mrvn
<mrvn> let handle socket handler = let rec loop = let data = read_data socket in handler data; loop
<mrvn> Something like that works fine without filling the stack.
<kev> ah, yeah, thanks :)
Dalroth has joined #ocaml
intero has joined #ocaml
<intero> hi ppl
* intero is away: I'll answer as I come back, I am away now, sorry =(
mattam_ is now known as mattam
docelic is now known as nudedude
systems has joined #ocaml
systems has left #ocaml []
graydon has joined #ocaml
nudedude is now known as docelic|away
rox has quit [Remote closed the connection]
matkor has joined #ocaml
karryall has quit [Remote closed the connection]
esabb has left #ocaml []
iusris has joined #ocaml
lindril has quit [Read error: 54 (Connection reset by peer)]
lindril has joined #ocaml
graydon has quit ["xchat exiting.."]
listener has joined #ocaml
<listener> Basic question:
<listener> type 'a rf = RF of ( 'a rf -> 'a );;
<listener> let y ( RF f) =
<listener> let g (RF h) =
<listener> f( h (RF h) ) in
<listener> (g (RF g));;
<listener> How do I get this to work?
<intero> any more significant name? ;P
<listener> Significant name?
<intero> significative
<intero> sorry
<listener> I'm still not clear what you mean.
<intero> call a function 'do_a_sum' instead of 'y'
<listener> It's the y combinator. It's usually called Y but ocaml doesn't like capitals for values.
<intero> :P
<intero> it compiles to me
<intero> val y : 'a rf -> 'b = <fun>
<listener> The rest are pretty much what they are in all literature.
<listener> Hmmm. Let me restart ocaml and try again.
<intero> paste the error in case
<listener> It complains about the second g to me.
<listener> # Characters 68-69:
<listener> (g (RF g));;
<listener> ^
<listener> This expression has type 'a rf rf -> 'a but is here used with type
<listener> 'a rf rf -> 'a rf
<intero> what version? :P
<intero> of ocaml?
<listener> 3.06
<intero> same
<intero> mmm
<intero> weird
<intero> same code here
<intero> hold on let me check better
<intero> oh i had f( h (RF h) ) in with no f
<intero> *thinking*
<intero> f( h (Rf h) ) has too many things. remove an f or an h and it will work
<listener> They are supposed tobe there.
<intero> then you are prob missing something before the =
<listener> I changed the first line to:
<listener> let y f =
<listener> and it compiles. But then if I do:
<listener> let base_fac q=fun n->if n<2 then 1 else n * ( q (n-1) );;
<listener> y (base_fac) 10;;
<listener> I get an infinite loop
<intero> what is q?
<intero> and int?
<whee> I really don't understand your y function
<intero> =function
<intero> whee: good i am not the only one
<whee> whats with the parens?
<whee> the spacing is off and there's an abundance of parens, I can't follow it, heh
<listener> whee: Do you have Paulsen?
<listener> I couldn't follow it in Scheme. So I translated to OCaml.
<whee> eh?
<listener> It's the sort of famous Y combinator. Sort of because until last week, I never heard of it.
<intero> i never heard either
<intero> is it really that famous
<listener> Described in the second half of Chapter 9 of Little Lisper/Schemer.
<whee> what book is this?
<whee> I'll do a quick translation of that y function
<whee> oh
<whee> doing the y combination naively in ocaml would lead to an infinite loop
<listener> Why?
<whee> combinator, even :\
<whee> the straightforward way works better with lazy evaluation
<listener> Paulsen, ML for the Working programmer. p 380-392.
<listener> It's also in the ml FAQ.
<whee> you can do it in ml by adding another argument so it's only partially applied
<listener> Can you show me?
<whee> mmmf
<whee> I'll use your types :)
<whee> type 'a rf = RF of ('a rf -> 'a);;
<whee> and that's one massive brain freeze
<whee> hold on :\
<intero> nite ppl
<whee> hah
<whee> I'll just rip it from a page :)
<whee> let y f = (fun g -> fun x -> f (g g) x) (fun g -> fun x -> f (g g) x);;
<whee> you need -rectypes for that
intero has quit ["bye all, thanks and take care"]
<listener> No kidding about the brain freeze. I've been working on this for a couple of days. This is the last step, and am glad to get it done.
<listener> I don't think using "-rectypees" is fair. The point of the Y combinator is to introduce recursion.
<whee> well -rectypes just allows the type checker to check recursive types
<iusris> hello all :)
<whee> it's still recursion when you apply the combinator
<listener> type 'a rf = RF of ( 'a rf -> 'a );;
<listener> let y f x=
<listener> let g (RF h) y =
<listener> f( h (RF h) ) y in
<listener> (g (RF g) x);;
<listener> Works.
<listener> In some sense, but it's sort of a dynamic recursion ( you specify the function at runtime ).
<whee> it's the same thing as I pasted, basically
<whee> except yours uses a recursive type instead
<listener> Yeah but with the types in.
<iusris> can someone point me to the best places to go to get started on ocaml?
<listener> www.ocaml.org
<iusris> :) any others of note?
<whee> iusris: there's a lot of things on http://caml.inria.fr/tutorials-eng.html worth reading
<whee> also the o'reilly book linked from ocaml.org is good
<listener> There is also a beginner's mailing list on yahoogroups.
<iusris> whee: great
<iusris> listener: even better :) thanks to both of you.
<listener> How much FP do you have? Any Lisp or Haskell?
<iusris> listener: Some haskell and erlang
<whee> erlang! woo
* whee loves erlang
<listener> Then download the Hickey book. Wait a minute.
<iusris> listener: I'm mostly a ruby programmer, though. but I love FP
<mrvn> listener: The problem of Y is that its not typeable with the ocaml type system.
* iusris loves erlang too
<mrvn> listener: You have to introduce a recursive type to make it typeable.
<whee> mrvn: but also using -rectypes can eliminate that
<mrvn> Well, thats cheating
<whee> pfft :P
<listener> http://caml.inria.fr/ocaml/papers.html for the Hickey paper.
<iusris> listener: great, tks
<listener> On the ocaml web page, there are downloadable boooks. The reference manual and an O'Reilly book.
<mrvn> # let f f = f f;;
<listener> But for someone whoalready knows some haskell and erlang, the Hickey paper is probably the best place to start.
<mrvn> val f : ('a -> 'b as 'a) -> 'b = <fun>
<mrvn> What kind of type is that anyway?
<iusris> listener: :)
<mrvn> -rectypes maps recursive types onto polymorphics types?
<whee> haha
<whee> I think you picked a bad example :)
<mrvn> Its the easiest one
<mrvn> # let f n h = if n<2 then 1 else n*(h (n-1) h);;
<mrvn> val f : int -> (int -> 'a -> int as 'a) -> int = <fun>
<mrvn> # let fac n = f n f;;
<mrvn> val fac : int -> int = <fun>
<mrvn> Heres a more real world example. Still the same construct with as.
<listener> whee: The reason that I wanted to learn Y combinator is because there is a paper.
<mrvn> Isn't that how polymorphic types are shown?
<listener> Supposedly it has some good debugging techniques.
<mrvn> mrvn@dual:/tmp/foo% ar -x base-files_3.0.7_mips.deb
<mrvn> ups
Dalroth has quit []
<listener> >>>I've just skimmed that paper and it seems to have good techniques. Now I will dig further.
<listener> mrvn: Part of the trick of Y is to pass the function to itself. Thus the (f f).
<listener> So obviously you have to have an "undefined" argument.
<mrvn> listener: no, its not undefined. just not typeable by the normal type engine.
<listener> Either a recursive type ('a->'a)->'a|(('a->'a)->'a)->'a|....
<mrvn> To understand why it fails you have to look at how the type engine determines types.
<listener> Or of type ('x->'a)->'a where x has to be a polymorphic type.
<mrvn> Also the way types are normaly written (without the as) its just not possible to write the type.
<listener> I'm not sure what you mean by possible.
<listener> If you do:
<listener> type rt=int->rt->int;;
<mrvn> let f f = f f;; that has at first a type 'a->b' because its a function.
<listener> Then: let f n (rt h) = if n<2 then 1 else n*(h (n-1) (rt h));;
<listener> works under OCaml with out -rectypes.
<mrvn> But it calls "f f" => 'a->('b->'c)
<listener> Of course rectype is a polymorphic type.
<mrvn> But it calls "f f" => ('a->'b)->'c I mean
<mrvn> But 'b is the f that gets called, so it has type 'd->'f
<mrvn> but 'f is the f that gets called, so it has 'g->'h
<mrvn> ...
<listener> <mrvn> ...
<listener> Sorry. Hiccup.
<listener> Try.
<listener> type 'a rf = RF of ( 'a rf -> 'a );;
<mrvn> By defining a recursive type rt you remove the recusion from the type of the function and then it works.
<listener> let f (RF f) = f (RF f);;
<mrvn> # let f (RF f) = f (RF f);;
<mrvn> val f : 'a rf -> 'a = <fun>
<mrvn> no recursion there anymore.
<listener> Yes. Something like Y works in Lisp/Scheme because it's...
<listener> volunarily typed????
<mrvn> listener: No, lisp and scheme just don't care about the type. They just try and fail.
<mrvn> (or not if one is lucky)
<listener> But the typing gets in the way in OCaml (probably Haskell too ). Because they type functions strongly.
<listener> Is they just had an arbitrary type function, without specifying the argument/return types.
<mrvn> and gladly so.
<mrvn> 90% of all bugs are type errors.
<kev> mrvn: it hurts for RAD though
<mrvn> And that numberis old, from times when people could still programm properly.
<kev> especially when you're beating stuff out and refactoring it
<listener> In Lisp you can declare type in function calls. It will also try to infer type, but give up if can't.
<listener> I wouldn't say 90%. But typing certainly helps.
<mrvn> kev: I hate untype languages. You develope some source and you try run it and everything works. 3 weeks later while doing something other on the source it suddenly fails.
<mrvn> Just because the type doesn't match on some rarely used case.
* listener thinks that people who hate typing just want to make type errors.
<kev> mrvn: yeah, but they still have their place
<kev> would be nice to have a python equivalent for ocaml
<iusris> using untyped languages without good unit testing is a gamble.
<mrvn> sure, but not for anything complex.
<kev> that way you can throw your app up, suss it out, then replace it bit by bit with ocaml code
<kev> much like you can do with python/swig c++ etc
<listener> For programs less then 500 lines untyped language are probably bettter. Because you can beat the thing to death.
<kev> yep
<mrvn> I use ocaml to throw something together and then I think about doing it in C++ for optimisation.
<kev> ocaml forces you to get it right first time
<kev> which doesn't really work that great
<mrvn> you get used to it quite fast
<listener> Better then spending time trying to figure out where you got it wrong.
<kev> mrvn: yeah, but for each new situation you write an app for you'll wrestle with the app structure
<mrvn> Thats my experience too.
<mrvn> In untyped languages something as simple as a misspelling can throw you off for hours.
<kev> I'm certainly converted to the batter in python, then port approach atm
<listener> The only problem is that I'm a Caml newbie. I spend hours getting something to compile, but when it does it usually works.
<mrvn> listener: thats what ocaml feels like. Once it compiles it usually works.
<kev> mrvn: how do you find that for real life situations though?
<kev> ie, changing specs, unexpected parts of specs, etc
<listener> About ten years ago, Al Stevens the writer of the Dr. Dobbs C/C++ column said that he passed some C code through a C++compiler.
<listener> It wouldn't compile so he fixed the compiler errors. Then several bugs he could never find went away.
<mrvn> kev: works fine wih mldonkey.
<kev> mrvn: mldonkey ain't real life ;)
<kev> I was meaning more for a business situation or something
<mrvn> listener: C compiler are pretty loose about all the pointer arithmetic. The C standard allows a much stricter checking on pointers but all compilers ignore those for speed reasons.
<mrvn> kev: Biggest think I work on atm.
<mrvn> Gr
<mrvn> kev: Being a student I have no real business experience yet. Nothing bigger than a few php or pyhon scripts.
<mrvn> bash ist ja ok
<kev> mrvn: I find that the real challenge with programming comes with dealing with the open environment
<mrvn> ups
<mrvn> ETOOMANYCHATS
<kev> but then again, it depends on what your job is
<mrvn> kev: you mean when your coworkers change the datatypes and interfaces on you all the time?
<kev> mrvn: it's not as much as the programmers, but the other things you need to work with
<listener> PHBs
<kev> eg, your company needs to treat client relationships in a different way, and so your interfaces need to change
<kev> i also have to admit, that I've worked for far too many cowboys ;)
<mrvn> What I miss most in open source projects is that there is no direction. Everyone does what he feels like and then someone responsible for the repository picks up what looks good.
<kev> yep, higher level of control in open source really is lacking
<listener> I've got to go. Thanks for the help.
<listener> Bye.
<mrvn> You can't meet in the morning and decide what way to go for the day. morning means when you go to bed for other guys.
listener has quit ["ERC v2.0 (IRC client for Emacs)"]
<kev> what did the linux developer say to the microsoft developer?
<mrvn> And if you start a discussion about a certain problem the other guy might be away for a week or something.
<kev> do you want fries with that?
<mrvn> Is there a more omplete implementation of the X11 interface for ocaml? I saw Graphics and GraphicsX11 modules. But the X11 variant has only subwindows as extras. Nothing like shared memory, server bitmaps, backing store options etc.
<mrvn> s/omplete/complete/
matkor has quit [Remote closed the connection]