CamlP4 で遊んでみた

OCaml

今まで何となく手を付けていなかった CamlP4 で OCaml の文法を拡張してみました。
実はそんなに難しくない CamlP4 による文法拡張:

  • コンパイル方法、使用方法はほぼお約束。
  • Make functor 周りもお約束。
  • 既存のパースルールを DELETE_RULE で剥ぎ取り、
  • EXTEND で新しいルールを付け加える。
  • 付け加える場所はラベルで指定できる。
  • 既存文法は Camlp4OCamlParser.ml に書いてあるからそれを見て剥がしたり加えたり。

でもやっぱり嫌になる CamlP4 による文法拡張:

  • stream base の parser なので yacc とはチョト違う癖がある。
  • Camlp4OCamlParser.ml は Camlp4OCamlRevisedParser.ml の差分として実装されている。なのでいちいち両方のファイルを参照せねばならない。
  • Camlp4OCamlRevisedParser.ml が定義する文法は CamlP4 の誰も使わないことで悪名高い revised syntax を定義している。そこに差分を当てて通常の OCaml 文法を定義しているので意味も無く面倒。
  • Camlp4OCamlParser.ml 自体が revised syntax で書かれている。Revised syntax を理解する手間が無駄。
  • ドキュメントが何時までたっても整備されない。

CamlP4 はとても良いアイデアだとは思いますが、この revised syntax のせいで P4 ユーザー一人ひとりの時間が無駄になっていることを考えるとやはり失敗だと言わざるを得ません。少なくとも、さっさと実装から revised syntax を追放するべきです。

(* 
   pa_hoge.ml
   to compile: ocamlc -annot -I +camlp4 dynlink.cma camlp4lib.cma -pp camlp4of.opt pa_hoge.ml  
   to play: ocaml dynlink.cma camlp4o.cma pa_hoge.cmo

   x${y} == Hashtbl.find x y
   x${y} <- z == Hashtbl.replace x y z
*)
module Id = struct
  let name = "pa_hoge"
  let version = "1.0"
end

open Camlp4

module Make (Syntax : Sig.Camlp4Syntax) = struct
  open Sig
  include Syntax

  let bigarray_hashtbl_set _loc var newval =
    match var with
    | <:expr< Bigarray.Array1.get $arr$ $c1$ >> ->
        Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >>
    | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> ->
        Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >>
    | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> ->
        Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >>
    | <:expr< Bigarray.Genarray.get $arr$ [| $coords$ |] >> ->
        Some <:expr< Bigarray.Genarray.set $arr$ [| $coords$ |] $newval$ >>
    | <:expr< Hashtbl.find $e1$ $e2$ >> ->
        Some <:expr< Hashtbl.replace $e1$ $e2$ $newval$ >>
    | _ -> None
  ;;

  DELETE_RULE Gram expr: SELF; "<-"; expr LEVEL "top" END;

  EXTEND Gram  
    GLOBAL: expr
  ;

  expr: LEVEL "simple"
    [ 
      [ e1 = SELF; "$"; "{"; e2 = SELF; "}" 
	-> <:expr<Hashtbl.find $e1$ $e2$>> 
      ]
    ];
  expr: LEVEL ":="
    [
      [ e1 = SELF; "<-"; e2 = expr LEVEL "top" ->
        match bigarray_hashtbl_set _loc e1 e2 with
        | Some e -> e
        | None -> <:expr< $e1$ := $e2$ >> 
      ]
    ];
  END  
end

let module M = Register.OCamlSyntaxExtension(Id)(Make) in ()