flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
Yoric[DT] has quit ["Ex-Chat"]
seafood has joined #ocaml
seafood has quit [Client Quit]
seafood has joined #ocaml
seafood has quit [Client Quit]
seafood has joined #ocaml
seafood has quit [Client Quit]
seafood has joined #ocaml
seafood_ has joined #ocaml
<mrvn> Anyone awake with a clue about forge.ocamlcore.org? I set my ssh key but I still can't log in.
<maxote> hi, is there any concurrent GUI for simulation on OCaml?
<mrvn> maxote: there is the Graphics module and there are gtk bindings
<maxote> for education purpose
|jedai| has quit [Read error: 110 (Connection timed out)]
vixey has quit [Connection timed out]
<maxote> i wanted autopainting
<mrvn> I'm not sure what you are looking for.
<maxote> each 1/4 second
|jedai| has joined #ocaml
<maxote> :s
<mrvn> you can create a paint thread that repaints and sleeps 0.25 seconds over and over.
<maxote> yes, for the turtles
<mrvn> So you have some turtles that run around and you want to paint them. Wouldn't it make more sense to paint them after every step they take?
<maxote> errr no, the turtles are fool that each does its race
<maxote> one step is not sufficient, the turtles are time-counted
<mrvn> let loop turtles = let turtles = List.map move_turtle turtles in List.iter draw_turtle turtles; loop turtles
<maxote> it's not easy, i've many turtles as threads
<mrvn> Ah, ok. then just make a paint thread
<maxote> each turtle does its own competition
<maxote> i will need look for concurrent languages
<mrvn> ocaml has no real concurrency but it has threads that do timesharing.
<mrvn> Only difference is that if you have multiple cores ocaml will still only use one.
<maxote> mrvn, ocaml has no real parallelism, concurrency!=parallelism
<maxote> i will try concurrent languages / thread safe languages as oz-mozart, erlang, ruby, ... and possibly forth
<mrvn> maxote: if you use only functional programming then every operation is atomic and thread save.
alexyk has quit []
<mrvn> If on the other hands your turles are procedural then you might have to add locks.
seafood has quit [Read error: 110 (Connection timed out)]
<maxote> yes, i need locks, semaphores, and so on
<Smerdyakov> maxote, why not use message-passing?
<maxote> Smerdyakov, i've a problem, the turtles suck the biggest shared memory
<mrvn> ocaml as a Mutex module.
<mrvn> +h
<mrvn> maxote: and you can't make their public data functional?
<maxote> i can't fork turtles as processes, otherwise it will hang the OS with out of memory/swap
<Smerdyakov> maxote, who said anything about fork or processes?
<Smerdyakov> maxote, Concurrent ML is based on message-passing and lightweight threads.
<Smerdyakov> maxote, OCaml's [Event] module copies the message-passing part, but the OCaml standard library doesn't support the lightweight threads part.
<mrvn> Smerdyakov: what about the Thread module?
<Smerdyakov> maxote, but you can use the original Concurrent ML (within SML).
<Smerdyakov> mrvn, nope. All heavyweight threads.
<mrvn> Lightweight threads for Posix 1003.1c and Win32.
hkBst has quit [Read error: 104 (Connection reset by peer)]
<maxote> Smerdyakov, Concurrent ML, is it a language or a library?
<Smerdyakov> maxote, I'm not sure on whether it's 100% accurate to portray it as a library, but it at least comes very close. From the programmer's perspective, it's a library, but you may need runtime system modifications for it to work well.
<mrvn> maxote: Do you need this at all? Can't you give the turtle a function that runs for one timeslice and returns and then you just iter over them?
<maxote> its homepage is http://cml.cs.uchicago.edu/
|jedai| has quit [Read error: 110 (Connection timed out)]
<maxote> mrvn, timeslices?
<maxote> are they coroutines?
<mrvn> maxote: make one decision.
<maxote> the coroutines can be valid for me !
|jedai| has joined #ocaml
IWannaLog has quit []
<mrvn> you can use continiouation passing style
m3ga has quit ["disappearing into the sunset"]
<maxote> i was remember the win95's events style
<mrvn> But I would think your turtle has some main loop where it looks around, thinks a bit and then decides on something to do.
<maxote> /remember/remembering/
<mrvn> Instead of having that a loop that runs endless in a thread just have it run once and return and call it for each turtle in turn over and over.
<maxote> i think my app need a cooperative scheduler
<mrvn> maxote: what I described is cooperative round-robin
<maxote> where can i find it in?
<mrvn> let loop turtles = let turtles = List.map move_turtle turtles in List.iter draw_turtle turtles; loop turtles
<mrvn> maxote: something like that is all it would need.
<maxote> it's suspending the state of the turtle and resuming the next turtle
<mrvn> do you have any design for your turtle?
<maxote> mrvn, the problem is that i've not the coroutine/cooperative round-robin library :(
<maxote> i knew much of it in Modula-2
<mrvn> maxote: you wouldn't have any. you would write your turtles nicely.
<maxote> mrvn, the turtles are very complex that their states are very different, i need the coroutines to do them easy
<mrvn> maxote: are they and iterative automaton?
<mrvn> s/and/an/
<maxote> mrvn, the turtles are different competitors and different implementations :s
<mrvn> so they might even be bad turtles that try to grab all the cpu time for themself?
<maxote> i wanna build a global automaton
<maxote> mrvn, the bad turtles will be misclassified of the racing in real-time
<maxote> i've 2 choices. A) multithreading + semaphores/lockers B) cooperative round-robin / coroutines (i think i don't need semaphores/lockers here)
<mrvn> % ocaml -rectypes
<mrvn> # type miniThread = unit -> miniThread;;
<mrvn> # let rec turtle x = fun () -> Printf.printf "Turtle %d\n" x; flush_all (); turtle x;;
<mrvn> # let turtles = [ turtle 1; turtle 2];;
<mrvn> # List.map (fun turtle -> turtle ()) turtles;;
<mrvn> You can do it like this.
<mrvn> Each turtle is just a continuation that gets called with () and outputs a new continuation for the next timeslice.
<mrvn> You can get rid of the rectype with a slightly more complex type.
<maxote> i don't see the sleeping commands
<mrvn> There is no sleeping in the turtle. You would sleep between the List.map calls.
<maxote> turtle X has to do the task and to sleep later
<mrvn> You can create a larger miniThread type that includes a sleep time and whatever else you need.
<maxote> it only prints 2 lines, why not infinite lines?
<mrvn> maxote: because there is no loop around the List.map
<mrvn> let rec loop turtles = loop (List.map (fun turtle -> turtle ()) turtles)# let rec loop turtles = loop(List.map (fun turtle -> turtle ()) turtles);;
<mrvn> # loop turtles;;
<maxote> mrvn, there is a problem, Ctrl-C doesn't work, i'm in an infinite loop
<mrvn> maxote: ctrl \
<mrvn> maxote: Using closures makes it verry easy to build your own multitasking with verry little overhead. Like the example above or the pasted urls. But your turtles have to play nice because it is cooperative.
<maxote> mrvn, your code can be a nice workaround, but i need register the timings of each turtle and sum them, i need to contact to scheduler to give CPU to the lesser timed turtle :( for statistically equal accumulated timings of the turtles.
<mrvn> Smerdyakov: How much overhead does the Thread module have? I thought that would only have userspace threads thus only a root set and a few registers overhead.
<maxote> the greater timed turtles can't be champions
<mrvn> maxote: After each turtle note the time and add it to the turtles "time_next". Then always run the turtle with lowest time_next.
<maxote> the lesser timed turtles can't be losers
<Smerdyakov> mrvn, I don't know, but the standard wisdom is that it's too much.
m3ga has joined #ocaml
<mfp> maxote: can you use discrete instead of continuous time? -> for example, using Lwt, expose a number of functions used to control the turtles & returning some 'a Lwt.t. You can then control the scheduling in those funcs by monitoring some per-turtle event counters.
<m3ga> anyone using lablgl on Ubuntu intrepid?
<m3ga> i get segfaults on anything that links lablglut.cmxa
<maxote> mfp, yes, i need some as one control tower and turtles=airplanes
<mrvn> maxote: There are a million ways to do it. It realy depends on what your turtle is supposed to look like and how you count time.
<maxote> the turtle is not who counts the time, it's the control tower
<mrvn> maxote: but how? You could for example count the number of queries ask of the control tower (or the world). Things like where other airplanes are etc.
<mrvn> Or you could count actual cpu time used
<maxote> my objetive is simple, who turtle can do many operations in aprox. one minute
<mrvn> wall time, cpu time?
<maxote> N turtles, required N minutes
<maxote> wall time
<mrvn> and the turtle with the least cpu time at the end wins?
<maxote> the worst turtle will be eliminated in the e.g. 2nd minute
<mrvn> worst meaning the highest cpu time?
<maxote> initially, you don't know the worst turtle in minute 0
<maxote> worst turtle = bad speed = lesser operations per minute of the turtle
Axioplase_ is now known as Axioplase
<maxote> the elimination of the turtles is decided by the commitee in real-time depending if they are not-bad or very-bad
<mrvn> ok, so for each turtle you measure the time the turtles closure takes each time you call it and add that up.
<maxote> the eliminated turtles (e.g. 500 from 1000) implies CPU gaining for the competitors
<mrvn> e.g.: type miniThread = { time_used : float; time_next : float; fn : (unit -> 'a) as 'a; };;
<maxote> in the last rounds (e.g. last 10 of 100), there are only few competitors (e.g. 3 from 1000) consuming a lot of CPU for them only!
<mrvn> wait, like this: type miniThread = { time_used : float; time_next : float; fn : (unit -> 'a * float) as 'a; };;
<mrvn> the float in the fn being the time to sleep till it wants to be called again.
<mrvn> Or you could create a class BaseTurtle that keeps track of the time used and when next to run and has a virtual method run_slice : unit -> float that each implementation overloads to do its own thing.
<mrvn> Every time the class is to be run you call run_slice and measure the time it took. The float returned is again the time to sleep. You account for them and go to the next BaseTurtle.
<mrvn> The BaseTurtle could have some common variable like the turtles position and name and so on.
<maxote> mrvn, award_of_turtle: integer * unit -> float ok?
<mrvn> maxote: whatever you find usefull
<mrvn> although the unit there makes no sense.
<maxote> mrvn, the CommitteeTurtle eliminate turtles that their awards per minute are lesser than 50% of the average awards per minute
<maxote> mrvn, the problem is that award_of_turtle is a stateful function
<mrvn> so BaseTurtle would have a mutable val awards = 0;
<mrvn> maxote: the individual Turtle classes have to store their own state.
<maxote> ok
<mrvn> The benefit of using classes would be that you can provide an interface to the control tower and generic turtle functions in the base class. Like the position of the turtle, moving or turning, checking the score one has etc.
<maxote> mrvn, the turtle is abstract, i don't need the position of the turtle, i only need its current award and consumed timing
<maxote> sorry, s/award/reward
<mrvn> So they aren't real little cute turtles that run around a maze or something? :((
<maxote> mrvn, bad lucky turtles, but it's not my problem
<maxote> i only wanted to eliminate the worst turtles (lower rewards)
<mrvn> A long while back I did something like this with ants. You had a few different types of ants like warrior, worker, queen and they would run around and gather food or build the hive.
<maxote> remember, one eliminated turtle = one gift of CPU to the turtles's population
<mrvn> One turtle dies, more food for the rest. :)
<maxote> yes!
<maxote> food=cpu
<maxote> only the best turtles run speedy
Camarade_Tux has quit ["Leaving"]
<maxote> very thanks people
struktured has joined #ocaml
<maxote> i only need look for couroutines library, a chronometer and some implemented ADTs
<mrvn> maxote: couroutines are simplest done via continuations
<maxote> instead of inefficient pthreads + semaphores ...
<maxote> i've to care that my functions has to be thread-safe
<mrvn> And if you use cooperative multitasking and define that turtles must be in a consistent state when they end their timeslice then you don't need locks.
<mrvn> functions will never be interrupted
<maxote> and possible reentrant (function can call itself in a nested manner)
<mrvn> reentrant is something different. That is multiple threads calling the same function in parallel
<mrvn> You just have recursive functions which come totaly naturally in ocaml
<mrvn> anyway, zzzZZZ
<maxote> good bye mrvn, but when you use referenced data, care of the reentrant
<mrvn> PS: I managed to upload a first draft of libaio. Just took some time for the ssh key to work.
struktured__ has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml
<alexyk> when I do: let a = Array.make 2 ref 0; incr a.(0); I get both => 2. How do I create an array of different references initialized to 0?
struktured has quit [Read error: 110 (Connection timed out)]
seafood_ has quit []
jknick has joined #ocaml
|jedai| has quit [Read error: 110 (Connection timed out)]
|jedai| has joined #ocaml
mohbana has quit [Read error: 145 (Connection timed out)]
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
shortc|desk is now known as shortc|laptop
shortc|laptop is now known as shortc|desk
seafood has joined #ocaml
munificent has joined #ocaml
<alexyk> hmm -- how does a.(0) <- a.(0)+1 compare to an array of ref int? why would you need an array of ref int if you can do <- ?
<thelema> alexyk: one more level of indirection -- if you wanted to have multiple array indexes hold the same value
<thelema> to make an array of different references, use Array.init 2 (fun _ -> ref 0)
<thelema> (or are the args in the other order...
<thelema> as to your remaining question, I'd guess that incrementing a ref could be faster, but it's possible that the assembly generation for array incrementing isn't as literal as most generated code.
johnnowak has joined #ocaml
<hcarty> alexyk: You need to use Array.init rather than Array.make. Array.make produces an array with (effectively) two pointers to the same (ref 0) in your example.
<hcarty> alexyk: Array.init 2 (fun _ -> ref 0) will produce an array with a unique (ref 0) in each element.
<hcarty> And I'm apparently up too late, as this question was already answered... sorry for the noise
Stefan_vK has joined #ocaml
Stefan_vK1 has quit [Read error: 60 (Operation timed out)]
<tsuyoshi> damnit.. why are all the programming jobs in this country java or c#
<thelema> tsuyoshi: My guess is because 1) those languages have established communities of bean-counters making useless tools to help manage their projects
<thelema> and 2) huge stdlib = less rewriting the wheel
ygrek has joined #ocaml
<alexyk> thelema, hcarty: thanks! it is clearer now
<alexyk> tsuyoshi: can always talk C# people into F#
Axioplase has quit ["Lost terminal"]
Axioplase has joined #ocaml
|jedai| has quit [Operation timed out]
|jedai| has joined #ocaml
ygrek has quit [Remote closed the connection]
alexyk has quit []
struktured has joined #ocaml
ikaros has joined #ocaml
m3ga has quit [Read error: 110 (Connection timed out)]
nocte has joined #ocaml
nocte has left #ocaml []
vixey has joined #ocaml
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
m3ga has joined #ocaml
seafood has quit []
_zack has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
ygrek has joined #ocaml
_zack has quit ["Leaving."]
ikaros has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
munificent has quit []
ikaros has quit [".quit"]
|jedai| has quit [Read error: 110 (Connection timed out)]
|jedai| has joined #ocaml
_zack has joined #ocaml
Yoric[DT] has joined #ocaml
Yoric[DT] has quit [Client Quit]
Yoric[DT] has joined #ocaml
ppsmimou has joined #ocaml
olgen has joined #ocaml
seafood has joined #ocaml
schme has joined #ocaml
<schme> Hello ocaml.
<schme> Anyone hip with the ocaml jack bindings?
<schme> I'm curious about how usable they are, and if it is indeed possible to use ocaml for jackery.
<Yoric[DT]> hi
marmotine has joined #ocaml
<schme> Hi Yoric[DT]
<schme> I have not used ocaml that much, but it is usable for RT then?
* Yoric[DT] never tried it for RT.
* schme is trying to avoid C :)
<Yoric[DT]> :)
<schme> That other popular FP language turns out to be quite useless for it. and google suggested there were indeed jack bindings so hrrmm..
<schme> What good sites are there on ocaml anyway?
<Yoric[DT]> I've seen uses of OCaml in RT, I believe.
<Yoric[DT]> For podcasting, among others.
<schme> I tried reading a book that turned out to be not at all to my liking.
<schme> Oh that's cool.
<Yoric[DT]> I've liked OCaml for Scientists.
* schme searchees
<schme> my bookstore doesn't have it :(
<Yoric[DT]> It's only available on-line, I believe.
<Yoric[DT]> And it's quite expensive.
<schme> Yes.. this is an online bookstore ;)
<schme> hmm..
<schme> not on amazon either.
<schme> Oh it's just 85UKmonies :)
<schme> You guys have a journal!
<schme> Is the ocaml journal any good?
<Yoric[DT]> Never read it but it's the same editor as OCaml for Scientists.
<Yoric[DT]> Jon Harrop is good but tends to use OCaml only for numerical analysis, which doesn't give him the same priorities as other users.
<schme> What do you mean? numerical analysis is the main hobby of everyone ;)
<schme> I'll order this book. Thanks for the suggestion.
<schme> Ok. Google gives this: "a hard realtime CNC architecture
<schme> based on Ocaml"
<schme> if it is good for CNC it is good for me. I think I have found the tool :) Now I will stop flooding your channel for a bit.
<Yoric[DT]> :)
<Yoric[DT]> Have fun.
schme_ has joined #ocaml
|jedai| has quit [Connection timed out]
schme has quit [Read error: 110 (Connection timed out)]
|jedai| has joined #ocaml
<flux> I remember someone here subscribed to ocaml journal
<flux> although I'm not going to order it, I wonder how is it..
Axioplase has quit [Read error: 104 (Connection reset by peer)]
_zack has quit ["Leaving."]
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
_zack has joined #ocaml
<schme_> flux: From the site atleast it seems to have interesting articles. :)
<schme_> If I get somewhat hooked I'll be sure to order a subscription and drop off a review ;)
<det> Is the the harrop thing?
<det> I get annoyed how he pollutes planet ocaml with advertisements
Morphous is now known as Amorphous
<schme_> harrop?
OChameau has joined #ocaml
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
<gildor> det: i plan to remove his feed from the planet
<gildor> but it is difficult to draw the line between harrop planet contribution (some are good) and other feed that have a little commercial background
<gildor> (CamlPDF e.g.)
schme_ has quit [Read error: 54 (Connection reset by peer)]
schme has joined #ocaml
ikaros has joined #ocaml
ikaros has quit [".quit"]
ppsmimou has quit [Read error: 60 (Operation timed out)]
ygrek has quit [Remote closed the connection]
<Yoric[DT]> schme: yeah, Jon Harrop has the somewhat annoying tendency of attempting to make money by selling his OCaml work and reminding of this rather often.
<schme> ok.. never heard of him. I guess I will. :)
<Yoric[DT]> Well, he's the author of OCaml for Scientists and the editor of the OCaml Journal.
<schme> Oh ok :)
<schme> looking at ocaml-tutorial.org . The syntax of it all seems more pleasant than that other FP lang.
<schme> brilliant stuff.
<schme> are there some vim plugins one should hook up with?
jeremiah has quit [Read error: 104 (Connection reset by peer)]
seafood_ has joined #ocaml
seafood_ has quit [Client Quit]
seafood has quit [Read error: 60 (Operation timed out)]
jeremiah has joined #ocaml
mohbana has joined #ocaml
seafood has joined #ocaml
ygrek has joined #ocaml
seafood has quit []
<maskd> schme: really? i find ocaml's syntax a bit annoying
<maskd> but i think i finally 'get' it after some days
<schme> maskd: Well I've seen worse :)
<johnnowak> they're both potentially awkward and have a few gotchas
<schme> maskd: But I'm a lisp hacker by nature, so all syntax is annoying by default ;)
<johnnowak> schme: it gets better
<schme> :)
<johnnowak> schme: then it gets worse
<schme> ouch.
<johnnowak> "I'll just write mac... oh."
<schme> I am quite amused by the planet.ocamlcore.org site. .NET news on the front page and everything. It is very refreshing to see something not spewing the microsoft hate :)
ygrek has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
<gildor> schme: Microsoft is part of the CAML consortium
<gildor> and OCaml should be "portable"
<schme> gildor: Hmm.. No idea what the CAML consortium is. But I'll look it up. :)
<gildor> so it is quite hard to ignore win32 world
<schme> That's very cool though. I don't really use it myself, but the random hate one seems to find everywhere against it kinda bugs me :)
<gildor> I talked to people from microsoft using OCaml
pango has joined #ocaml
<gildor> they really use OCaml for great things
<gildor> (driver verification)
<schme> oh gosh. portability, how I have missed thee.
<gildor> but ocaml support for win32, is enough for the compiler but most lib are difficult to use
<schme> k.
<Yoric[DT]> I seem to remember that someone was planning to rewrite an operating system layer for Win32, instead of Unix.
<gildor> Unix module is already quite extended under Win32 (talking about >= windows 2000)
<schme> My main goal is to do audio programming, so the portability is not sooo interesting. But still nice that it is there :)
Yoric[DT] has quit ["Ex-Chat"]
trisiak has joined #ocaml
vixey has quit [Remote closed the connection]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
Smerdyakov has quit ["Leaving"]
alexyk has joined #ocaml
willb has joined #ocaml
jlouis_ has joined #ocaml
jlouis_ has quit [Read error: 54 (Connection reset by peer)]
jlouis has quit ["Leaving"]
jlouis has joined #ocaml
l_a_m_ has quit ["Lost terminal"]
<johnnowak> schme: you could port rohan drape's supercollider bindings
snhmib_ has joined #ocaml
<schme> johnnowak: What's that?
<johnnowak> you familiar with supercollider?
<schme> Yes.
snhmib_ is now known as snhmib
<johnnowak> he just wrote tools for using sc from haskell and scheme
<schme> That's great.
<schme> How does that let me interface CL with jackd though?
<johnnowak> suns tuff
<johnnowak> *fun stuff rather
l_a_m has joined #ocaml
<schme> Yes, I agree.
<schme> I don't think that is what I want :)
<johnnowak> look, just do what I say!
<schme> hahaha.
<schme> HAHAHA.
<johnnowak> the fact that i have no idea what you're trying to do is of no concern
<schme> No you just have to play with it in scheme.
<schme> I want to hook sbcl up as a jack client so I can develope a super sweet soft synth.
<schme> or whatever one feels like when one works as a jack client.
vixey has joined #ocaml
olgen has quit []
alexyk has quit []
inYourCurry has joined #ocaml
ikaros has joined #ocaml
olgen has joined #ocaml
sporkmonger has joined #ocaml
<det> gildor, I've never seen anything other than "<teaser> subscribe today!" from Harrop on the planet.
jeremiah has quit []
inYourCurry has left #ocaml []
fixnum has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
olgen has quit [Read error: 104 (Connection reset by peer)]
|jedai| has quit [Read error: 60 (Operation timed out)]
olgen has joined #ocaml
|jedai| has joined #ocaml
l_a_m has quit ["Lost terminal"]
l_a_m has joined #ocaml
schme has quit [Remote closed the connection]
mjonsson_ has quit [Read error: 110 (Connection timed out)]
Yoric[DT] has joined #ocaml
jlouis has quit ["Leaving"]
schme has joined #ocaml
jlouis has joined #ocaml
Camarade_Tux has joined #ocaml
mishok13 has quit [Read error: 60 (Operation timed out)]
alexyk has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
<Camarade_Tux> hi :)
mishok13 has joined #ocaml
<schme> Hi Camarade_Tux
alexyk has quit []
itewsh has joined #ocaml
<gildor> det: there was an interesting article + slide from J. Harrop about use of OCaml at XenSource sometimes ago
sanity- has joined #ocaml
hcarty has quit [Read error: 110 (Connection timed out)]
<mrvn> Just commit the error handling for the libaio bindings to https://forge.ocamlcore.org/plugins/scmsvn/viewcvs.php/?root=libaio-ocaml
<flux> no LICENSE?
<mrvn> ups.
<det> gildor, ahh, probably before I came across it
<mrvn> Is there anything that can be done if an error happens in a *_finalize? Should I exit(1) then?
<flux> mrvn, how does the lib work with ocaml threads?
<mrvn> No idea.
<mrvn> Probably needs locking in several functions if not all to work with threads.
<mrvn> And I have no idea how I would get a closure to run in a specific ocaml thread.
<mrvn> I don't think you can.
<flux> having a dedicated ocaml thread to run such closures might be one solution?
<mrvn> Currently it would run in the thread that calls "Aio.run ctx" and waits for events.
<olegfink> 02j20
_zack has quit ["Leaving."]
<mrvn> flux: The point of libaio is so that I don't have to create threads.
<mrvn> flux: All my threads run till they need to do some I/O and then they request that I/O with a continuation where it should resume when done and end.
<flux> mrvn, that sounds smart, I have a similar system based on select
<flux> except I switched from continuations to monads, much nicer
<mrvn> syntactic suggar.
<flux> (still continuations under the hood, of course)
<flux> it's actually nicer in places even without any syntactic sugar
<flux> no need to juggle continuation parameters around
<mrvn> I might have a look at that for reading/writing structures from/to buffers. Currently I have some code with continuation passing style:
<mrvn> let fmt = u8 $ u16 $ u32 in
<mrvn> let buffer = print fmt 1 2 3
<mrvn> scan fmt buffer (fun x y z -> Printf.printf "total %d %d %d\n" x y z)
fixnum has quit ["Leaving"]
hcarty has joined #ocaml
<det> O'Caml + CPS kind of sucks for performance, all unknown function calls. Though, probably doesn't matter for most things.
<mrvn> det: you mean indirect jumps into closures?
Yoric[DT] has joined #ocaml
<det> yeah
<mrvn> doesn't that get optimized away?
<det> calling a known function is way cheaper than an unknown function
<mrvn> but it knows the 5 functions in "fmt" and could optimize them
<det> I'm not away of the implementation, but if it is CPS as you say, then it is all unknown function calls
<mrvn> det: If it is in different compilation units then sure. But within a single unit I hope it inlines.
<det> it cant inline cps
<mrvn> det: sure it can.
<det> Would need some kind of flow analysys
<det> OCaml doesn't optimize much
<mrvn> They are just functions like any other.
<vixey> + CPS, meaning what? writing all your code in CPS?
<mrvn> det: If it doesn't inline the code then the jump prediction will be horrible.
<det> Ocaml can't inline calls unless the function is apparent syntacticly, I think.
<det> brb
<mrvn> u8 $ u16 $ u32 has all functions directly there
<mrvn> Sometimes I think it is too bad ocaml can't have inline functions in mli files.
<flux> mrvn, you do know that infact ocaml can inline across modules?
<mrvn> it can? Where does it get the code from?
<flux> because .cmx-files contain that kind of information
<mrvn> ahh, cool.
<mrvn> The advantage I see in using cps notation for the I/O is that i can specify one format function for both input and output. What it writes will allways match what it reads back later.
<mrvn> I can't accidentally write an uint8_t and read an uint16_t.
<flux> nice idea and implementation
<mrvn> The code is quite simple too. e.g.: let u8 = ((fun cont buffer i -> put8 buffer i; cont buffer), (fun cont buffer fn -> let i = get8 buffer in cont buffer (fn i)))
<mrvn> Just a pair of continuations. One for reading, one writing.
<det> main2 benchmarks 2.6x faster on my machine
Camarade_Tux has quit [Read error: 104 (Connection reset by peer)]
<mrvn> So it doesn't inline the fold_ints
Camarade_Tux has joined #ocaml
<det> it is impossible to
<det> In Ocaml, I mean.
<mrvn> det: why?
<Yoric[DT]> Well, I'd expect it to inline [f] but not [fold_int].
<mrvn> det: all arguments to fold_ints are literals. easy to inline
<mrvn> Yoric[DT]: how could it inline f?
<det> Ocaml lacks the necessary flow analysis to inline it.
<Yoric[DT]> You'd wish it to precompute the result of [main2]?
<mrvn> Yoric[DT]: no. include the source for fold_ints in main1 with the arguments pluged in and optimize for (+)
<Yoric[DT]> Ah, ok, that's essentially what I had in mind, too.
<mrvn> I don't want to do loop unrolling for 1000000000 iterations so to speak.
<mrvn> det: A large amount of the time will be spend on boxing and unboxing ints I bet.
<det> ints are never boxed in Ocaml
<Yoric[DT]> When would they be boxed?
<mrvn> det: they are tagged
<Yoric[DT]> det: iirc, technically, they can be.
<det> Yoric[DT], Oh? When ?
<Yoric[DT]> Well, to pass them as accumulator to [fold_left] or [fold_right], for instance.
<Yoric[DT]> iirc
<mrvn> I use boxing to include tagging
<det> tagging is much cheaper
<flux> yoric[dt], wouldn't that be a simple int parameter to fold_right, so why would it be boxed?
<mrvn> I'm pretty sure fold_ints2 will untag accu and x, then do its loop and in the end tag accu and return.
<vixey> mrvn, why would you write in CPS style when there are native CWCC implementations?
<vixey> blech "CPS style"
<mrvn> On the other hand fold_ints has type val fold_ints : ('a -> int -> 'a) -> 'a -> int -> 'a = <fun>
<det> I dont think Ocaml has CWCC for ocamlopt
<Yoric[DT]> flux: I'm not completely sure, so I'll just shut up.
<mrvn> every call to (+) will untag, add and retag (well x+y-tag or so)
<det> unless you mean via monad libraries or similar, in which case it is still CPS behind the scenes
<mrvn> vixey: ?
<flux> mrvn, (+) doesn't need to untag per se, it just needs to take tagging into account..
<vixey> mrvn, asking something? I don't know how to answer "?"
<mrvn> vixey: where can I gate a cwcc implementation to do structured binary I/O?
<mrvn> s/gate/get/
<mrvn> flux: it gets tagged values and must return a tagged value. In fold_ints2 it can work completly untagged.
<vixey> if you type "ocaml continuations" you will find the first hit is http://okmij.org/ftp/Computation/Continuations.html#caml-shift
<det> vixey, byte-code only
<flux> mrvn, yes, but it doesn't need to untag arg1, untag arg2, eval arg1 + arg2, tag result, but instead it can eval arg1 + arg2, and then do bit magic to make sure the result it still tagged :)
<flux> hm, will fold_ints2 actually work with untagged numbers then?
<mrvn> vixey: That sounds way way to heavy to read a few bytes from a buffer and forget about it.
<flux> actually I'm not sure if doing + directly on tagged numbers works in overflow cases ;)
<vixey> mrvn, Yeah, using a library someone wrote to write a program is a crazy idea
<mrvn> flux: as said above (x+y-tag)
<flux> right, that should work
<mrvn> vixey: copying part of the stack and exception handlers for every byte you read is way to expensive
<vixey> you lost me
<det> CPS means you are allocating a closure and making an unknown function call for every byte you read
<det> also not very nice
<mrvn> vixey: This is ment to be verry short lived and localized and should get completly optimized away when possible.
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
<mrvn> It is ment just as a way to get the type system to reflect what gets written or read and make sure the two are identical.
<vixey> "ment"?
<mrvn> vixey: it could always be abused
sanity- has left #ocaml []
OChameau has quit [Read error: 113 (No route to host)]
<flux> I benchmarked functions sum_bm, sum'_bm and sum'_bm', and the difference was 2.0s to 2.1s
<flux> (the two last ones had basically identical runtimes)
<flux> so if you do some work (print_int qualifies as work..), cps is not _that_ costly?
<mrvn> flux: do they have different code?
<flux> mrvn, assembly? didn't look, but I sure would expect that
<flux> in any case if you are doing io code, you want to work in blocks anyway, if possible
<mrvn> flux: identical
<flux> heh
<flux> so indeed, ocamlopt _does_ optimize that?
<mrvn> (fun n -> print_int n) gets completly optimized away.
<flux> ah, that might've been a bit too small closure
<flux> perhaps if I'll make use of a parameter
<mrvn> be: 48 8d 44 00 ff lea -0x1(%rax,%rax,1),%rax
<mrvn> c3: 48 8b 3b mov (%rbx),%rdi
<mrvn> c6: ff d7 callq *%rdi
<mrvn> I believe that is the print_int
<flux> I slightly complicated it
<flux> now the closure cannot be optimized away
<flux> well, atleast in the sense being replaced by simple print_int
<flux> it's still as fast
<flux> so I imagine it still produces idential code
<mrvn> 64bit cpu?
<flux> 32
<flux> of course, perhaps print_int is 'too much work' here
<mrvn> On 64bit cpus the only difference should be the jump prediction. And since you always call the same closure that works just as well with a fixed address or variable.
<mrvn> With cps the closure it calls would be different all the time.
<mrvn> Plus it would heap allocate the arguments for each call.
<flux> ah, now that I lessened the work significantly (print_int n -> v:=n), there is a difference of 13 sec / 42 sec
<mrvn> vixey: How do you think delimcc would help me? I would still have to write all the continuation for every type of input/output and each would result in a library call.
<flux> so there is a cost. and amdahl's law dictates how much faster your app will be if you make that faster.
<mrvn> flux: now it might be too simple again and it inlines and optimizes away all the assignments.
Snark has joined #ocaml
<flux> I wonder if it is permitted to optimize that kind of code..
<flux> otoh, ocaml memory model is not documented, is it?-)
<det> mrvn, delimcc won't help you, it is a hack for ocamlc only, as I pointed out
<det> mrvn, no ocamlopt support
<flux> given threads, there could be an observer for the value. (I compiled without -threads, but would it matter to the optimizer?)
<mrvn> flux: the docs on interfacing C with ocaml has a lot about it
<mrvn> I'm not aware that one thread can observe a value from another.
<flux> how to implement message passing if that would not be possible?
<mrvn> flux: you can read a value but you can not wait for it to change.
<flux> lea -1(%ebx, %ebx), %ecx movl camlFoo + 12, %eax movl %ebx, (%eax) movl camlFoo + 12, %eax
<flux> looks like it's assigning it twice alright
<mrvn> let a = ref 0 a := 1; a := 2; might verry well just ommit the 1. I see no reason the compiler should assume some other thread might want to read the value at exactly that time and should expect it to be 1.
<flux> because ocaml doesn't have the concept of memory barrier, how else would thread A change a values so that thread B would see the change?
<flux> which would be the basis of inter-thread communication
<mrvn> flux: change it and wait.
<flux> mrvn, wait for how long?
<flux> btw, ocaml would need to know print_int doesn't have access to variable v also
<mrvn> flux: a := 1; something with possible side effect; a:= 2; must not be optimized out
<flux> except, actually in my case, it didn't need to
<mrvn> That is different from a:=1; a:=2 without anything inbetween
<flux> well, what does this seem like it's doing? movl camlBar, %eax movl $1, (%eax) movl camlBar, %eax movl $3, (%eax) movl camlBar, %eax movl $5, (%eax) movl camlBar, %eax movl $7, (%eax) movl camlBar, %eax movl $9, (%eax) movl camlBar, %eax
<mrvn> flux: yes. I see that too.
<flux> (n := 0; n:= 1; n:= 2 etc)
<mrvn> Which is really stupid code. It realy does not need to reload eax every time.
<mrvn> Every time I read ocaml asm output I wonder how ocaml gets any speed at all.
<flux> not writing superfluous assignments in the code is a good start ;)
<flux> anyway, I don't see the memory model _must_ be one, that such sequences of assignments must be considered atomic
<mrvn> I would still think the compiler has some common subexpression detection and would optimize the loading into a single call.
<flux> although it does give plenty better optimization possibilities..
<mrvn> flux: sure. I never said they must. I just mean that it would be equivalent as any access could just accidentally be before or after them all anyway.
<mrvn> flux: by the way, for message passing you should either have a read and write variable for each side or use a mutex.
<mrvn> By the way, does ocaml garantie the execution order of a;b;c?
<flux> a lot of code would break horribly if it didn't :) (atleast in a way that can be witnessed)
<mrvn> Code like 'a := 1; b := 2; c := 3;' could do the assignment in any order without anything breaking.
<mrvn> In C you have to place a memory barrier to prevent reordering.
<Camarade_Tux> actually I'm wondering if I did not have problems with that (ie reordering)
<Camarade_Tux> stranges problems which were fixed by using 'let _ = ... in let _ = ... in ...'
<mrvn> flux: My question goes towards wether the compiler just doesn't care or wether it may not reorder because the language says so.
<Camarade_Tux> s/stranges/strange
<flux> mrvn, well, AFAIK there is no formal (or even semiformal, other than the ocaml docs) semantic model of how ocaml should work, so to find an answer, the compiler source (and ocamlrun) has the answer
<flux> I wonder if such a model exists for caml light
<mrvn> Anyone know of a text dealing with interfacing with C and threading? What needs to be done and when?
<flux> mrvn, with ocaml you mean?
<mrvn> interfacing ocaml and C, yes
<mrvn> When do I need enter_blocking_section(); and leave_blocking_section();?
<mrvn> What are they anyway?
<flux> when you call for example 'read'
<flux> and you want ocaml threads to run
<flux> you promise ocaml runtime that you won't interface with ocaml during that section
<flux> I haven't been exactly that position, but I've solved a C asynchronously calling back to ocaml by having an ocaml thread receiving incoming messages (closures) and runs them there
<flux> the mechanism has been outlined here: http://alan.petitepomme.net/cwn/2005.03.08.html#9
<mrvn> And if I don't do enter_blocking_section() then no other ocaml thread runs while the C code runs?
<flux> correct
<mrvn> So there is one big mutex. Whatever thread holds the mutex may run and the enter_blocking_section() gives it up and leave_blocking_section() waits for it again?
<flux> that's the idea
johnnowak has quit []
<mrvn> will ocaml interrupt my C code and let some other thread run for a while?
<mrvn> or rather, when/how does ocaml switch between threads?
<flux> I imagine it switches when a thread blocks, or it interrupts, as threading systems in general
<flux> and no, it will not interrupt C code, unless you've called enter_blocking_section
<mrvn> Doesn't sound like it uses a timer to interrupt threads.
<mrvn> Say I have the following code: let set x y z = a:=x; b:=y c:=z, will it ever interrupt set in the middle or only when it is done?
<mrvn> i.e. do I need a mutex around a,b,c to make sure they are changed atomically together or not?
<flux> I would use a mutex
<mrvn> can't be wrong, just wastefull. :)
<flux> darn, strace (still) doesn't work with threads..
<mrvn> flux: As to your url. That seems to be a problem with java creating threads that all of a sudden want to call ocaml code.
<mrvn> I have the same problem in fuse as it creates threads to handle the filesystem operations.
<mrvn> My solution is to use libaio to make everything non blocking instead of using threads. No threads, no problem. :)
<mrvn> The existing fuse bindings have a single thread that waits for fuse requests, reads the requests and starts an ocaml thread that jumps back into libfuse to execute the request which then comes back and goes to the ocaml callback. But then every single request creates a thread. No thread pool or other to reduce overhead.
|jedai| has quit [Read error: 110 (Connection timed out)]
|jedai| has joined #ocaml
<mrvn> When I call enter_blocking_section() then any caml value I hold may change, right?
<mrvn> char *buf = String_val(str); enter_blocking_section(); read(fd, buf, count); leaving_blocking_section();
<mrvn> What prevents the GC from moving str around while the read blocks?
<mrvn> I guess nothing. Hence the need for a static buffer and memmove() in otherlibs/unix/read.c
snhmib has quit ["BLAM BAM BAM BAM BAM"]
<Camarade_Tux> this is the second time I notice that but it only really annoys me now : I can't "factor" what is right to '->' in pattern-matching when using guards, it gives me a syntax error
<Camarade_Tux> anyone knows the reason ?
<Camarade_Tux> (this for instance : match 0 with | 0 when true | _ -> 1;; )
<mrvn> WTF is that?
<mrvn> syntax error on the second |
|jedai| has quit [Connection timed out]
<mrvn> Camarade_Tux: do you mean something like this: function 0 | 1 -> 0 | _ -> 1;;
|jedai| has joined #ocaml
<hcarty> Camarade_Tux: You could try searching the BTS. It sounds like it may be a bug.
<mrvn> match 0 with | 0 when true -> 1 | _ -> 1;; or match 0 with | 0 | _ -> 1;; work. But not when combined.
<Camarade_Tux> I had searched but did not found, but actually it's a terribly old bug : http://caml.inria.fr/mantis/view.php?id=453
<mrvn> Camarade_Tux: No, that is different.
<mrvn> | None | Some x when p x creates a binding x that could be used like | None | Some x when p x -> x
<mrvn> The compiler is right that the "None" has no x.
<mrvn> # let f p = function Some x when p x | None -> ();;
<mrvn> Syntax error
<mrvn> on the | just like your example.
Waleee has joined #ocaml
<Camarade_Tux> mrvn, oh right
<Camarade_Tux> I just can't believe noone hit that before...
<Camarade_Tux> (otoh the code were I noticed that could have been cleaner)
<mrvn> as to your example look at it like this: match 0 with (0 | _) when true -> 1
<mrvn> The guard is outside the "|" and there there can be no "|" after it, only "->"
<mrvn> odd.
<mrvn> Today is a day of revelations. :)
<Camarade_Tux> unfortunately I won't be able to apply anything like this in my code
<Camarade_Tux> think I'll just report it on the bts
<mrvn> Camarade_Tux: from the bug you pasted the grammatic is written that way that guards are outside the patterns. The Syntax error is correct that way.
psnively has joined #ocaml
<psnively> Howdy camls!
<Camarade_Tux> mrvn, yeah, I was actually reading the #bug to be sure it would not be a duplicate, and it is ;)
<Camarade_Tux> well, I'll just make a function taking ten arguments, each with 20-characters names then ><
<mrvn> not quite a duplicate but the explanation explains your question too.
<Camarade_Tux> hi psnively :)
<Camarade_Tux> yeah so won't be changed anyway ;)
<psnively> Tux!
<mrvn> So has anyone tried the libaio bindings yet?
<psnively> Not I.
<Camarade_Tux> not yet
* Camarade_Tux whishes it were more cross-platform
<mrvn> Do windows / macs even have such system calls?
hkBst has joined #ocaml
<mrvn> I guess macs have a librt with its aio functions. They are slightly different but could be used too.
<Camarade_Tux> windows seems to
<mrvn> the librt function (aio_read, ...) are POSIX.1-2001
<mrvn> I don't know how the librt implements this though. I know the glibc aio functions use thread pools which I wanted to avoid.
<mrvn> And hurray for having 3 interfaces to do the same thing just differently.
johnnowak has joined #ocaml
ikaros has quit [".quit"]
jackie has joined #ocaml
jlouis has quit [Remote closed the connection]
schme_ has joined #ocaml
jlouis has joined #ocaml
schme has quit [Read error: 60 (Operation timed out)]
Snark has quit ["Ex-Chat"]
|jedai| has quit [Read error: 110 (Connection timed out)]
seafood has joined #ocaml
|jedai| has joined #ocaml
olgen has quit []
johnnowak has quit []
|jedai| has quit [Connection timed out]
|jedai| has joined #ocaml
jackie has quit [Remote closed the connection]
|jedai| has quit [Connection timed out]
|jedai| has joined #ocaml
<jonafan> anyone know neural networks?
marmotine has quit ["mv marmotine Laurie"]
<Camarade_Tux> I can maybe answer _some_ questions if everybody else is asleep
<jonafan> the input values must range between -1 and 1 right?
<mrvn> whatever you want
<jonafan> well, it doesn't seem to learn if i don't do that
<mrvn> In the brain you only have "fireing" events. Not input values.
<jonafan> however, i've been using the sigmoid function that came with the library
<jonafan> which is simply tanh
<mrvn> doesn't the library say what input values to use?
<jonafan> i wrote a function to unsigmoid them, but it seems to have trouble with values higher than 18
<jonafan> i could be dealing with numbers up to 255 or more in some cases
<jonafan> will it cause any problems if i just use (v/255.) as my sigmoid function in that case?
<mrvn> wouldn't 0 map to -1 and 255 to 1?
<mrvn> (float_of_int (v-128)) /. 128. in that case
<jonafan> so the sigmoid function doesn't really matter
<mrvn> no idea
<mrvn> Just correcting your (v/255.) to range from -1 to 1.
<jonafan> yeah
<jonafan> okay
|jedai| has quit [Success]
|jedai| has joined #ocaml
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
<Camarade_Tux> hmm, nearly getting signals support in my webkit-gtk bindings :)
willb has quit [Read error: 60 (Operation timed out)]
caligula has quit [Read error: 104 (Connection reset by peer)]
m3ga has joined #ocaml
Camarade_Tux has quit ["Leaving"]
Camarade_Tux has joined #ocaml
_zack has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
m3ga has quit ["disappearing into the sunset"]
Amorphous has joined #ocaml
_zack has quit ["Leaving."]
psnively has quit []
Camarade_Tux has quit ["Leaving"]