Variant type k has no constructor S

Question

I am trying to write an implementation for parallel prefix scan using the message passing interface module with the following signature

module type S = sig
  type ('s, 'r) channel
  val spawn : (('r, 's) channel -> 'a -> unit) -> 'a -> ('s, 'r) channel
  val send : ('s, 'r) channel -> 's -> unit
  val receive : ('s, 'r) channel -> 'r
  val wait_die : ('s, 'r) channel -> unit
end

module Mpi : S

Using the Mpi module I write an implementation for parallel prefix scan.

val scan: ('a -> 'a -> 'a) -> 'a -> 'a t -> 'a t

type 'a t = 'a array
type 'a receive_message = Seq of 'a t | Kill
type 'a ctree = Leaf of 'a * 'a | Node of 'a ctree * 'a * 'a * 'a ctree
type 'a down_incoming = In of  'a ctree * 'a | Kill

let scan (f: 'a -> 'a -> 'a) (base: 'a) (seq: 'a t) : 'a t =
  let rec up_handler ch () =
    let rec aux () =
      match Mpi.receive ch with
        Kill -> ()
      | Seq s ->  (
        let n = length s in
          match n with
            0 -> failwith "error usage"
          | 1 -> Mpi.send ch (Leaf (nth s 0,base)); aux ()
          | _ ->
            let mid = n / 2 in
            let l,r = Mpi.spawn up_handler (), Mpi.spawn up_handler () in
            Mpi.send l (Seq (Array.sub s 0 mid));Mpi.send r (Seq (Array.sub s mid (n - mid)));
            let result = (
              match (Mpi.receive l, Mpi.receive r) with
                (Leaf (lacc,_) as l_ans), (Leaf (racc,_) as r_ans) -> Node (l_ans,f lacc racc,base,r_ans)
              | (Leaf (lacc,_) as l_ans), (Node (_,racc,_,_) as r_ans) -> Node (l_ans,f lacc racc,base,r_ans)
              | (Node (_,lacc,_,_) as l_ans), (Leaf (racc,_) as r_ans) -> Node (l_ans,f lacc racc,base,r_ans)
              | (Node (_,lacc,_,_) as l_ans), (Node (_,racc,_,_) as r_ans) -> Node (l_ans,f lacc racc,base,r_ans)
            ) in
            Mpi.send ch result;Mpi.send l Kill;Mpi.send r Kill;
            Mpi.wait_die l;Mpi.wait_die r; aux () )
    in aux ()
  in
  let rec down_handler ch () =
    let rec aux () =
      match Mpi.receive ch with
        Kill -> ()
      | In (Leaf (acc,_), p) -> Mpi.send ch (singleton (f p acc)); aux ()
      | In (Node ( ( (Leaf (lacc,_) | Node (_,lacc,_,_)) as left),acc,_,right), p) ->
        let l, r = Mpi.spawn down_handler (), Mpi.spawn down_handler () in
        Mpi.send l (In (left, p));Mpi.send r (In (right,f p lacc));
        let l_ans, r_ans = Mpi.receive l, Mpi.receive r in
        let _ = Mpi.send l Kill, Mpi.send r Kill in
        Mpi.wait_die l;Mpi.wait_die r;
        let result = (append l_ans r_ans) in
        Mpi.send ch result; aux ()
    in aux ()
  in
  match length seq with
    0 -> [||]
  | _ ->
    let up_ch = Mpi.spawn up_handler () in
    Mpi.send up_ch (Seq seq);
    let up_ans = Mpi.receive up_ch in
    let _ = Mpi.send up_ch Kill in
    Mpi.wait_die up_ch;
    let down_ch = Mpi.spawn down_handler () in
    Mpi.send down_ch (In (up_ans,base));
    let down_ans  = Mpi.receive down_ch in
    let _ = Mpi.send down_ch Kill in
    Mpi.wait_die down_ch;
    down_ans

When I try to compile I get the error "Error: The variant type down_incoming has no constructor Seq" which doesn't make sense as it should be matching with the 'receive_message' type instead.

Answer 1

It's because Kill is first in the matching and will infer the type to be the latest type with that variant. Switch the order and you will be fine.

  match Mpi.receive ch with
  | Seq s -> ...
  | Kill -> ()
  ...
  match Mpi.receive ch with
  | In (Leaf (acc,_), p) -> ...
  |  Kill -> ()

Instead of using Kill like this in two places, you should consider an option around the In or Seq type parameters.

type 'a receive_message = 'a t option
type 'a down_incoming   = ('a ctree * 'a) option

Answer 2

As both your types have a constructor Kill , the last one is used by default in a pattern matching. So when traversing your up_handler and your aux functions, as ch 's type is not yet inferred, it is (wrongly) deduced that it has type down_incoming .

Workarounds:

• Change your pattern matching order (handle Seq before Kill ).
• Unify ch with type receive_message manually ( let rec up_handler (ch:receive_message) () = ... ).
• Give different names to your constructors.

Note that as those three solution will produce the same code, it's really up to you to choose your favorite way (mine would be the second).