I'm having some trouble getting functors to play nice with polymorphism.

I'm using a functor to parallelize a function, so given a function 
wrapped up in a module, I apply a functor to it get a module with 
several parallel versions of the function.  The in/output of the 
functions have to be types wrapped up in a Message module (as they may 
need to be serialized).

This is pretty trivial for monomorphic functions, but I can't seem to 
define the Bind functor correctly to allow a polymorphic function 
definition which is bound to two message types at functor application.  
I've tried every variation on the theme I can think of, but I can't 
seem to make it work.

Is what I'm trying to do possible?  I think it is because I did 
something similar for polymorphic messages (included in code, but not 
used).  Maybe someone could point out to me something I'm overlooking?

(Code inlined below)

Thanks,
--Jonathan

functor_test.mli
----------------

module type Message =
  sig
    type t
    val to_string : t -> string
    val of_string : string -> t
  end

module type PolyMessage =
  functor (M : Message) ->
  sig
    type 'a t
    val to_string : M.t t -> string
    val of_string : string -> M.t t
  end

module BindMessage :
  functor (P : PolyMessage) ->
  functor (M : Message) ->
  Message

module type Function =
  sig
    module A : Message
    module B : Message
    val f : A.t -> B.t
  end

module type PolyFunction =
  (*
  functor (A : Message) ->
  functor (B : Message) ->
  *)
  sig
    (* val f : A.t -> B.t *)
    val f : 'a -> 'b
  end

module BindFunction :
  functor (F : PolyFunction) ->
  functor (A : Message) ->
  functor (B : Message) ->
  Function

module type ParallelFunction =
  sig
    module A : Message
    module B : Message
    val sequential : A.t -> B.t
    val concurrent : A.t -> B.t
    val parallel : A.t -> B.t
    val remote : A.t -> B.t
  end

module Parallelize : functor (F : Function) -> ParallelFunction

module IntMessage : Message
module FloatMessage : Message

module Double : Function

module Identity : PolyFunction
module BoundIdentity : Function

module ParallelDouble : ParallelFunction
module ParallelIdentity : ParallelFunction

functor_test.ml
----------------

module type Message =
  sig
    type t
    val to_string : t -> string
    val of_string : string -> t
  end

module type PolyMessage = functor (M : Message) ->
  sig
    type 'a t
    val to_string : M.t t -> string
    val of_string : string -> M.t t
  end

module BindMessage =
  functor (P : PolyMessage) ->
  functor (M : Message) ->
  struct
    module P = P (M)
    type t = M.t P.t
    let to_string m = P.to_string m
    let of_string s = P.of_string s
  end

module type Function =
  sig
    module A : Message
    module B : Message
    val f : A.t -> B.t
  end

module type PolyFunction =
  (*
  functor (A : Message) ->
  functor (B : Message) ->
  *)
  sig
    (* val f : A.t -> B.t *)
    val f : 'a -> 'b
  end

module BindFunction =
  functor (F : PolyFunction) ->
  functor (A : Message) ->
  functor (B : Message) ->
  struct
    module A = A
    module B = B
    let f x = F.f x
  end

module type ParallelFunction =
  sig
    module A : Message
    module B : Message
    val sequential : A.t -> B.t
    val concurrent : A.t -> B.t
    val parallel : A.t -> B.t
    val remote : A.t -> B.t
  end

module Parallelize = functor (F : Function) ->
  struct
    module A = F.A
    module B = F.B
    let sequential x = F.f x
    let concurrent x = F.f x
    let parallel x = F.f x
    let remote x = F.f x
  end

module IntMessage =
  struct
    type t = int
    let to_string m = string_of_int m
    let of_string s = int_of_string s
  end

module FloatMessage =
  struct
    type t = float
    let to_string m = string_of_float m
    let of_string s = float_of_string s
  end

module Double =
  struct
    module A = IntMessage
    module B = IntMessage
    let f x = 2 * x
  end

module Identity =
  (*
  functor (A : Message) ->
  functor (B : Message) ->
  *)
  struct
    let f x = (Obj.magic x : 'b)
    
    (* Fails type checking, why?
    let f x = x
    *)
  end

module BoundIdentity = BindFunction (Identity) (IntMessage) (IntMessage)

(* Fails type checking, as it should:
module BoundIdentity = Bind (Identity) (IntMessage) (FloatMessage)
*)

module ParallelDouble = Parallelize (Double)
module ParallelIdentity = Parallelize (BoundIdentity)