polymorphicなopen recursionを作りたい
OCaml 4.02で導入されたExtensible variant typesを使ってexpression problemの解のようなものを書いていた際、polymorphicなopen recursionが欲しくなりましたが、書けなくて困っています。
module Lang = struct
type 'a expr = ..
type 'a expr +=
Num : int -> int expr
| App : ('a -> 'b) expr * 'a expr -> 'b expr
type reval = { f : 'a. 'a expr -> 'a }
(* open recursion. polymorphicなlet recだと拡張できないので。 *)
(* evalをレコードにしてあるのは、Appのeval適用で型が異なる適用を二回行うので、forallを付ける必要があったから。 *)
let open_eval (type a) (eval:reval) (exp:a expr) : a =
match exp with
Num i -> i
| App (f, x) -> eval.f f (eval.f x)
| _ -> failwith "no match"
end
(* Langのデータと関数の両方の拡張. *)
module Plus = struct
type 'a Lang.expr +=
Plus : (int -> int -> int) Lang.expr
let open_eval (type a) (eval:Lang.reval) (expr:a Lang.expr) : a =
match expr with
Plus -> (+)
| x -> Lang.open_eval eval x
let show : type a. a Lang.expr -> string = function
Plus -> "plus"
| Lang.App _ -> "app"
| Lang.Num _ -> "num"
| _ -> "no match"
end
ここまではコンパイル通ります。しかし、その後不動点演算子fixによってfix Plus.open_eval
したいのですが、fixの実装はどうやって書けばいいのでしょうか?
通常の不動点演算子は下記の記事のようにかけるのは知っています。
http://d.hatena.ne.jp/KeisukeNakano/20060926/1159273362
そもそも書けないのかもしれませんが、ご助言ありましたら宜しくお願い申し上げます。
追記
ちなみに、
let fix (`M x) y = y Lang.{ f = fun z -> x (`M x) y z }
だと
Error: This field value has type 'b Lang.expr -> 'b which is less general than 'a. 'a Lang.expr -> 'a
のようにfix定義時にエラーになります。orz