CamlP4 が何やっているか知りたいときどうするか
一番よいのは CamlP4 が何を出力しているか見ることです。
例として OCamltter の Twitter API の JSON 表現と OCaml の型との間を取り持つ api11.ml がどうなっているか見てみましょう。
type 'a t = { previous_cursor : Json.t; next_cursor : Json.t; next_cursor_str : string; previous_cursor_str : string; contents : 'a mc_embeded; } with conv(json, ocaml)
この型宣言の with conv(json, ocaml) の部分は CamlP4 の拡張の部分で、型定義からなにかしらコードを生成しています。
$ rm lib/twitter/api11.cmo $ omake --verbose lib/twitter/api11.cmo
まず実際に走るコンパイルコマンドを得るために該当オブジェクトを消去し、ビルドしなおします。 OCamltter は omake でビルドするので、 omake でコンパイルコマンドを表示させるために -verbose つけています。
... ocamlfind ocamlc -annot -bin-annot -for-pack Twitter -package cryptokit,str,spotlib,tiny_json_conv,ocaml_conv,curl -thread -w A-4-9 -warn-error +1..39-4-9 -g -syntax camlp4o -package meta_conv.syntax -I ../base -I . -c api11.ml
こんなん出ました。 -syntax camlp4o とか書いてあるので P4 が動いていますね。でもこれはまだ実際走るコマンドが ocamlfind でラップされていてわかりません。そこで ocamlc に -verbose つけてこのコマンドを手動で走らせます：
$ cd lib/twitter # まずソースのあるところに移動 $ ocamlfind ocamlc -verbose -annot -bin-annot -for-pack Twitter -package cryptokit,str,spotlib,tiny_json_conv,ocaml_conv,curl -thread -w A-4-9 -warn-error +1..39-4-9 -g -syntax camlp4o -package meta_conv.syntax -I ../base -I . -c api11.ml # 以下、 + から実際に走るコマンド + ocamlc.opt -verbose -annot -bin-annot -for-pack Twitter -w A-4-9 -warn-error +1..39-4-9 -g -I ../base -I . -c -thread -I /home/aaa/.opam/system/lib/num -I /home/aaa/.opam/system/lib/cryptokit -I /home/aaa/.opam/system/lib/oUnit -I /home/aaa/.opam/system/lib/pa_ounit -I /home/aaa/.opam/system/lib/spotlib -I /home/aaa/.opam/system/lib/tiny_json -I /home/aaa/.opam/system/lib/tiny_json_conv -I /home/jun/.share/prefix/lib/ocaml/compiler-libs -I /home/aaa/.opam/system/lib/ocaml_conv -I /home/aaa/.opam/system/lib/curl -I /prefix/lib/ocaml/camlp4 -I /home/aaa/.opam/system/lib/type_conv -I /home/aaa/.opam/system/lib/meta_conv -pp "camlp4 '-I' '/prefix/lib/ocaml/camlp4' '-I' '/home/aaa/.opam/system/lib/type_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-parser' 'o' '-parser' 'op' '-printer' 'p' 'pa_type_conv.cma' 'meta_conv.cmo' 'pa_meta_conv.cma' " api11.ml + camlp4 '-I' '/prefix/lib/ocaml/camlp4' '-I' '/home/aaa/.opam/system/lib/type_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-parser' 'o' '-parser' 'op' '-printer' 'p' 'pa_type_conv.cma' 'meta_conv.cmo' 'pa_meta_conv.cma' 'api11.ml' > /tmp/ocamlpp5fe07e
長いですねー。ocamlfind はこんなすごいことをしてくれているんですね。一つ目では ocamlc.opt が動いていて、そこから camlp4 を呼び出しているのが二つ目です。この二つ目のコマンドが実際に p4 の展開を行っているところです。このコマンドを実行すれば目的の p4 の出力が得られます、がひとつだけ注意することがあります
-printer p はバイナリ形式なので人間には読めない
なので -printer o にして、ついでに出力先も api11.out.ml というのにします:
$ camlp4 '-I' '/prefix/lib/ocaml/camlp4' '-I' '/home/aaa/.opam/system/lib/type_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-I' '/home/aaa/.opam/system/lib/meta_conv' '-parser' 'o' '-parser' 'op' '-printer' 'o' 'pa_type_conv.cma' 'meta_conv.cmo' 'pa_meta_conv.cma' 'api11.ml' > api11.out.ml
api11.out.ml を見れば展開後の OCaml ソースコードが手に入ります:
type 'a t = { previous_cursor : Json.t; next_cursor : Json.t; next_cursor_str : string; previous_cursor_str : string; contents : 'a mc_embeded } let _ = fun (_ : 'a t) -> () let json_of_t : type tyvar__a. (tyvar__a -> Json.t) -> tyvar__a t -> Json.t = fun __tv_a __v -> Json_conv.Constr.record "t" (List.flatten [ [ ("previous_cursor", ((fun x -> x) __v.previous_cursor)) ]; [ ("next_cursor", ((fun x -> x) __v.next_cursor)) ]; [ ("next_cursor_str", (json_of_string __v.next_cursor_str)) ]; [ ("previous_cursor_str", (json_of_string __v.previous_cursor_str)) ]; Json_conv.DeconstrDecoder.record_exn "t" ~trace: [ `Field "contents"; `Field "t" ] (__tv_a __v.contents) ]) let _ = json_of_t let t_of_json : type tyvar__a. (tyvar__a, Json.t) Meta_conv.Types.Decoder.t -> (tyvar__a t, Json.t) Meta_conv.Types.Decoder.t = fun __tv_a ?trace:(__t = []) __v -> let __name = "t" in let primary_labels = [ "previous_cursor"; "next_cursor"; "next_cursor_str"; "previous_cursor_str" ] in match Json_conv.DeconstrDecoder.record __name ~trace: __t __v with | `Error e -> `Error e | `Ok fields -> let (primary_fields, secondary_fields) = Meta_conv.Internal.filter_fields primary_labels fields in (try let previous_cursor = Meta_conv.Internal.field_assoc_exn __name "previous_cursor" primary_fields Json_conv.throw (Json_conv.exn (fun ?trace:(__t) x -> `Ok x)) ?trace: (Some __t) __v and next_cursor = Meta_conv.Internal.field_assoc_exn __name "next_cursor" primary_fields Json_conv.throw (Json_conv.exn (fun ?trace:(__t) x -> `Ok x)) ?trace: (Some __t) __v and next_cursor_str = Meta_conv.Internal.field_assoc_exn __name "next_cursor_str" primary_fields Json_conv.throw (Json_conv.exn string_of_json) ?trace: (Some __t) __v and previous_cursor_str = Meta_conv.Internal.field_assoc_exn __name "previous_cursor_str" primary_fields Json_conv.throw (Json_conv.exn string_of_json) ?trace: (Some __t) __v in let (contents, secondary_fields) = let v = Json_conv.Constr.record "_dummy_type_name_" secondary_fields in match Meta_conv.Internal.embeded_decoding_helper secondary_fields v (__tv_a ~trace: ((`Field "contents") :: __t) v) with | `Ok v -> v | `Error e -> Json_conv.throw e in let res = { previous_cursor = previous_cursor; next_cursor = next_cursor; next_cursor_str = next_cursor_str; previous_cursor_str = previous_cursor_str; contents = contents; } in if secondary_fields <> [] then `Error ((Meta_conv.Error.Unknown_fields (__name, (List.map fst secondary_fields), (Obj.repr res))), __v, __t) else `Ok res with | Json_conv.Error e -> `Error e) let _ = t_of_json let t_of_json_exn : type tyvar__a. (tyvar__a, Json.t) Meta_conv.Types.Decoder.t -> (tyvar__a t, Json.t) Meta_conv.Types.Decoder.t_exn = fun __tv_a ?(trace = []) v -> match t_of_json __tv_a ~trace v with | `Ok v -> v | `Error e -> raise (Json_conv.Error e) let _ = t_of_json_exn let ocaml_of_t : type tyvar__a. (tyvar__a -> Ocaml.t) -> tyvar__a t -> Ocaml.t = fun __tv_a __v -> Ocaml_conv.Constr.record "t" (List.flatten [ [ ("previous_cursor", (Json.ocaml_of_t __v.previous_cursor)) ]; [ ("next_cursor", (Json.ocaml_of_t __v.next_cursor)) ]; [ ("next_cursor_str", (ocaml_of_string __v.next_cursor_str)) ]; [ ("previous_cursor_str", (ocaml_of_string __v.previous_cursor_str)) ]; Ocaml_conv.DeconstrDecoder.record_exn "t" ~trace: [ `Field "contents"; `Field "t" ] (__tv_a __v.contents) ]) let _ = ocaml_of_t let t_of_ocaml : type tyvar__a. (tyvar__a, Ocaml.t) Meta_conv.Types.Decoder.t -> (tyvar__a t, Ocaml.t) Meta_conv.Types.Decoder.t = fun __tv_a ?trace:(__t = []) __v -> let __name = "t" in let primary_labels = [ "previous_cursor"; "next_cursor"; "next_cursor_str"; "previous_cursor_str" ] in match Ocaml_conv.DeconstrDecoder.record __name ~trace: __t __v with | `Error e -> `Error e | `Ok fields -> let (primary_fields, secondary_fields) = Meta_conv.Internal.filter_fields primary_labels fields in (try let previous_cursor = Meta_conv.Internal.field_assoc_exn __name "previous_cursor" primary_fields Ocaml_conv.throw (Ocaml_conv.exn Json.t_of_ocaml) ?trace: (Some __t) __v and next_cursor = Meta_conv.Internal.field_assoc_exn __name "next_cursor" primary_fields Ocaml_conv.throw (Ocaml_conv.exn Json.t_of_ocaml) ?trace: (Some __t) __v and next_cursor_str = Meta_conv.Internal.field_assoc_exn __name "next_cursor_str" primary_fields Ocaml_conv.throw (Ocaml_conv.exn string_of_ocaml) ?trace: (Some __t) __v and previous_cursor_str = Meta_conv.Internal.field_assoc_exn __name "previous_cursor_str" primary_fields Ocaml_conv.throw (Ocaml_conv.exn string_of_ocaml) ?trace: (Some __t) __v in let (contents, secondary_fields) = let v = Ocaml_conv.Constr.record "_dummy_type_name_" secondary_fields in match Meta_conv.Internal.embeded_decoding_helper secondary_fields v (__tv_a ~trace: ((`Field "contents") :: __t) v) with | `Ok v -> v | `Error e -> Ocaml_conv.throw e in let res = { previous_cursor = previous_cursor; next_cursor = next_cursor; next_cursor_str = next_cursor_str; previous_cursor_str = previous_cursor_str; contents = contents; } in if secondary_fields <> [] then `Error ((Meta_conv.Error.Unknown_fields (__name, (List.map fst secondary_fields), (Obj.repr res))), __v, __t) else `Ok res with | Ocaml_conv.Error e -> `Error e) let _ = t_of_ocaml let t_of_ocaml_exn : type tyvar__a. (tyvar__a, Ocaml.t) Meta_conv.Types.Decoder.t -> (tyvar__a t, Ocaml.t) Meta_conv.Types.Decoder.t_exn = fun __tv_a ?(trace = []) v -> match t_of_ocaml __tv_a ~trace v with | `Ok v -> v | `Error e -> raise (Ocaml_conv.Error e) let _ = t_of_ocaml_exn
はい、こんだけ自動生成されているんですね。
今回は .ml の展開を行いましたが .mli の展開も .cmo ではなく .cmi を作ることにすれば同じようにできます。
OCaml コンパイラソース内の ocaml/tools/read_cmt コマンドを使って api11.cmt を作ったうえで、 read_cmt -o api11.out.ml api11.cmt でもいいのですが、 4.00.1 のものはインデント腐ってますし括弧も無駄にあるので正直使えません。P4 はその辺はちゃんとしていて偉大ですねえ。 read_cmt も 4.01.0 では修正されているといいですねえ
