Question

我正在尝试使用带有以下签名的消息传递接口模块编写并行前缀扫描的实现

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

使用Mpi模块，我为并行前缀扫描编写了一个实现。

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

当我尝试编译时，我得到了错误＆＃34;错误：变体类型down_incoming没有构造函数Seq＆＃34;这没有意义，因为它应该与＆＃39; receive_message＆＃39;匹配。改为输入。

Answer 1

这是因为Kill是匹配中的第一个，并且将该类型推断为具有该变体的最新类型。切换订单，你会没事的。

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

您应该在option或In类型参数周围考虑Seq，而不是在两个地方使用Kill。

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

Answer 2

由于两种类型都有构造函数Kill，因此默认情况下会在模式匹配中使用最后一种类型。因此，在遍历您的up_handler和aux函数时，由于ch的类型尚未推断，因此（错误地）推断其类型为down_incoming

解决方法：

更改模式匹配顺序（在Seq之前处理Kill。）。
手动（ch）统一receive_message类型let rec up_handler (ch:receive_message) () = ...。
为构造函数指定不同的名称。

请注意，由于这三个解决方案将生成相同的代码，因此您可以选择自己喜欢的方式（我的第二个方法）。

变体类型k没有构造函数S.

2 个答案: