Trees that Grow in OCaml

要約

抽象構文木のような再帰的データ構造に対して、再帰的に各ノードに付加情報を付けられるようにする、Tree decoration問題というのがある。Haskellでは開いた型族（open type family）を使ってこの問題を解決しており、TypeScriptではインタフェースを型パラメータに渡すことで解決できる（入れ子構造を自由に拡張する – TypeScript版「Trees that Grow」を参照）。OCamlでは多相バリアントとオブジェクト型を使うと、より拡張性を高めた形でこの問題を解決することができる。

問題設定

次のような、整数リテラル、変数参照、代入、関数式、関数呼び出しのある言語を考える。

type expr =
  | Literal of int
  | Variable of string
  | SetVariable of string * expr
  | Func of string * expr
  | CallFunc of expr * expr

これらの Literal, Variable, SetVariable, Func, CallFuncに対して、必要に応じて、後から別々の付加情報を付けられるようにしたい。 expr の定義は再帰的になっているため、そのあたりがちょっと面倒そうだ。

方法

TypeScript版ではノードの種類と付加情報の対応関係をインタフェースで与え、交差型で付加情報をノードオブジェクトに追加する。Haskell版では代数データ型に付加情報用のフィールドを追加し、ノードの種類と付加情報の対応付けは型族で決定している。

OCaml版はこのふたつの間の子のような形で、付加情報はバリアントのフィールドとして持ち、ノードの種類と付加情報の対応付けはオブジェクト型で与えることにする¹。オブジェクト型の分解にはconstraintが使えるので下のような感じになる。

type 'a expr =
  | Literal of int * 'lit
  | Variable of string * 'var
  | SetVariable of string * 'a expr * 'sv
  | Func of string * 'a expr * 'func
  | CallFunc of 'a expr * 'a expr * 'call_func
  constraint 'a =
    < literal : 'lit
    ; variable : 'var
    ; set_variable : 'sv
    ; func : 'func
    ; call_func : 'call_func
    >

普通に書けてしまった。

次のように使う。

type no_info =
  < literal : unit
  ; variable : unit
  ; set_variable : unit
  ; func : unit
  ; call_func : unit
  >

type expr_no_info = no_info expr

多相バリアント版

これだけだと面白くないので、付加情報だけでなく、バリアントタグ方向にも拡張性を持たせることにしてみる。例のごとく多相バリアントをつかう。

まず整数リテラルに対応するノードを定義する。

type 'a literal = [`Literal of int * 'lit]
  constraint 'a = <literal : 'lit; ..>

付加情報は先程と同様に多相バリアントのフィールドとして持つ。ここでは 'lit がそれだ。付加情報も先程と同様に型パラメータ経由で渡し、constraint で分解する。オブジェクト型には .. をつけておき、 literal 以外のフィールドも含められるようにしておく。

あとは、他のノードも同様に定義する。

type 'a variable = [`Variable of string * 'var]
  constraint 'a = <variable : 'var; ..>

type 'a set_variable = [`SetVariable of string * 'expr * 'sv]
  constraint 'a = <expression : 'expr; set_variable : 'sv; ..>

type 'a func = [`Func of string * 'expr * 'func]
  constraint 'a = <expression : 'expr; func : 'func; ..>

type 'a call_func = [`CallFunc of 'expr * 'expr * 'call_func]
  constraint 'a = <expression : 'expr; call_func : 'call_func; ..>

TypeScript版ではノード型の合併型としてExpression型を定義し、それを経由して型に再帰構造を持ち込んでいるが、ここではそれも型パラメータの expression : 'expr フィールド経由で与えるようにしている。

使い方

実際に上記の型を組み合わせて構文木の定義をつくってみる。

module Full = struct
  type ext =
    < literal : unit
    ; variable : unit
    ; set_variable : unit
    ; func : unit
    ; call_func : unit
    ; expression : t
    >
  and 'a t_ = ['a literal | 'a variable | 'a set_variable | 'a func | 'a call_func]
  and t = ext t_
end

ext 型で付加情報の型を指定する。今回は付加情報の中身には興味がないので、すべて unit にしている。 t_ で取り得るノードの種類を列挙し、さきほど定義したノード型たちに型パラメータを渡していく。 t_ に ext を渡したものを t として再帰を閉じてやれば定義は完成だ。

今回は多相バリアントを使い、個々のノード定義では他のノードを参照せず、さらに型パラメータの制約ではオブジェクト型に .. を使っておいたので、ノードの種類を増減させるのも簡単だ。例えば下記のように t_ の定義を変更するだけで関数式と関数呼び出しがない言語の構文木を定義することができる（説明のわかりやすさのためextの定義は変更しなかったが、funcとcall_funcのフィールドは削除してよい）。

module NoFunc = struct
  type ext =
    < literal : unit
    ; variable : unit
    ; set_variable : unit
    ; func : unit
    ; call_func : unit
    ; expression : t
    >
  and 'a t_ = ['a literal | 'a variable | 'a set_variable ]
  and t = ext t_
end

1. ちなみにここでオブジェクト型の代わりにレコード型を使うことはできない。オブジェクト型は型を書ける場所にならどこにでも書ける型式（type expression）であるのに対して、レコード型は型定義の右辺にしか書けない型表現（type representation）だからだ。オブジェクト型の代わりにタプル型を使うことはできるが、その場合は名前ベースでフィールドにアクセスできるというオブジェクト型の利点を捨てることになる。 ↩