Generates compiler error

open Core.Std
open Async.Std
 
let reader,writer = Pipe.create()
 
let reader2,writer2 = Pipe.create()
 
type ('a,'b) obs = Fwd of 'a | Back of 'b;;
 
let swap obs = match obs with Fwd x -> Back x | Back x -> Fwd x
 
let read_write r w s = let open Deferred.Monad_infix in Pipe.read r >>= function
   | `Eof -> Deferred.return (`Finished s) | `Ok obs -> Pipe.write w (swap obs) >>| fun () -> `Repeat s
 
 (** Generate compiler error because ('a,'b) obs and ('b,'a) obs share no 
     common type parameters to the readers and writers *)
 let f1 = read_write reader writer2
 let f2 = read_write reader2 writer

Solution

open Core.Std
open Async.Std
module R = Pipe.Reader
module W = Pipe.Writer
 
type ('a,'b) obs = Fwd of 'a | Back of 'b
 
let swap obs = match obs with Fwd x -> Back x | Back x -> Fwd x
 
 
module Reveal = 
struct  
(** This will concretely bind the type parameters between the two different pipes *)
type ('a,'b) t = {reader1:('a,'b) obs R.t;
            writer1:('a, 'b) obs W.t;           
            reader2:('b, 'a) obs R.t;
            writer2:('b, 'a) obs W.t}
 
let create () = 
  let reader1, writer1 = Pipe.create() in 
  let reader2, writer2 = Pipe.create() in
  {reader1;writer1;reader2;writer2}
 
let read_write r w s = let open Deferred.Monad_infix in Pipe.read r >>= function
   | `Eof -> Deferred.return (`Finished s) | `Ok obs -> Pipe.write w (swap obs) >>| fun () -> `Repeat s
 
(* This compiles because ('b, 'a) obs and ('a,'b) now refer to the same 'a and 'b types *)
let from_chan t = read_write t.reader1 t.writer2
let to_chan t = read_write t.reader2 t.writer1
end