Need more polymorphism

[Euan Harris <euan@xxxxxxxxxxxxx>]

Hi,

I'm trying to write a small actor-style program using Core.   I'm stuck on the 
fact that Pipe.create () returns a pair of weakly polymorphic values: 

> # let r,w = Pipe.create ();;
> val r : '_a Async.Std.Pipe.Reader.t = <abstr>
> val w : '_a Async.Std.Pipe.Writer.t = <abstr>

I'm using pipes as the mailboxes for my processes, and polymorphic variants as 
the message types.   I'm using the writer ends of the pipes in place of process 
IDs - to send a message to a process, you need a reference to the writer on its 
mailbox.

The problem is that the mailboxes inherit the weakly polymorphic property of 
the underlying pipe, even once the 'a has been resolved to my message type:

> # let proc_p = spawn p ();;
> val proc_p : _[< `Ping | `Stop ] -> unit Async_core.Deferred.t = <fun>

I have two different processes that both accept the `Stop message, but as soon 
as I try to put them together in the same list, for instance to pass them to a 
'stopper' process, the original processes lose their ability to receive 
anything apart from `Stop messages:

> # let proc_q = spawn q ();;
> val proc_q : _[< `Pong | `Stop ] -> unit Async_core.Deferred.t = <fun>
> # let l = [ proc_p; proc_q ];;
> val l : (_[< `Stop ] -> unit Async_core.Deferred.t) list = [<fun>; <fun>]
> # proc_p;;
> - : _[< `Stop ] -> unit Async_core.Deferred.t = <fun>

I found a note in the OCaml FAQ that shows how to work around this problem by 
eta-expansion 
(http://caml.inria.fr/resources/doc/faq/core.en.html#eta-expansion) but I don't 
see how to apply the same technique here.   I note that the signature of 
Pipe.create isn't weakly polymorphic, so it looks like it should be possible:

> # Pipe.create;;
> - : unit -> 'a Async.Std.Pipe.Reader.t * 'a Async.Std.Pipe.Writer.t = <fun>

Full code below.   Help! :)

Thanks,
Euan

---

open Core.Std
open Async.Std

(* Spawn a 'process' running f and return its mailbox *)
let spawn f args = 
        let r,w = Pipe.create () in
        don't_wait_for (f (r,w) args);
        Pipe.write w
        
(* Simple process *)
let rec p (r,w) () = 
        Pipe.read r >>= function
        | `Ok `Ping -> print_endline "ping"; p (r,w) ()
        | `Ok `Stop -> return (print_endline "stop")
        | `Eof      -> return (print_endline "eof" )
        
let rec q (r,w) () = 
        Pipe.read r >>= function
        | `Ok `Pong -> print_endline "pong"; q (r,w) ()
        | `Ok `Stop -> return (print_endline "stop")
        | `Eof      -> return (print_endline "eof" )
        
let _ =
        let rec proc_p = spawn p ()
        and proc_q = spawn q ()
        (* and l = [proc_p;proc_q]  -- with this line uncommented, the `Ping 
and `Pong lines below won't typecheck *)
        in
        ignore (proc_p `Ping);
        ignore (proc_q `Pong);
        never_returns (Scheduler.go())