open recursionなモジュールに型定義を持たせる（中）

今回は今まで散々参考にしてきたこの記事の内容に近い形でopen recursionを実装してみる：

blag.bcc32.com

題材もまったく同一なのでパクリと言われても仕方ない・・・

前回までの記事の内容を踏まえて少し整理したり、スタイルをいじったりしてあるくらい。もう一歩進めた（より継承チックな）実装も出来たが長くなるので次の記事に持ち越し。

まずはコード全体：

module type GT = sig
  type t
  type ctor

  val create : ctor -> t
  val addressee : t -> string
  val greet : t -> string
end

module GreetF(Self : GT)
  : GT with type t = Self.t and type ctor = Self.ctor
  = struct
    include Self
    let addressee _t = "world"
    let greet t = "Hello " ^ Self.addressee t
  end

module rec Greet
  : GT with type t = unit and type ctor = unit
  = GreetF(struct
    include Greet
    let create () = ()
  end)

module NamedF(Self : GT)
  : GT with type t = Self.t and type ctor = Self.ctor
  = struct
    include GreetF(Self)
    let addressee = Self.addressee
  end

type named = { name : string }

module rec Named
  : GT with type t = named and type ctor = string
  = NamedF(struct
    include Named
    let create name = { name=name }
    let addressee named = named.name
  end)

個別に詳細をみていく。

シグニチャ

module type GT = sig
  type t
  type ctor

  val create : ctor -> t
  val addressee : t -> string
  val greet : t -> string
end

今回のコードはOCamlのモジュールらしく、モジュールの中心となるイミュータブルなデータt型、そのt型のコンストラクタとt型に対して使える関数群を定義するようになる。

そこがシグニチャにもしっかり表れている。createで何らかのctor型の引数からt型のデータを作り、addresseeやgreetという関数をそのデータに適用して文字列を得る。

ベースクラス

まずはファンクタ：

module GreetF(Self : GT)
  : GT with type t = Self.t and type ctor = Self.ctor
  = struct
    include Self
    let addressee _t = "world"
    let greet t = "Hello " ^ Self.addressee t
  end

これは前回の記事のファンクタとかなり近い。Selfというモジュールを引数にGT型のモジュール（ただしtやctorが何の型か外部に見えるようにしてある）を返す。

モジュール内の定義に関しては、type t、type ctor、let createなどといろいろSelfの中身が多かったのでいちいちtype t = Self.tなどとせず、include Selfで一括でコピーしている。addresseeやgreetは外部では定義されないのでファンクタ内でちゃんと定義する。

次に再帰モジュール：

module rec Greet
  : GT with type t = unit and type ctor = unit
  = GreetF(struct
    include Greet
    let create () = ()
  end)

前回と同じく、tとctorの指定はGreetのシグニチャ部分だけで十分でモジュール本体では必要ない（再帰モジュールのおかげでinclude Greetで入ってくる。なんか不思議な気もするが・・・）

前回はmodule rec Greet : ... = GreetF(Greet)という形で完結していたが、今回はcreate関数を定義する必要があるのでGreetF(struct include Greet let create () = () endと無名モジュールを作ってその中でincludeとcreate定義をしている。

これで

utop # let g = Greet.create ();;
val g : unit = ()

utop # Greet.greet g;;
- : string = "Hello world"

のようにできる。

子クラス

流石にこれではつまらないので、せめてt型に固有の名前を持たせてgreetで"Hello <名前>"と返すようにしたい、のでファンクタNamedFと再帰モジュールNamedを作ってみる。

ファンクタ：

module NamedF(Self : GT)
  : GT with type t = Self.t and type ctor = Self.ctor
  = struct
    include GreetF(Self)
    let addressee = Self.addressee
  end

モジュール内の2行で

• GreetFからの継承
• addressee関数だけoverride

ということを指定している。addresseeの中身は外部から注入する。（ここは元ネタの記事準拠だが、個人的には少し不満があるところでaddresseeの実装がファンクタにないとNamedFを継承できなくなってしまう。次回の記事ではこのポイントを修正する）

type named = { name : string }

Named.tとして一つの文字列型フィールドnameを持つレコードを定義。（元記事だとここにsuperというフィールドも付いていたのだが、このフィールドまったく使われていなかった上に原理的に使えなさそうだったので今回は省略。次回はこの点についても探っていく）

再帰モジュール：

module rec Named
  : GT with type t = named and type ctor = string
  = NamedF(struct
    include Named
    let create name = { name=name }
    let addressee named = named.name
  end)

t型はnamedレコード、ctorは文字列型とシグニチャで定義、createとaddresseeを（tがnamedレコード型であるという情報を使って）定義している。

前述の通りNamedFからはt型の形が見えないのでaddresseeの定義の中でフィールドアクセスが使えないのでNamedで定義してNamedFに注入する形になっている。

使ってみる

utop # let g = Greet.create ();;
val g : unit = ()

utop # Greet.greet g;;
- : string = "Hello world"

utop # let n = Named.create "Bob";;
val n : named = {name = "Bob"}

utop # Named.greet n;;
- : string = "Hello Bob"

成功。

次回

今回のコードの問題点２つはどちらも「ベースクラスのt型の情報が子クラスから使えなさそう」ということに繋がる。

次回はその解決法を探るため、「ベースクラスでは挨拶の文字列、子クラスではそれに追加で相手の名前がt型に格納されている」というようなコードを書いてみる。