OCaml多态递归错误

时间:2018-05-29 14:30:00

标签: ocaml gadt bucklescript

考虑以下类型:

type _ task =
| Success : 'a -> 'a task
| Fail : 'a -> 'a task
| Binding : (('a task -> unit) -> unit) -> 'a task
| AndThen : ('a -> 'b task) * 'a task -> 'b task
| OnError : ('a -> 'b task) * 'a task -> 'b task

type _ stack =
| NoStack : 'a stack
| AndThenStack : ('a -> 'b task) * 'b stack -> 'a stack
| OnErrorStack : ('a -> 'b task) * 'b stack -> 'a stack

type 'a process = 
{ root: 'a task 
; stack: 'a stack 
}

let rec loop : 'a. 'a process -> unit = fun proc ->
match proc.root with
| Success value -> 
    let rec step = function
    | NoStack -> ()
    | AndThenStack (callback, rest) -> loop {proc with root = callback value; stack = rest }
    | OnErrorStack (_callback, rest) -> step rest  <-- ERROR HERE
    in
    step proc.stack
| Fail value -> 
    let rec step = function
    | NoStack -> ()
    | AndThenStack (_callback, rest) -> step rest
    | OnErrorStack (callback, rest) -> loop {proc with root = callback value; stack = rest }
    in
    step proc.stack
| Binding callback -> callback (fun task -> loop {proc with root = task} )
| AndThen (callback, task) -> loop {root = task; stack = AndThenStack (callback, proc.stack)}
| OnError (callback, task) -> loop {root = task; stack = OnErrorStack (callback, proc.stack)}

我从编译器收到错误:

  

错误:此表达式具有类型b#1堆栈          但是表达式是一个堆栈类型          类型构造函数b#1将逃避其范围

在这行代码中:

| Success value -> 
    let rec step = function
    | NoStack -> ()
    | AndThenStack (callback, rest) -> loop {proc with root = callback value; stack = rest }
    | OnErrorStack (_callback, rest) -> step rest  <-- ERROR HERE
    in
    step proc.stack

需要一段时间才能实现这一目标,而不会遇到使用某些助手类型不可避免地纠正的模糊错误消息,但我似乎无法弄清楚如何纠正此问题帮助者,或者如果我试图用我的类型做些蠢事。

消除此错误的正确方法是什么?

2 个答案:

答案 0 :(得分:0)

我认为这些功能有些不连贯。添加一些注释并删除不相关的分支会给出:

let rec loop (type s) (proc : s process) =
  match proc.root with
  | Success value -> 
      let rec step (type t) (x : t stack) =
        match x with
        | NoStack -> ()
        | AndThenStack (callback, rest) ->
            loop {proc with root = callback value; stack = rest }
                                          (*^^^^^*)
        | OnErrorStack (callback, rest) -> step rest
      in
      step proc.stack
  | _ -> ()

其中“带下划线”的变量是错误消息的主题:

  

错误:此表达式具有类型s,但预期表达式为t

如果第一次通过step(OnErrorStack : unit stack)进行操作,然后第二次通过step(AndThenStack : int stack)进行操作会发生什么?

换句话说,如果loop的参数类似于:

{ root = Success ();
  stack = OnErrorStack ((fun () -> Success 3),
                        AndThenStack ((fun x -> Success (float_of_int x)),
                                      (NoStack : float stack))) }

虽然(value : unit)将与第一个step兼容,但在我看来,没有任何东西可以保证它与第二个step的兼容性,而第二个OnErrorStack的作用相当于存在类型的值int(反例中的<a href="/news/2018/05/israeli-army-projectiles-fired-israel-gaza-180529051139606.html"> <h2 class="top-sec-title"> Israel launches counterattacks in Gaza amid soaring tensions </h2> </a> )。

答案 1 :(得分:0)

需要将第二个变量添加到任务类型定义中以表示单独的成功和失败值。这是完整的解决方案:

type (_,_) task =
| Success : 'a -> ('a,_) task
| Fail : 'x -> (_,'x) task
| Binding : ((('a,'x) task -> unit) -> unit) -> ('a,'x) task
| AndThen : ('a -> ('b,'x) task) * ('a,'x) task -> ('b,'x) task
| OnError : ('x -> ('a,'y) task) * ('a,'x) task -> ('a,'y) task

type (_,_) stack =
| NoStack : (_,_) stack
| AndThenStack : ('a -> ('b,'x) task) * ('b,'x) stack -> ('a,'x) stack
| OnErrorStack : ('x -> ('a,'y) task) * ('a,'y) stack -> ('a,'x) stack

type ('a,'x) process = 
{ root: ('a,'x) task 
; stack: ('a,'x) stack 
}

let rec loop : type a x. (a, x) process -> unit = fun proc ->
match proc.root with
| Success value -> 
    let rec step : 'x. (a, 'x) stack -> unit = function
    | NoStack -> ()
    | AndThenStack (callback, rest) -> loop {root = callback value; stack = rest }
    | OnErrorStack (_callback, rest) -> step rest
    in
    step proc.stack
| Fail value -> 
    let rec step : 'a. ('a, x) stack -> unit = function
    | NoStack -> ()
    | AndThenStack (_callback, rest) -> step rest
    | OnErrorStack (callback, rest) -> loop {root = callback value; stack = rest }
    in
    step proc.stack
| Binding callback -> callback (fun task -> loop {proc with root = task})
| AndThen (callback, task) -> loop {root = task; stack = AndThenStack (callback, proc.stack)}
| OnError (callback, task) -> loop {root = task; stack = OnErrorStack (callback, proc.stack)}