module type of

3.12.0出ましたね！MacPortsになかなか来ないので、ローカルでビルドして移行中です。
さて今回新機能目白押しです。その中でも個人的に一番ありがたいのがmodule type ofです。面倒くさいsig宣言のコピー&ペーストをかなり削減できます。
頻繁に弄ってる最中ですと、2箇所直さないといけないのが1箇所で済むようになるのは本当に嬉しいです。やったー。

で、ままならないのがファンクタ。

module type P = sig type t end
module type T = sig ...MANY-DECLARATIONS... end
module F (A: P) = struct ...MANY-DECLARATIONS... end

今まで...MANY-DECLARATIONS...の部分を2回書いていたのを、↓のように直したいわけです。

module type P = sig type t end
module F (A: P) = struct ...MANY-DECLARATIONS... end
module type T = module type of F(???)

どうすればスマートかなあ、とあれこれやってみた話。
ここで、???に既存のモジュールDummyを充てがってしまうと、A.tがDummy.tに固定されて元と同じにならず。

module type P = sig type t end
module F (A: P) = struct type t = A.t end (* 例ですので以降tだけ *)
module Dummy = struct type t end
module type T = module type of F(Dummy)

↑をocamlc -iすると↓になってしまいます。

% ocamlc -i test.ml
module type P = sig type t end
module F : functor (A : P) -> sig type t = A.t end
module Dummy : sig type t end
module type T = sig type t = Dummy.t end (* ここからDummy.tを消したい *)

そこで、これまた新機能のdestructive substitutionを試してみる。

module type P = sig type t end
module F (A: P) = struct type t = A.t end
module Dummy = struct type t end
module type T = sig
  type t
  include module type of F(Dummy) with type t := t
end

……撃沈しました。

% ocamlc -i test.ml
File "test.ml", line 6, characters 10-49:
Error: In this `with' constraint, the new definition of t
       does not match its original definition in the constrained signature:
       Type declarations do not match:
         type t = t
       is not included in
         type t = Dummy.t

色々試した部分を省くと、引数モジュールをインラインで与えればOKでした。tを抽象型にすることで他の型に縛られないシグネチャが得られます。

module type P = sig type t end
module F (A: P) = struct type t = A.t end
module type T = module type of F(struct type t end)

% ocamlc -i test.ml
module type P = sig type t end
module F : functor (A : P) -> sig type t = A.t end
module type T = sig type t end

実際には引数型Pもtype tだけということはなく、関数や値があったりするわけです。
ダミーの引数モジュールの方は、型さえ満足させればいいので、楽勝……？

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module type T = module type of F(struct
  type t
  let compare _ _ = 0 (* 楽勝 *)
  let create _ = ... (* どうしよう…… *)
  let empty = ... (* 同上 *)
end)

tの値を作らない限りはいいのですが、tを返す関数を書こうとして詰まりました。ここでtに具体的な型を与えるわけにはいきません。
大丈夫、こういう時のためのObj.magic！実行されてしまうとクラッシュしますが、実際には呼ばれないから関係なし！(またかよ……)

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module type T = module type of F(struct
  type t
  let compare _ _ = 0
  let create _ = Obj.magic 0
  let empty = Obj.magic 0
end)

% ocamlc -i test.ml
module type P =
  sig
    type t
    val compare : t -> t -> int
    val create : unit -> t
    val empty : t
  end
module F : functor (A : P) -> sig type t = A.t end
module type T = sig type t end

でもやはり不安なので、もう一捻りして、ダミー関数が実際に呼ばれないことをリンカに保証させましょう。

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module type T = module type of F(struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ" (* これはひどい *)
  type t
  let compare _ _ = 0
  let create _ = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end)

% ocamlopt test.ml # ちゃんとリンクされます

module type ofの中で何を宣言しても、機械語には落ちない。こういう所がしっかりしてて素敵です。
実はダミーの引数も不要です。'aって便利。もちろんObj.magicのままでも同じです。

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module type T = module type of F(struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  type t
  let compare = ultrasuperdeluxmagic ()
  let create = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end)

さて、実際にはPの方も結構ボリュームがあったりして、Fの内容をコピー&ペーストするよりも、ダミーを作るほうが苦痛だったりします。
特にFのようなファンクタが複数あったりすると……。

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module type FT = module type of F(struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  type t
  let compare = ultrasuperdeluxmagic ()
  let create = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end)
module G (A: P) = struct type t = A.t end
module type GT = module type of F(struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  type t
  let compare = ultrasuperdeluxmagic ()
  let create = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end)
module H (A: P) = struct type t = A.t end
module type HT = module type of F(struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  type t
  let compare = ultrasuperdeluxmagic ()
  let create = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end)

幸いにも'aのおかげでcompareやcreateのダミー実装は型tに縛られてません。ここだけでもincludeできないでしょうか。

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module Dummy = struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  let compare = ultrasuperdeluxmagic ()
  let create = ultrasuperdeluxmagic ()
  let empty = ultrasuperdeluxmagic ()
end;;
module type FT = module type of F(struct
  type t
  include Dummy
end)
module G (A: P) = struct type t = A.t end
module type GT = module type of F(struct
  type t
  include Dummy
end)
module H (A: P) = struct type t = A.t end
module type HT = module type of F(struct
  type t
  include Dummy
end)

% ocamlopt test.ml
Undefined symbols:
  "_$e3$81$aa$e3$81$84$e3$82$88", referenced from:
      _camlTest__6 in test.o
      _$e3$81$aa$e3$81$84$e3$82$88$non_lazy_ptr in test.o
ld: symbol(s) not found
collect2: ld returned 1 exit status
File "caml_startup", line 1, characters 0-1:
Error: Error during linking

ultrasuperdeluxmagicも、module type ofの外に出してしまうとこの様。当初の意図通りリンカによるチェックが機能してるとも言いますが。
それでもObj.magicなら、Obj.magicならなんとかしてくれる……！！

……結果だけ書きますと……いまいち挙動をよくわかってないのですが、Obj.magic 0版は、動くことは動くのですが、対話環境にロードしたときとかなんか怪しかったです。
まあ、もしObj.magic 0の代わりにassert falseを使うとして考えてみればわからないこともないです……。

module Dummy = struct
  let compare _ _ = assert false
  let create _ = assert false
  let empty = assert false
end;;

emptyのところでassert falseが実行されてしまってますよね、これ！実行されないことが前提の'aなのに！
assert falseやultrasuperdeluxmagicで発生するエラーをObj.magicは抑え込みますが、それで怪しいのもまあしょうがない。

というわけでどうするか……Dummyの初期化のための実行を回避できればいいので、Dummyもファンクタにすれば……。
怪しい動作を回避するのが目的ですので、一応安全のためultrasuperdeluxmagicを使います。

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module Dummy (A: sig end) = struct
  external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  let compare = assert false
  let create = assert false
  let empty = assert false
end;;
module type FT = module type of F(struct
  type t
  include Dummy (struct end)
end)
module G (A: P) = struct type t = A.t end
module type GT = module type of F(struct
  type t
  include Dummy (struct end)
end)
module H (A: P) = struct type t = A.t end
module type HT = module type of F(struct
  type t
  include Dummy (struct end)
end)

% ocamlopt test.ml 
Undefined symbols:
  "_$e3$81$aa$e3$81$84$e3$82$88", referenced from:
      _camlTest__10 in test.o
ld: symbol(s) not found
collect2: ld returned 1 exit status
File "caml_startup", line 1, characters 0-1:
Error: Error during linking

ああ……ファンクタといってもコードは生成されてしまうのですね……。module type ofの外ですから仕方ないですが……。やはりultrasuperdeluxmagicはmodule type ofの中で定義しないといけません。
というわけでこれが最終コードだ！

module type P = sig
  type t
  val compare: t -> t -> int
  val create: unit -> t
  val empty: t
end
module F (A: P) = struct type t = A.t end
module Dummy (A: sig val ultrasuperdeluxmagic: unit -> 'a end) = struct
  let compare = A.ultrasuperdeluxmagic ()
  let create = A.ultrasuperdeluxmagic ()
  let empty = A.ultrasuperdeluxmagic ()
end;;
module type FT = module type of F(struct
  type t
  include Dummy (struct
    external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  end)
end)
module G (A: P) = struct type t = A.t end
module type GT = module type of F(struct
  type t
  include Dummy (struct
    external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  end)
end)
module H (A: P) = struct type t = A.t end
module type HT = module type of F(struct
  type t
  include Dummy (struct
    external ultrasuperdeluxmagic: unit -> 'a = "ないよ"
  end)
end)

% ocamlopt test.ml # ちゃんとリンクされます