大駱駝解軆變造概説補遺
OCaml Meeting 2009 in Tokyo で私が発表した、「大駱駝解軆變造概説」という OCaml コンパイラを改造するお話の補遺です。
スライド: http://ocaml.jp/?plugin=attach&refer=Users%20Meeting&openfile=camlmod.pdf
トーク動画: http://www.ustream.tv/recorded/2073121
そして、このお話のために準備した改造パッチ: http://ocaml.jp/?plugin=attach&refer=Users%20Meeting&openfile=OCM-patch2.txt
このパッチを使用して (+) と (+.) を SML 97 風に (+) 一つにオーバーロードするのですが、パッチの実際の使用法と、長いわりに判りにくいですが、パッチの解説をしておきたいと思います。あまりこういう話が頻繁に世の中に出てくるとも思えませんので。
なおこの記事は特に予告無しに修正、拡充します。
ビルド方法
OCaml 3.11.1 のソースコードを取ってくる: (http://caml.inria.fr/pub/distrib/ocaml-3.11/ocaml-3.11.1.tar.gz)
ソースを展開
$ tar zxvf ocaml-3.11.1.tar.gz
dry-run でパッチをテスト (私は dry-run なんか知らなかったころは泣きながらパッチを当てては失敗し、バックアップを取っていなくて泣きながらオリジナルソースをダウンロードしなおし、またパッチで失敗し、を繰り返していました。)
$ cd ocaml-3.11.1 $ patch -p1 --dry-run < OCM-patch2.txt patching file ... ...
変なプロンプトが出たりエラーが出たら何かおかしいので確認。
実際にパッチをあてる
$ patch -p1 < OCM-patch2.txt
$ ./configure $ make core $ make coreboot # ブートストラップ $ make ocaml # インタプリタ
この時点でトップレベル・インタプリタが出来てるので遊んでみる
$ ./byterun/ocamlrun ./ocaml -I stdlib/ Objective Caml version 3.11.1+OCM-patch # 1 + 2;; - : int = 3 # 1.2 + 3.4;; - : float = 4.6 # ^D (* Ctrl+D で抜ける *)
全部コンパイル
$ make world $ make opt $ make opt.opt $ make install # したかったら。オリジナルを上書きするかもしれないから注意。
解説
Parsetree の拡張
(+) は通常は identifier (Pexp_ident _) としてパースされますが、この拡張では (+) を特別視して特殊な型付けを行います。(実際にはそこまでする必要は無いのですけれど、パーサ部分の改造例がほしかったので。)そのためにまず、パースツリー定義中の Parsetree.expression_desc を拡張して「オレ(+)」 のためのコンストラクタ Pexp_super_plus を追加します。
diff -r 397b59b4697c parsing/parsetree.mli --- a/parsing/parsetree.mli Wed Jun 17 13:12:31 2009 +0900 +++ b/parsing/parsetree.mli Mon Aug 31 03:55:04 2009 +0900 @@ -112,6 +112,7 @@ | Pexp_lazy of expression | Pexp_poly of expression * core_type option | Pexp_object of class_structure + | Pexp_super_plus (* Value descriptions *)
Parser の拡張
次に (+) を見たら Pexp_ident _ ではなく、新しく作った Pexp_super_plus として解釈するようにします。これはちょうど演算子名から Pexp_ident _ を作る Parser.mkoperator という関数がありましたので、これを変更します。"+" なら Pexp_super_plus にするだけです。
diff -r 397b59b4697c parsing/parser.mly --- a/parsing/parser.mly Wed Jun 17 13:12:31 2009 +0900 +++ b/parsing/parser.mly Mon Aug 31 03:55:04 2009 +0900 @@ -45,7 +45,10 @@ let reloc_exp x = { x with pexp_loc = symbol_rloc () };; let mkoperator name pos = - { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos } + if name = "+" then + { pexp_desc = Pexp_super_plus; pexp_loc = rhs_loc pos } + else + { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos } (* Ghost expressions and patterns:
Parsetree を拡張した余波を fix
Parsetree.expression_desc を拡張したため、 Parsetree.expression_desc のパターンマッチをしていた所が網羅的ではなくなってしまいました。それを make core で見つけながら潰していきます:
diff -r 397b59b4697c parsing/printast.ml --- a/parsing/printast.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/parsing/printast.ml Mon Aug 31 03:55:04 2009 +0900 @@ -202,6 +202,7 @@ let i = i+1 in match x.pexp_desc with | Pexp_ident (li) -> line i ppf "Pexp_ident %a\n" fmt_longident li; + | Pexp_super_plus -> line i ppf "Pexp_super_plus\n"; | Pexp_constant (c) -> line i ppf "Pexp_constant %a\n" fmt_constant c; | Pexp_let (rf, l, e) -> line i ppf "Pexp_let %a\n" fmt_rec_flag rf;
上はパースツリーのプリンタの部分。簡単。
diff -r 397b59b4697c tools/depend.ml --- a/tools/depend.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/tools/depend.ml Mon Aug 31 03:55:04 2009 +0900 @@ -117,6 +117,7 @@ let rec add_expr bv exp = match exp.pexp_desc with Pexp_ident l -> add bv l + | Pexp_super_plus -> () | Pexp_constant _ -> () | Pexp_let(_, pel, e) -> add_pat_expr_list bv pel; add_expr bv e | Pexp_function (_, opte, pel) ->
依存関係抽出ツール ocamldep のコード。Pexp_super_plus は他の値に依存する必要が無いので、定数 Pexp_constant _ と同じ扱いでよいです。
diff -r 397b59b4697c tools/ocamlprof.ml --- a/tools/ocamlprof.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/tools/ocamlprof.ml Mon Aug 31 03:55:04 2009 +0900 @@ -171,6 +171,7 @@ and rw_exp iflag sexp = match sexp.pexp_desc with Pexp_ident lid -> () + | Pexp_super_plus -> () | Pexp_constant cst -> () | Pexp_let(_, spat_sexp_list, sbody) ->
プロファイラのコードです。何をやってるか、わかりませんが、Pexp_ident _ も Pexp_constant _ も () を返してるんだから、Pexp_super_plus も () で良いでしょう。
diff -r 397b59b4697c typing/unused_var.ml --- a/typing/unused_var.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/typing/unused_var.ml Mon Aug 31 03:55:04 2009 +0900 @@ -113,6 +113,7 @@ begin try (Hashtbl.find tbl id) := true; with Not_found -> () end; + | Pexp_super_plus -> () | Pexp_ident _ -> () | Pexp_constant _ -> () | Pexp_let (recflag, pel, e) ->
これは、定義されてるけど使われてない値を捜し出す unused_var.ml の一部。これも Pexp_ident _, Pexp_constant _ が () を返すんだからPexp_super_plus も () でいいんだろう。こんな感じでバリアントを拡張した場合はコンパイルしていけば、明らかに直すべき所がエラーとし発見されていくので関数型言語のパターンマッチは便利すぎて止められません。もちろん、 ocamlc -w A -warn-error A とかしてちゃんとパターンマッチの問題をエラーとして扱ってあげて初めて可能な事なんですけど。
型推論部分の改造
さて、この辺までやってくると make core すると typing/typecore.ml でエラーに。これは Parsetree を Typedtree に変換する所で、この改造のメイン部分です。まず、Pexp_super_plus に対応するモノを作ってあげましょう。
diff -r 397b59b4697c typing/typedtree.ml --- a/typing/typedtree.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/typing/typedtree.ml Mon Aug 31 03:55:04 2009 +0900 @@ -79,6 +79,7 @@ | Texp_assertfalse | Texp_lazy of expression | Texp_object of class_structure * class_signature * string list + | Texp_super_plus and meth = Tmeth_name of string diff -r 397b59b4697c typing/typedtree.mli --- a/typing/typedtree.mli Wed Jun 17 13:12:31 2009 +0900 +++ b/typing/typedtree.mli Mon Aug 31 03:55:04 2009 +0900 @@ -78,6 +78,7 @@ | Texp_assertfalse | Texp_lazy of expression | Texp_object of class_structure * class_signature * string list + | Texp_super_plus and meth = Tmeth_name of string
Parsetree.expression_desc の Pexp_ident _ は Typedtree では Typedtree.expression_desc の Texp_ident _ に変換されます。なので、Pexp_super_plus には Texp_super_plus にしてみました。
では、Pexp_super_plus を Texp_super_plus に型付けしていく本改造のメイン部分に入ります。
diff --git a/typing/typecore.ml b/typing/typecore.ml --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -930,7 +952,39 @@ let rec type_exp env sexp = match sexp.pexp_desc with - Pexp_ident lid -> + | Pexp_super_plus -> + (* type of super plus is 'a -> 'a -> 'a + where + - 'a is fresh + - 'a cannot be generalized + *) + let tvar = Btype.newty2 Btype.lowest_level Tvar in + let typ = + (* lowest_level <= !current_level, therefore variables with + lowest_level cannot be generalized + + But lowest_level is too low. The level of the variable + should be same or larger than Path.binding_time <int/float> + Otherwise the type system complains about escaping + int/float from their scopes. + + Therefore, we have to change the meaning of lowest_level a + little bit. See ctype.ml, update_level. + *) + Ctype.newty (Tarrow ("", + tvar, + Ctype.newty (Tarrow("", tvar, tvar, Cok)), + Cok)) + in + let exp = + { exp_desc = Texp_super_plus; + exp_loc = sexp.pexp_loc; + exp_type = typ; + exp_env = env } + in + Weak_variable.add tvar exp; + re exp + | Pexp_ident lid -> begin try if !Clflags.annotations then begin try let (path, annot) = Env.lookup_annot lid env in
基本的には Pexp_super_plus のための型 typ = '__a -> '__a -> '__a を作ってあげて、それを Texp_super_plus と一緒にして exp を作ってあげてるだけ。ただこの '__a (上では tvar) が曲者で、こいつは間違っても let-polymorphism で generalize されてはいけない。されちゃうと、let double x = x + x とかが polymorphic になってしまい、
- Haskell style のオーバーローディングを実装せざるを得なくなる
- さもなければ let double x = x + x はエラーにせざるを得なくなる (OCaml Meeting では、簡単のために、この仕様での拡張しかお話していません)
のどちらかになります。上記リンクのパッチによる拡張では Meeting でのトークから発展して、SML97 の挙動と同じ、
- let double x = x + x in double 1.2;; は + を float の演算として通したい
- let double x = x + x;; のように、コンテクストからパラメータの型がわからない場合は int の演算と見なす
という仕様で行きます。'__a と書いたのは特にこの型変数が多相にならないこと、そして最終的には int か float に instantiate される事を強調するためです。
さて、どの let-polymorphism でも型変数が generalize されないようにするためには、'__a はどの let-polymorphism レベルよりも低いレベル、つまり Btype.lowest_level を持っていなければいけません。
ラクダ君のちょっといい話
OCaml では let(と他の polymorphism) の入れ子レベルによって型変数の generalizability を判定します。自由型変数のレベルはその変数が出現する最低の let レベルです。型をある let で generalize する際には、 その let のレベルと同じか高いレベルを持つ自由型変数だけを generalize します。逆に let レベルより低いレベルを持つ自由型変数は、その let の外側に出現するので、let-polymorphism のルールによりgeneralize の対象から外れる訳です。所謂 let での型の generalization のルール σ = ∀FV(τ)＼FV(Γ).τ の集合計算の部分を let レベルという整数値の比較で賢く実装しているのです。
自由型変数 '__a (tvar) は今のところ型変数ですが、最終的には int か float に unifyされていてほしい。これを後で型付けが安定した所で行うために、 '__a の事を覚えておく必要があいます。この登録をしているのが Weak_variable.add tvar exp の式。 話が前後しますが '__a を管理するのが次の Weak_variable モジュールです。名前は MacQueen の weak type variable に由来します:
diff --git a/typing/typecore.ml b/typing/typecore.ml --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -90,6 +91,26 @@ node ;; +module Weak_variable = struct + let var_exps = ref [] + let add var exp = var_exps := (var,exp) :: !var_exps + let check () = + List.iter (fun (var, e) -> + let ty = Ctype.expand_head e.exp_env var in + match ty.desc with + | Tlink _ -> assert false + | Tvar -> + (* defaulting to int *) + unify e.exp_env ty (instance Predef.type_int) + | Tconstr (p, [], _) + when p = Predef.path_int || p = Predef.path_float -> + () + | _ -> + raise (Error (e.exp_loc, + Super_plus_illegal_instance ty)) + ) !var_exps; + var_exps := [] +end (* Typing of constants *)
Ctype.expand_head は、type hoge = int などの alias された型 hoge を大元の int にまで落してくれる関数です。
Weak_variable.check () は登録されたかつて '__a だった型を見て、それが int か float に unify されているかどうかを調べます。変数のままの場合は int に unify してしまいます。このため、 let double x = x + x;; のように、結局何にも使われなかった俺(+)がある式は int -> int になります。それ以外の型に unify されてしまっていた場合、たとえば、let double x = x + x in double "hoge";; はSuper_plus_illegal_instance _ エラーにします。このエラーは Typecore.error を拡張して宣言しています:
diff -r 397b59b4697c typing/typecore.mli --- a/typing/typecore.mli Wed Jun 17 13:12:31 2009 +0900 +++ b/typing/typecore.mli Mon Aug 31 03:55:04 2009 +0900 @@ -100,6 +100,7 @@ | Not_a_variant_type of Longident.t | Incoherent_label_order | Less_general of string * (type_expr * type_expr) list + | Super_plus_illegal_instance of type_expr exception Error of Location.t * error diff --git a/typing/typecore.ml b/typing/typecore.ml --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -60,6 +60,7 @@ | Not_a_variant_type of Longident.t | Incoherent_label_order | Less_general of string * (type_expr * type_expr) list + | Super_plus_illegal_instance of type_expr exception Error of Location.t * error @@ -2247,3 +2301,5 @@ report_unification_error ppf trace (fun ppf -> fprintf ppf "This %s has type" kind) (fun ppf -> fprintf ppf "which is less general than") + | Super_plus_illegal_instance ty -> + fprintf ppf "Super (+) cannot be used for type %a" type_expr ty
後半はエラーメッセージの生成です。
さて、型が落ち着いたら、Weak_variable.check () を呼ぶのですが、それは force_delayed_check 関数が丁度型が安定した時に最後に呼出す関数なので、そこで呼出すことにしましょう:
diff --git a/typing/typecore.ml b/typing/typecore.ml --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -602,6 +623,7 @@ let reset_delayed_checks () = delayed_checks := [] let add_delayed_check f = delayed_checks := f :: !delayed_checks let force_delayed_checks () = + Weak_variable.check(); (* checks may change type levels *) let snap = Btype.snapshot () in List.iter (fun f -> f ()) (List.rev !delayed_checks);
俺(+)のコンパイル
さあ、ここまで来れば、make core が失敗するのは bytecomp の中になります。最後の仕上げ、Texp_super_plus を Lambda.lambda に変換です:
diff -r 397b59b4697c bytecomp/translcore.ml --- a/bytecomp/translcore.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/bytecomp/translcore.ml Mon Aug 31 03:55:04 2009 +0900 @@ -583,6 +583,39 @@ raise(Error(e.exp_loc, Free_super_var)) | Texp_ident(path, {val_kind = Val_reg | Val_self _}) -> transl_path path + | Texp_super_plus -> + let ty = + match (Ctype.repr e.exp_type).desc with + | Tarrow (_, ty, _, _) -> Ctype.repr ty + | _ -> assert false + in + let ty = Ctype.expand_head e.exp_env ty in + let prim = + match ty.desc with + | Tlink _ -> assert false + | Tvar -> fatal_error "(+)'s type is not instantiated" + | Tconstr (p, [], _) when Predef.path_int = p -> + (* copied from primitive.ml *) + { Primitive.prim_name = "%addint"; + prim_arity = 2; + prim_alloc = true; + prim_native_name = ""; + prim_native_float = false } + | Tconstr (p, [], _) when Predef.path_float = p -> + { Primitive.prim_name = "%addfloat"; + prim_arity = 2; + prim_alloc = true; + prim_native_name = ""; + prim_native_float = false } + | _ -> + (* This cannot happen since we have already checked the + instantiation at Typecore.Weak_variable.check () *) + Format.eprintf "ERROR AT %a (type=%a)@." + Location.print_error e.exp_loc + Printtyp.type_expr ty; + fatal_error "(+)'s type must be int or float" + in + transl_primitive prim | Texp_ident _ -> fatal_error "Translcore.transl_exp: bad Texp_ident" | Texp_constant cst -> Lconst(Const_base cst)
ここでは、Texp_super_plus の型、e.exp_type を分解して、'__a -> '__a -> '__a 中の型変数 '__a が一体どんな型に unify されたのかを調べています。 Ctype.repr は unification で作られた Tlink を辿っていく為の関数。 型が引数のないデータ型 Tconstr (p, [], _) である事がわかったら、パス p が int か、float であるかを調べ、対応する演算プリミティブを選び、Lambda.lambda を構成します。型推論段階の Weak_variable.check () の部分で、Texp_super_plus の型は必ず int -> int -> int か float -> float -> float の形になっているのは保証されています。他のケースに行き当たったばあい、何か改造に問題があることになります。
さて、あとは幾つか周辺ツールの Texp_super_plus のケースを拡張していくだけですが、全部簡単にできます。
ここまで来ると、make core したら、トップディレクトリに ./ocamlc コンパイラが出来ます!! そして、今度は、今迄のコンパイラ boot/ocamlc ではなく、その新しいコンパイラ ./ocamlc を使って標準ライブラリをコンパイルしていきます…が:
$ make core
...
cd stdlib; make all
make[1]: Entering directory `/home/jun/new-share/ocaml/stdlib'
../boot/ocamlrun ../ocamlc -g -warn-error A -nostdlib `./Compflags pervasives.cmi` -c pervasives.mli
../boot/ocamlrun ../ocamlc -g -warn-error A -nostdlib `./Compflags pervasives.cmo` -c pervasives.ml
File "pervasives.ml", line 141, characters 25-27:
Error: This expression has type int but an expression was expected of type 'a
The type constructor int would escape its scope
make[1]: *** [pervasives.cmo] Error 2
make[1]: Leaving directory `/home/jun/new-share/ocaml/stdlib'
make: *** [library] Error 2
$ あれ、失敗です。なんだか、 int が scope を逃げるような使いかたをしたと言われてしまいました。これは、型 int が、Texp_super_plus の型変数 '__a と unify されたときに出るエラーです。定義された型が、定義が見える所から勝手に抜け出してしまわないように、データ型は自分より低い let レベルを持つ型変数と unification されるとエラーになるようになっています。'__a は最低のレベル Btype.lowest_level を持っているので、int のレベルよりも低いのです。
ラクダくんのちょっといい話
改造していない普通の OCaml でもたまーにこういうエラーに出会えるかもしれません。例えば、
let r = ref None module M = struct type t = Foo let _ = r := Some Foo endこれをコンパイルすると、 t が scope から逃げてるからキモイよー、と言われるよ。r を定義した時点では M.t なんてデータ型存在しなかったのに、後で、その型が M.t だと判明するからですね。
別の言い方をすれば、もし escape 云々でエラーにならなかった場合、上のプログラムをベタベタ型を付けて書くと、
let r : M.t option ref = ref None module M = struct type t = Foo let _ : unit = r := Some Foo endになります。あれ、r の型 M.t は r の定義の時点では未定義だ、、、なんか悪いことが起こりそうですよね？
Type level の hack
これを回避するにはデータ型と Btype.lowest_level のレベルを持つ型変数との unification を特別扱いして、エラーにならないようにする必要があります。次のパッチがそれです:
--- a/typing/ctype.ml Wed Jun 17 13:12:31 2009 +0900 +++ b/typing/ctype.ml Mon Aug 31 03:55:04 2009 +0900 @@ -97,9 +97,11 @@ (**** Type level management ****) -let current_level = ref 0 -let nongen_level = ref 0 -let global_level = ref 1 +(* Btype.lowest_level (=0) now has a special meaning as weak variables + and therefore the initial level must not be lowest_level. *) +let current_level = ref 1 +let nongen_level = ref 1 (* init: equal to current_level *) +let global_level = ref 2 (* init: current_level + 1 *) let saved_level = ref [] let init_def level = current_level := level; nongen_level := level @@ -607,7 +609,11 @@ let ty = repr ty in if ty.level > level then begin begin match ty.desc with - Tconstr(p, tl, abbrev) when level < Path.binding_time p -> + | Tconstr(p, tl, abbrev) when level = Btype.lowest_level -> + (* We avoid lower the level of Tconstr type to lowest, + since it causes the "escape the scope" error. *) + () + | Tconstr(p, tl, abbrev) when level < Path.binding_time p -> (* Try first to replace an abbreviation by its expansion. *) begin try link_type ty (!forward_try_expand_once env ty);
まず、let レベルの初期値、current_level を Btype.lowest_level より高い 1 にします。こうすることで、俺(+) 以外に level が Btype.lowest_level の型変数 '__a を持つ可能性をなくします。次に、この '__a 変数とのデータ型との unification では、データ型のレベルを Btype.lowest_level に下げることで scope のエラーになるのを防ぐ為のコードを update_level 関数に入れています。本来ならこんなことはしてはいけないのですが、'__a 変数は必ず int か float に Weak_variable.check () によって unify され、型変数としては残り得ないため、安全なのです。
