mfurr changed the topic of #ocaml to: OCaml 3.08.2 available! | Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
malc_ has quit ["leaving"]
cryptilox has quit ["leaving"]
<vincenz> hi
gim has quit ["insuffisant resources: hosting computer is halting and this program is not able to migrate to another one (too bad :|). good ]
cryptilox has joined #ocaml
CosmicRay has quit ["Client exiting"]
CosmicRay has joined #ocaml
monochrom has quit ["hello"]
zzorn_afk has quit ["........"]
<dan2> how do I build an ocaml project with an OMakefile
<dan2> hello?
<dan2> CosmicRay: ping
<vincenz> if noone answers they're either gone, busy, or unknowledgeable
<vincenz> I suggest reading inside of the examples
<vincenz> it's stated quite clearly
<CosmicRay> hello dan2
<dan2> CosmicRay: hey, how do you build an application with an OMakefile
<mfurr> dan2: not sure, I usually use /usr/share/ocaml-tools/configure.in(/Makefile.in)
<CosmicRay> don't you just type make?
<dan2> I tried
<dan2> that doesn't work
<CosmicRay> there's no Makefile?
<dan2> its an OMakefile, like it depends on another program
<dan2> no
<CosmicRay> hm.
<CosmicRay> does it look like a Makefile?
<CosmicRay> it maybe uses the file in, hmm, ocaml-tools?
<CosmicRay> I thought though that OMakefile was the name of the thing that got included
<CosmicRay> I don't know, its been awhile since I hacked on those things
<CosmicRay> they're all sorta evil and screwy
<mfurr> CosmicRay: are you thinking of OCamlMakefile perhaps?
<CosmicRay> ah. yes.
<CosmicRay> that's what it is.
<dan2> Demitar: this isn't useful if i can't build it!
<dan2> CosmicRay: looks like it needs Omake
<CosmicRay> dan2: I don't think I'm going to be much help, sorry
<CosmicRay> you might try the list
<dan2> CosmicRay: no, omake works
CosmicRay has quit ["Leaving"]
|Lupin| has joined #ocaml
<|Lupin|> Hello !
<|Lupin|> So many Caml fans here ?
<vincenz> yah
<|Lupin|> quite impressive !
<vincenz> ?
<|Lupin|> Well I did not expectthat
<|Lupin|> but it's cool !
<dan2> hmm
<dan2> can I pass fd's to threads?
<|Lupin|> dan2: Where is the problem ?
<dan2> |Lupin|: its not a problem, its a question
<|Lupin|> dan2: Do you want to know ifthere is a predefined type for file descriptors ?
<dan2> |Lupin|: yeah, Unix.file_descr
<|Lupin|> yeah
<mfurr> dan2: at creation time, or while they are running
<mfurr> ?
<dan2> mfurr: while they are running
<|Lupin|> dan2: You probably need some shared variable, protected by a mutex...
<dan2> mfurr: its not really an issue, I am trying to figure out how Demitar's mailbox handles events
<dan2> ahh Queues, perfect
<|Lupin|> pls, is trunc an existing english word to express that something is brought back to a given size ?
<mfurr> not really, its an abbreviation for truncate
mfurr has quit ["Client exiting"]
mfurr has joined #ocaml
<|Lupin|> ok so truncate exists, kewl.
<dan2> Demitar: I hacked your code to add an is_empty function so I can use a loop and iterate over it
<|Lupin|> May I ask what Demitar's code does ? is it something published ?
rey_ has joined #ocaml
CosmicRay has joined #ocaml
vezenchio has quit ["haibane · renmei"]
mrsolo has joined #ocaml
<|Lupin|> Is the chan always so calm, or is it because most of the participants are in Europe and it is just to early for them ?
<mfurr> usually
<mfurr> I guess most of the people here are Lazy and only react when input is available
<|Lupin|> oh ok
CosmicRay has quit ["Leaving"]
<|Lupin|> \begin{joke} if there are so lazy then they should join #haskell ! \end{joke}
<dan2> mfurr: if something returns a triple, I can do something like this right
<dan2> let (a,b,c) = foo ();;
<mfurr> yes, exactly
<dan2> compiler isn't liking this
<dan2> let handle_events idleq mbox =
<dan2> while not (Mailbox.is_empty mbox) do
<dan2> let (a,b,c) = Mailbox.receive mbox in
<dan2> if b = CONNECTION_WAIT then Queue.add idleq (a,c)
<dan2> done;
<dan2> ();;
<dan2> mfurr: the if is stupid now, but I'll be using it later for more events
<dan2> mfurr: it doesn't like the Queue.add part, I don't know why
<dan2> This expression has type 'a * 'b but is here used with type 'c Queue.t
cryptilox has quit ["leaving"]
<mfurr> the arguments are backwards, try Queue.add (a,c) idleq
<dan2> oops
<dan2> mfurr: thanks
<mfurr> np
<dan2> Demitar: this Mailbox thing works great
<vincenz> what is the mailbox?
<dan2> mfurr: can I make types completely upper case
<dan2> vincenz: async event handler
<dan2> Demitar: I practically ripped yours apart and put a lot of new code in there with some convenience functions tho
<|Lupin|> dan2: I think you cannot use uppercase letters in type names (in first position).
<|Lupin|> dan2: I tried type Bool = bool;; in the top-level and got a syntax error
<dan2> This expression has type (Thread.t * 'a Mailbox.mbox) Queue.t
<dan2> but is here used with type ('b * eventhandle Mailbox.mbox) Queue.t
<dan2> The type constructor eventhandle would escape its scope
<dan2> I'm entertained
<dan2> hmm
<dan2> let (threadid,mbox) = Queue.pop idq
<dan2> complains about
mrvn_ has joined #ocaml
<dan2> what I want to know is how does it get the latter
<dan2> I'm not storing eventhandler at all
<dan2> mrvn_: ping
<mfurr> dan2: No, identifiers which start with an upper case letter are reserved for modules
<dan2> mfurr: forget that, I was referring to the things defined inside the type, and its fine
<dan2> mfurr: I can't seem to get by this bug
<dan2> mfurr: or don't understand it
<Riastradh> dan2, it might help if you were to paste the code to some pasting service on the web.
<dan2> Riastradh: ok, is there a good ocaml pastebin
<Riastradh> I don't know. In channels that lisppaste is absent from, rafb.net tends to be fairly popular.
mrvn has quit [Read error: 110 (Connection timed out)]
<dan2> http://mirrorlynx.com/~dan/{mailbox.ml,mailbox.mli,dialer.ml}
<Riastradh> (If you want a good really good IRC pasting service, some time ask the guy whose nick is 'chandler' to put lisppaste here.)
<dan2> Riastradh: only concerned about dialer.ml tho
<dan2> Riastradh: just paste it, or downlaod?
<Riastradh> It is fine as it is.
<|Lupin|> < mfurr> dan2: No, identifiers which start with an upper case letter are reserved for modules <-- you meant constructors, didn't you ?
<dan2> I meant this
<dan2> type foo = BLAH | FOOBAR
<dan2> ^
<dan2> :)
<mfurr> |Lupin|: err, yeah, those too
<dan2> Riastradh: its only complaing about the ok_thread call in main
<|Lupin|> mfurr: well, both actually, yeah, sorry.
<dan2> Riastradh: you figure it out?
<dan2> Riastradh: I can't
<Riastradh> Sorry, I'm a bit busy in another channel right now. I'll look at it in a minute.
<dan2> Riastradh: k
<mfurr> dan2: you need to either hoist the definition of eventhandle to a different module or make mailbox and dialer mutually recursive
<dan2> mfurr: umm, what does that mean
<Riastradh> Why would he need to do that, mfurr? eventhandle doesn't occur in mailbox.ml.
<mfurr> err... wait
<dan2> Riastradh: I can't see anything obviously wrong
<dan2> Riastradh: except eventhandle comes out of nowhere
<mfurr> ah got it
<dan2> mfurr: ok, what is it
<mfurr> you define the hashtbl after you define the type, switch the ordering
<mfurr> type eventhandle then define the hashtbl
<dan2> mfurr: what do you mean
<dan2> mfurr: what is hashtbl in my program?
<mfurr> err, sorry the Queue
<dan2> ahh ok
<mfurr> (I'm working on an ocaml project which uses a lot of hashtbl's at the moment...)
<dan2> mfurr: what do I do with these type errors
<dan2> File "dialer.ml", line 26, characters 4-39:
<dan2> Warning: this expression should have type unit.
<dan2> File "dialer.ml", line 33, characters 75-90:
<dan2> Warning: this expression should have type unit.
<dan2> File "dialer.ml", line 75, characters 4-19:
<dan2> Warning: this expression should have type unit.
<dan2> File "dialer.ml", line 81, characters 2-30:
<dan2> Warning: this expression should have type unit.
<mfurr> if you really don't care about the return types (which you probably don't in these cases), just wrap then in ignore()
<dan2> mfurr: ok
<dan2> mfurr: wrap the call?
<mfurr> foo x y z => ignore(foo x y z)
<dan2> ?!
<dan2> mfurr: how does that work
<mfurr> ignore just throws away the return value
<dan2> mfurr: still can't get rid of em
<mfurr> Did you change "Thread.create threadfunc threadarg" to "ignore(Thread.create threadfunc threadarg)" ?
<dan2> oh... now I see
<dan2> hmm
<dan2> how do I debug in ocaml
<mfurr> there are various ways depending on what kind of problems you are hitting...
<mfurr> working in a top-level is often useful
<mfurr> there's also the ocaml debugger where you can step forwards and backwards through your program
<mfurr> (quite handy)
<dan2> mfurr: hmm, dunno how to compile mine to bytecode to use the debugger
<dan2> thats what I want to use
<mfurr> just use ocamlc instead of ocamlopt
<dan2> k
<dan2> mfurr: I'm getting an uncaught exception
<dan2> mfurr: tho I can't identify from where
<mfurr> dan2: take a look at the printexc module, it can help with this
<dan2> mfurr: k
<dan2> mfurr: that doesn't work if I have more than one argumented functions
<mfurr> you can always do things like "(f w x y) z"
<dan2> mfurr: oh, I see
<dan2> mfurr: ok_thread is assuming that the Queue is filled and causing the exception, but it should be
<dan2> mfurr: create_threads is being called before main
<dan2> mfurr: it should have a stack of 10 threads ready to be loaded into event
<dan2> s/into/from/
<dan2> and the queue should be loaded
<dan2> mfurr: whats the syntax for break
<mfurr> you mean for control loops? There is none.
<dan2> mfurr: no, in ocamldebug
<dan2> mfurr: ok, going to try toplevel approach now
<dan2> mfurr: I can't figure it out
<dan2> mfurr: something is fucked
<dan2> mfurr: could you offer some assistance?
<mfurr> what exactly is the problem?
<dan2> mfurr: not a problem anymoer
<dan2> mfurr: the problem was that I forgot to wrap select in an if statement, and ok_thread was eating up all my threads
<dan2> mfurr: ok, this is bizarre now
<dan2> mfurr: if I start it with strace it works fine
<dan2> otherwise it doesn't
<mfurr> dan2: I gotta run. Good luck getting it to run
mfurr has quit ["sleep"]
<|Lupin|> Please, is it possible to include a .h file in a .ml file and to use constants defined in the .h in Caml code ?
<dan2> no
<|Lupin|> In other words can the compiler or camlp4, or some other tool expand #define macros ?
<|Lupin|> dan2: wow you seem sosure! ...
<|Lupin|> So is it a clean way to write Caml code that makes use of constants defined in C ?
<dan2> ugh
<dan2> Demitar: ping
<dan2> anybody around
<|Lupin|> yup
<dan2> |Lupin|: want to help me solve my thread problem
<dan2> where I keep gettings Queue Empty
<|Lupin|> if I can I'll be pleased to help
<|Lupin|> but I'm not sure, just ask, we'll see.
<|Lupin|> < dan2> where I keep gettings Queue Empty <-- is this your question ?
<dan2> |Lupin|: I know wehre Queue Empty, but not why
<|Lupin|> I am sorry but I don't understand what your problem is.
<dan2> Fatal error: exception Queue.Empty
<dan2> grr
<|Lupin|> You have a queue, it is empty, and you don't understand why it is empty, am I right ?
<dan2> http://mirrorlynx.com/~dan/{mailbox.ml,mailbox.mli,dialer.ml}
<dan2> |Lupin|: look at ^
<dan2> in dialer.ml
<|Lupin|> okay, pls wait.
<dan2> oh crap
<dan2> now I see whats going on
<|Lupin|> ok
<|Lupin|> So I don't need to browse the code ?
<dan2> hold on
<dan2> |Lupin|: browse through the code
<dan2> I can't figure it out
<|Lupin|> ok
<dan2> getting a Queue Empty error
<dan2> I'm pretty sure it can only happen in one place
<dan2> ok_thread
<|Lupin|> well
<dan2> theres a slight possibility it would happen in test_threadfunc at recv
<|Lupin|> just one stylistic remark
<dan2> Mailbox.recv
<|Lupin|> in creat_threads
<|Lupin|> the final () is probably not usefull
<|Lupin|> for constructs have type unit
<dan2> |Lupin|: thats irrelevant
<dan2> |Lupin|: I need to solve the problem
<|Lupin|> same remark for handle_events
<dan2> |Lupin|: its not helping
<|Lupin|> I know it has nothing to do with your problem, but shorter and clearer code is always easier to debug.
<dan2> |Lupin|: this is useless
mlh has quit [Client Quit]
<|Lupin|> in ok_thread, how can you besure that there will be something inthe queue ?
<|Lupin|> dan2: in ok_thread, how can you besure that there will be something inthe queue ?
<dan2> |Lupin|: because as soon as the thread ends, it will give handle events a CONNECTION_WAIT
<dan2> |Lupin|: and if its 0, handle_queue will load a thread before then
<|Lupin|> From my point of view
<|Lupin|> your code lacks synchronization mechanisms
<|Lupin|> Is it on purpose ?
<dan2> |Lupin|: yes
<|Lupin|> ow
<|Lupin|> So you are sure nothing bad can happen because a context switch happening ?
* dan2 kicks ocaml
<dan2> |Lupin|: because you requested it here
<|Lupin|> what did I request ?
<dan2> |Lupin|: now if there is no thread available it should add one in ok_thread
<dan2> |Lupin|: refresh
<|Lupin|> hmm I think I'll not be able to help you, sorry.
<dan2> |Lupin|: I think its being caused by Mailbox.receive
Submarine has joined #ocaml
<|Lupin|> hi Submarine
<Submarine> hi
m3ga has joined #ocaml
m3ga has quit [Client Quit]
srv has quit [Read error: 104 (Connection reset by peer)]
srv has joined #ocaml
pango has quit ["Client exiting"]
solarwind has joined #ocaml
Nutssh has joined #ocaml
Nutssh has left #ocaml []
pango has joined #ocaml
det_ has joined #ocaml
Submarine has quit ["Leaving"]
<Demitar> dan2, while the file certanily is in the public domain claiming you wrote it is bad style. (Rather add "modified by ..." or something equivalent.)
<Demitar> dan2, and I'm not sure that your implementation of is_empty is safe, _internal_queue can be modified by another thread. And I doubt it is even useful, another thread might receive an object in between you get the result and call receive thus making it block anyway, that's what poll is there for.
|Lupin| has quit ["leaving"]
srid has joined #ocaml
<srid> i am wondering how ICFP winners were using OCaml! ... when there are python, lisp, haskell ....
<Demitar> That is one peculiar question... :)
<karryall> arf
<srid> Demitar: well, i am newbie to this FP world ... know c,c++,bit of java and python (my favourite)
<srid> thinking of learning lisp and haskell .. but ocaml is really different ...
<srid> ... from ICFP point of view
<Demitar> srid, well you question has the implicit assumption that all those other languages are inherently better somehow. :)
<srid> basically my question is what makes those ICFP participants to prefer OCaml over others .. really confused
gim has joined #ocaml
<Demitar> srid, there could be a zillion different answers to that, ranging from "it R0xx0rz" to "because I invented it" to "since it's the best language so far". Choose yourself. ;-) Or be more specific. (In general I think they mostly simply like the language. :)
mrvn_ is now known as mrvn
stef_ has quit [Read error: 110 (Connection timed out)]
srid has quit [Read error: 104 (Connection reset by peer)]
stef has joined #ocaml
Godeke has quit [tolkien.freenode.net irc.freenode.net]
Godeke has joined #ocaml
zzorn has joined #ocaml
solarwind has quit ["leaving"]
solarwind has joined #ocaml
zzorn has quit ["........"]
CosmicRay has joined #ocaml
<dan2> Demitar: ping
zzorn has joined #ocaml
<dan2> Demitar: there is a problem when trying to Mailbox.recv on mbox per thread
<dan2> Demitar: the problem is that it tends to get it before the mbox does
<dan2> Demitar: I think we need a mutex
<dan2> Demitar: ping
CosmicRay has quit ["Client exiting"]
vezenchio has joined #ocaml
<dan2> cd
CosmicRay has joined #ocaml
rifleman_maynard has quit ["using sirc version 2.211+KSIRC/1.3.10"]
Submarine has joined #ocaml
pango has quit ["Leaving"]
pango has joined #ocaml
lus|wats has joined #ocaml
smimou has joined #ocaml
<dan2> whats up with Thread.kill not implemented
vezenchio has quit [Read error: 60 (Operation timed out)]
vincenz has quit [Read error: 104 (Connection reset by peer)]
cryptilox has joined #ocaml
mfurr has joined #ocaml
<dan2> mfurr: ping
<mfurr> dan2: pong
<dan2> mfurr: how do I make sure all the threads in my program aren't sleeping
<dan2> mfurr: thats the problem
<dan2> mfurr: erm, running rater
<dan2> they aren't running
<dan2> how do I send a wake up call to all of them
<mfurr> well, the same way you would make sure a single threaded program wasn't sleeping I'd imagine
<dan2> mfurr: everything I try fails
<dan2> mfurr: its not until I start sending crap over the event system do the threads wake up
<mrvn> There you have the reason why I don't use threads. You always end up with deadlocks or synchronisation problems.
<Smerdyakov> That is much less of a problem using CML (or OCaml Event).
smimou has quit ["?"]
vezenchio has joined #ocaml
<dan2> Smerdyakov: I'm using ocaml event
<dan2> Smerdyakov: all the threads are always sleeping
<Smerdyakov> You're not giving much information. I don't think of that as a problem in and of itself.
<dan2> Smerdyakov: I have to leave, but I will tell you later
<CosmicRay> smerdy!
<CosmicRay> haven't seen you in #haskell for awhile
smimou has joined #ocaml
<Smerdyakov> I'm banned.
<mfurr> What happened? Did you badmouth Microsoft Cambridge?
<Smerdyakov> Nope. I raised a stink every time they helped someone cheat on his homework.
<dan2> nack
<dan2> back
* dan2 still can't figure out why the threads never start
Smerdyakov has quit ["Client exiting"]
lus|wats has quit [Read error: 110 (Connection timed out)]
<dan2> mfurr: could you help me figure out why the threads aren't starting
<mfurr> dan2: I'm kinda busy atm
<dan2> mfurr: well, I just can't get any of my threads to start
<karryall> dan2: could it be some kind of scheduling problem ?
<dan2> karryall: thats what I think is happening
<karryall> make sure that your code need to allocate some memory
<dan2> karryall: what do you mean
<karryall> the global lock can only be released when your code enters the runtime
<dan2> karryall: it should be allocating stuff
vezenchio has quit ["haibane · renmei"]
<karryall> if you have a part of your code that never allocates (eg a for loop on a huge array), it will not switch to other threads I think
<mrvn> karryall: how about select?
<mrvn> or sleep?
<karryall> these blocking function release the lock
<karryall> so there's no problem
<dan2> ok
<dan2> that explains a lot
<dan2> karryall: even with sleep 0?
<karryall> I guess so
<karryall> you need to check the code in the unix module
<dan2> karryall: that seemed to work
<dan2> looks like I've got a new error
<dan2> Fatal error: exception Invalid_argument("Thread.kill: not implemented")
<dan2> karryall: had to run sleep 1
<dan2> 0 didn't work
<karryall> you could try select [] [] [] 0.
<dan2> ok
<dan2> karryall: nah that didn't work either
<dan2> karryall: does it matter what I allocate?
<karryall> I don't think so
<dan2> karryall: so I cna just do let v = 0
<dan2> ?
vezenchio has joined #ocaml
<karryall> no because that doesn't allocate anything :)
<karryall> it's just an integer
<dan2> karryall: ok, v = "foo"
<karryall> try let v = "foo" ^ "bar"
<dan2> hmm, whats "^" do?
<karryall> string concatenation
<dan2> karryall: that doesn't appear to be working
<karryall> what's your platform ?
<dan2> linux x86
<karryall> there was some issues with linux 2.6 and earlier releases of ocaml
<dan2> I'm on 3.08.1
<karryall> hmm, well I don't know
<dan2> karryall: nothing is working
<dan2> karryall: sleep did..
<dan2> karryall: maybe I'll run select for 0.01
<mrvn> Doesn't the event interface have a blocking call?
<dan2> mrvn: sync
<dan2> mrvn: its in the while loop in my threadfunc, (called by Mailbox.send)
<dan2> mrvn: but its not helping
<karryall> dan2: is your code somewhere so I could read it ?
Submarine has quit ["Leaving"]
Submarine has joined #ocaml
cryptilox has quit ["leaving"]
stef has quit [Nick collision from services.]
stef_ has joined #ocaml
avlondono is now known as parrot
parrot is now known as avlondono
monochrom has joined #ocaml
vincenz has joined #ocaml
mfurr has quit ["Client exiting"]
lus|wats has joined #ocaml
srv has quit [Read error: 104 (Connection reset by peer)]
srv has joined #ocaml
smimou has quit ["?"]
<Demitar> dan2, http://212.214.250.163/ocaml_event_mailbox-20041211.tar.gz , you still didn't respond to my concerns however.
CosmicRay has quit ["Client exiting"]
vezenchio has quit [Read error: 110 (Connection timed out)]
<Demitar> dan2, although I'm really not sure why it's bad that the messages short-circuit the Mailbox. It could at most affect the ordering, which really is unspecified anyway, unless you use a 1-1 thread communication.
monochrom has quit ["hello"]
cmeme has quit ["Client terminated by server"]
cmeme has joined #ocaml
cmeme has quit ["Client terminated by server"]
cmeme has joined #ocaml