<NaCl>
rproust: I got the "launch thread from mainloop" part working. Now I am worrying about the "redirect process to output file" part, with which I am probably not waiting enough (or correctly)
dnolen has quit [Quit: dnolen]
<rproust>
NaCl: can you paste the code smwhere?
<NaCl>
yup, moment
<NaCl>
rproust: actually, I think I'm going to need to "threadify" this function. lemme try this first...
<rproust>
once you started using a monad (and Lwt is one) you need to monadify everything. That's the most annoying thing with monads…
<NaCl>
oh. wonderful
<NaCl>
how would a non-threaded part of the code get access to the result of a thread?
<Julien_T>
thx NaCl & rproust :)
<rproust>
that's the tricky part… the result of a thread is in the monad (it is under the type of Lwt.t)
<rproust>
Julien_T: np
<rproust>
NaCl: because of this, the only way to use it is with the bind or map operators
<NaCl>
Julien_T: np
<NaCl>
hmmm
<rproust>
a non-monadified function can be monadified easily: let monadify f = fun x -> return (f x)
<NaCl>
this function itself is called under ignore_result
joewilliams_away is now known as joewilliams
<rproust>
func returns ()?
<rproust>
if it's a job, wouldn't it makes sense for it to return unit Lwt.t?
<NaCl>
yes, it would
<rproust>
then line 11 should read: func () >>= fun () ->
<NaCl>
actually, the job has a result
<rproust>
what do you want to do with the result?
<NaCl>
save it for future jobs
<NaCl>
(different) jobs
<NaCl>
(slightly different)
<rproust>
like, say, put in an other queue?
<rproust>
if the other queue is named result_queue then you can replace line 11 by: func () >>= fun result -> Queue.put result_queue result; Lwt.return () >>= fun () ->
<rproust>
you execute the job (func ()), you wait for it to end (>>=), you bind the result (fun result ->), you use the result (Queue.put), you get back in the monad (return ()) and you loop again
<NaCl>
mmm
<NaCl>
cool
<rproust>
or even simpler
<rproust>
func () >>= fun res -> Queue.put result_queue res; loop ()
<NaCl>
rproust: what's the difference between open_process and with_process?
<NaCl>
in Lwt_process
<NaCl>
does with_process call the command, wait for it to finish, then call the function on the resulting "process" value?
<NaCl>
or does it start the process and do whatever immediately? It seems to be undocumented
<rproust>
I think the difference is similar to open_file and with_file (in Lwt_io)
<rproust>
these two are slightly more documented
<NaCl>
ah, cool
<rproust>
I haven't actually used Lwt_process so I'm not but it seems that open_process is used to obtain a process while with_process can create a process, use it and clean up afterward
<eikke>
ah, there's LWT people in here
larhat has quit [Quit: Leaving.]
larhat has joined #ocaml
larhat has quit [Client Quit]
philtor has joined #ocaml
<thelema_>
:( ocamldep doesn't work on .mll and .mly
avsm has joined #ocaml
eikke has quit [Read error: Operation timed out]
axiles has joined #ocaml
mfp has quit [Read error: Connection reset by peer]
lopex has quit [Ping timeout: 258 seconds]
ftrvxmtrx has quit [Quit: This computer has gone to sleep]
lopex has joined #ocaml
ankit9 has joined #ocaml
mfp has joined #ocaml
avsm has quit [Quit: Leaving.]
palomer has quit []
lopex has quit []
enthymeme has joined #ocaml
galaad has quit [Ping timeout: 260 seconds]
ftrvxmtrx has joined #ocaml
zorun has quit [Ping timeout: 260 seconds]
zorun has joined #ocaml
* NaCl
seems to be breaking ocaml
<NaCl>
with my bad code. :P
<NaCl>
Nobody would happen to know what "xcb_io.c:221: poll_for_event: Assertion `(((long) (event_sequence) - (long) (dpy->request)) <= 0)' failed." means? :P
<thelema_>
I assume there's a function poll_for_event in xcb_io.c that's raising that assertion
<flux>
I think it means you received an older event sequence from X than what the code expected
<thelema_>
I don't even know what xcb is from.
<NaCl>
I'm spawing processes that have nothing to do with X. xD
<flux>
well, xcb is an X library
<flux>
do you use X?
<NaCl>
yeah, it's a lablgtk app
<flux>
if you do, then perhaps you need to make sure that you close the X connection fds when you fork
<flux>
actually
<flux>
I think it would seem very likely to me that at some point you have two processes using the same X connection
<flux>
and Xcb (used by xlib) gets confused
* NaCl
doesn't know hiw ti di that
<NaCl>
*how to do
<flux>
how do you spawn a new process?
<thelema_>
NaCl: are you forking?
<NaCl>
using lwt
<NaCl>
Lwt_process
<flux>
strace -f might reveal something
<thelema_>
I thought that lwt was single process... hmm
eikke has joined #ocaml
<NaCl>
thelema_: I'm launching another program
<flux>
maybe lwt has hooks for running stuff when making a new process
<flux>
or maybe you can it by adding code just after the fork (I don't know the interface)
<thelema_>
a race condition between forking and handling X events?
<flux>
but then you would find the X connection FD from lablgtk and close it
<flux>
perhaps
<flux>
actually, there might be some glib functions to deal with this matter as well
<flux>
in any case, strace -f might be able to confirm if this is the case.
<NaCl>
flux: glib is using the lwt mainloop
eikke has quit [Ping timeout: 276 seconds]
* NaCl
monadifies the code more
avsm has joined #ocaml
avsm has quit [Client Quit]
olasd has joined #ocaml
<rproust>
actually, if you use Lwt_processm then it can spawn processes
<rproust>
(iirc)
<rproust>
and that's probably what confuses xcb
<NaCl>
rproust: seems taht some of the problem is the fact that the Lwt process handling functions seem to want to hold on to the fd and don't like sharing it
<NaCl>
because I just got whatever mess of code I got here to work
<thelema_>
hmm, ignore the bit about forking (mispaste, I think)
<thelema_>
the url is still for you, and may help with monads
<NaCl>
indeed
* NaCl
doesn't know how to read haskell all that well yet
* ski
. o O ( "A monad is just a monoid in the category of endofunctors, what's the problem?" -- Wadler )
<zsparks>
:D
<NaCl>
What's "Some" ?
<thelema_>
NaCl: type 'a option = None | Some of 'a
<ski>
type 'a option = None | Some of 'a
avsm has joined #ocaml
<NaCl>
mmm
<ski>
NaCl : a monad is just any type supporting a particular interface
<ski>
`t' is a monad if you can define operations
<ski>
val unit : 'a -> 'a t
<ski>
val bind : 'a t -> ('a -> 'b t) -> 'b t
<ski>
satisfying a few reasonably laws
<NaCl>
how concise
<ski>
e.g. `t' can be `option', or `list', or more interesting things like `Lwt.t'
<ski>
there are monads for expressing parsers, for expressing (angelic) nondeterminism, for expressing (cooperative) concurrency (which is what `Lwt' does)
<ski>
there are monads for expressing state, for expressing exceptions, for expressing computations using continuations, for expressing expressing-trees
<ski>
it's a very versatile concept, and therefore usually a bit hard to get a grasp of, initially
<ski>
of course, O'Caml already has native state and exceptions, so one would typically not use monads for that in O'Caml
<ski>
NaCl : i'm not sure if this made anything much clearer. i just wanted to note that it's probably wrong to say that "monads do X", for any particular task "X" that you think of
<NaCl>
ski: It's fine, I'll read up a bit.
<NaCl>
THanks
<ski>
(i suppose in some cases, a val delayed : (unit -> 'a t) -> 'a t operation could be handy as well, since O'Caml is strict)
ankit9 has quit [Quit: Leaving]
<NaCl>
Isn't that what the Lazy module is for?
<ski>
well, this would be related to `Lazy', yes
<thelema_>
NaCl: this would be a different way to do lazy
ikaros has joined #ocaml
<ski>
`Lazy' only (directly) provides operations on it's own `Lazy.t' type
<ski>
(also, possibly one could want `delayed' to not be cached, in some cases)
<ski>
(but yes, `Lazy.t' should be a monad)
<NaCl>
ah
<ski>
of course, for doing most simple things, one would probably not gain very much by using `Lazy.t' monadically
<ski>
hm, maybe reusing some generic monadic operations, i suppose
<jmcarthur>
might be an interesting monad to apply a monad transformer to
<jmcarthur>
not sure how common monad transformers are in ocaml. i'm betting not very
<jmcarthur>
actually... are they even possible?
<thelema_>
jmcarthur: using functors, probably
* NaCl
seems to have started a discussion that he doesn't entirely understand
* ski
tries
<ski>
type ('a,'m,'s) state_t = Mk_state_t of ('s -> ('s * 'a) 'm);;
<ski>
Syntax error
<ski>
ho hum ..
<thelema_>
not that way - you can't have a (foo 'm)
<ski>
maybe there's some way to apply a type variable to a type, that i'm not aware of ..
<jmcarthur>
i don't think you are allowed
<ski>
hm, but is higher-kinded types allowed ?
<jmcarthur>
not that i am aware
<thelema_>
module X (Cont: sig type 'a t) = struct type foo = int Cont.t end
<thelema_>
sometimes annoying, but usually you really mean a type with functions that act on values on that type, and functors do that.
<thelema_>
without type classes, I can't see higher kinds being useful
<ski>
(imho, both functors and higher-kinded type expressions would be useful to have at the same time)
<ski>
hm, no. probably not that extension. but something similar, for `type' declarations
<jmcarthur>
even without type classes i think it's useful
<ski>
you might e.g. want to do things like
<ski>
val freeze : ('a,ref) t -> ('a,identity) t
<ski>
or
<jmcarthur>
this means i couldn't define something like (excuse me if my syntax is bad) type ('f,'a) free = Return of 'a | Roll of ('f,'a) free 'f
<jmcarthur>
i suppose a functor can get me there, maybe
<jmcarthur>
i'm still very new to this ocaml stuff
<ski>
val typeCheck : identity t -> type_annotation t
<thelema_>
ski: I agree that those are useful, but without functions specific to the container type, you can't do anything to it.
* NaCl
is going to have to mega-reorganize this program
<ski>
thelema_ : of course these are meant to be specific to `t'
<thelema_>
jmcarthur: module F(C:sig type 'a t end) = struct type 'a free = Return of 'a | Roll of 'a free C.t end
<thelema_>
ski: ah, I didn't recognize ref, identity and type_annotation as other than abstract types.
<jmcarthur>
thelema_: i guess that isn't so bad
<ski>
thelema_ : my point was that one could easily define operations on ('a,'f) t that were polymorphic in both 'a and 'f but particular to a certain t
<thelema_>
jmcarthur: you'd have to add more functions inside C that you would use in F to actually do anything to an 'a free, but yes, it's not bad at all
<ski>
thelema_ : whether those were abstract or not doesn't matter
<thelema_>
ski: how's that different from regular polymorphic types like 'a option?
<thelema_>
or ('a, 'b) Map.t
<ski>
thelema_ : 'f there could be (instantiated to be) a "type constructor" (or whatever you call it), like ref or option
lopex has joined #ocaml
<thelema_>
ski: ah. But then how would you know to use ref functions for 'f = ref and option functions for 'f = option?
<ski>
i don't see what's worrying you
<thelema_>
the internals of such a higher kinded function would need to call different code for different types, no?
<ski>
no
<ski>
it would be polymorphic
<ski>
just like `map' is polymorphic in the element types
<thelema_>
map can do that because the element types are just single words, and are not manipulated at all.
<ski>
(otherwise a functor would probably be more appropriate, i agree)
<NaCl>
adrien: I don't think I'm only using your "add row" routine now
<ski>
thelema_ : yeah, the same can apply to 'f above :)
<NaCl>
adrien: bah, I'm only using your add_row routine, most of the rest of your code has been "ignored" :P
<thelema_>
ski: so you're just skipping writing the type parameters on ref/option -- ('a, ref) t == ('a, 'b ref) t
<ski>
no, i am not
<ski>
# type 'a ref_list = 'a ref_cell ref
<ski>
and 'a ref_cell = Nil | Cons of 'a * 'a ref_list;;
<ski>
take this type declaration, and now abstract out the `ref' part
<ski>
i want to be able to write both
<thelema_>
('a ref) list
<ski>
val freeze : ('a,ref) indirect_list -> ('a,identity) indirect_list
<thelema_>
well, ocaml doesn't have this except through functors, as to use such a data structure with the ref part abstracted out would be impossible, as you need code from ref to understand it.
<ski>
well, some parts of the algorithms might be independent of whether you're using `ref' or `Lazy.t' or `option' or whatever
<ski>
so, it makes sense to be able to abstract out the common part
<ski>
and yes, functors can get you much of this
<thelema_>
true, but you need some magic like typeclasses or objects to resolve the dependent parts of the algorithms without generating code for every possible type
<ski>
but i don't think it can give you all -- at least it would in many cases be more convoluted than what feels necessary
<ski>
you don't need type-classes
<ski>
you can just pass ordinary arguments/records, e.g.
<thelema_>
objects would work, and whole program compilation would work.
<thelema_>
you need type-specific code
<ski>
like the two mapping arguments to `map' above
<thelema_>
this means passing around that code in some sort of structure or resolving it all at compile time
<ski>
one maps 'a into 'b , one maps 'f into 'g
<ski>
thelema_ : yes
<ski>
just like the function argument for the ordinary `map' for lists, e.g.
<thelema_>
hmm, okay, for the map example, the needed code seems to be provided
<ski>
type classes just make it so you don't have to explicitly specify the record of methods to use, everywhere
<thelema_>
yes, similar to objects
<ski>
(and make sure you can have at most one such record associated with each type, for a particular type class, to remove ambiguities
<ski>
)
<ski>
to some extent, i suppose :)
<thelema_>
just the code dictionary part
<jmcarthur>
consider my free example earlier... you can define (('a -> 'b) -> 'a 'f -> 'b 'f) -> ('a,'f) free -> ('a -> ('b,'f) free) -> ('b,'f) free without knowing what 'f is
<jmcarthur>
(using my not-valid-ocaml version)
* ski
. o O ( s/free/free_monad/ )
<jmcarthur>
yes
<jmcarthur>
that first function would normally be defined by haskell's Functor type class, but here it's just an argument
* ski
thinks jmcarthur example might be better, in that it's not higher-ranked
<thelema_>
ok, type classes aren't required
<ski>
thelema_ : i suppose i'm just saying that there are cases in which it'd make sense to abstract on "non-concrete" types like `ref'
<ski>
i agree that functors are great to have, and you're probably right that in many cases they suffice perfectly well
<ski>
(i'm often missing functors in Haskell)
<jmcarthur>
i am in no position to criticize or praise functors yet
<jmcarthur>
i can only complain that i can't do it the way i'm used to
<ski>
hehe
<ski>
(that's probably both good and bad : it's an opportunity to try to learn some alternate approaches and ideas)
vivanov has quit [Ping timeout: 246 seconds]
axiles has quit [Remote host closed the connection]
lopexx has joined #ocaml
lopex has quit [Ping timeout: 252 seconds]
lopexx has quit [Client Quit]
lopex has joined #ocaml
edwin has quit [Remote host closed the connection]
<thelema_>
any lablgtk experts here? I have to make a procedurally generated treeview
<thelema_>
I have row_expanded hooked to add children, but it can't be called if there's no children, as there's no expander triangle
mcclurmc_home has quit [Ping timeout: 255 seconds]
<thelema_>
figured it out: needed to add children when their parent was expanded.
BiDOrD has joined #ocaml
Vassia has quit [Quit: Quitte]
lamawithonel has quit [Read error: Connection reset by peer]
lopex has quit [Ping timeout: 244 seconds]
clog has quit [Ping timeout: 276 seconds]
clog has joined #ocaml
othiym23 has joined #ocaml
lopex has joined #ocaml
enthymeme has quit [Ping timeout: 258 seconds]
mcclurmc_home has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
Morphous_ has quit [Ping timeout: 255 seconds]
Morphous_ has joined #ocaml
dnolen has joined #ocaml
Cyanure has quit [Remote host closed the connection]