Arantium Maestum

プログラミング、囲碁、読書の話題

OCamlで48 Hour Schemeをやってみる その4 (第六〜八章)

前回から続いて、REPL機能を追加し、変数と関数を定義できるようにする。

第四章: REPL

REPLとはRead Eval Print Loopの略で、対話的にプログラムを入力・実行できる環境である。

この場合は

Lisp>>>

などといったプロンプトを表示してS式を受け取り、評価して結果を返した上で再度プロンプトを表示するようにする。終了のためにはquitと入力すればいい。

github.com

変更はbin/ex.mlファイルだけ。こんな感じになった:

open Lisp

let f s =
  try Lexing.from_string s
  |> Parser.f Lexer.f
  |> Eval.f
  |> Exp.to_string
  |> print_endline
  with
    | Exception.NumArgs (n, s) -> Printf.printf "NumArgs %d %s\n" n s
    | Exception.TypeMismatch (s1, s2) -> Printf.printf "TypeMismatch %s %s\n" s1 s2
    | Exception.LexingFail s -> Printf.printf "LexingFail %s\n" s
    | Exception.BadSpecialForm (s1, s2) -> Printf.printf "BadSpecialForm %s %s\n" s1 s2
    | Exception.NotFunction (s1, s2) -> Printf.printf "NotFunction %s %s\n" s1 s2
    | Exception.UnboundVar (s1, s2) -> Printf.printf "UnboundVar %s %s\n" s1 s2
    | Exception.Default s -> Printf.printf "DefaultError %s\n" s

let rec repl () =
  let s = (print_string "Lisp>>> "; read_line ()) in
  if s = "quit" then ()
  else (f s; repl ())

let _ = repl ()

例外を投げっぱなしにしていたのをcatchして文字列として出力するようにした。こうしないとループが止まってしまう。もうすこしよさげな書き方がありそうなものだが・・・

REPL自体は再帰関数となっていて、それでループしている。

第七章: 変数

第七章では変数を定義できるようにする。

そのためには変数環境を作る必要がある。このチュートリアルでの変数はlet式によるイミュータブルなものではなく、defineやset!で破壊的代入を起こすものなので、それに合わせて変数環境もミュータブルな状態を持つデータ構造にする。とりあえずHashtblで実装してみる。

github.com

変数環境を定義するEnvモジュールはこの通り:

type t = (string, Exp.t) Hashtbl.t

let create () = (Hashtbl.create 100 : t)

let is_bound = Hashtbl.mem
let get_var env v = match Hashtbl.find_opt env v with
  | Some e -> e
  | None -> raise @@ Exception.UnboundVar ("Getting unbound var", v)

let set_var env v e = 
  if is_bound env v
  then (Hashtbl.replace env v e; e)
  else raise @@ Exception.UnboundVar ("Setting unbound var", v)

let define_var env v e = (Hashtbl.replace env v e; e)

基本的にはHashtblの関数をラップする形でEnvの関数を定義している。

次に、式評価のためのEval.fを変数環境を使うよう変更:

let rec f env e = match e with
  (* 省略 *)
  | Atom x -> Env.get_var env x
  (* 省略 *)
  | List [Atom "set!"; Atom v; e'] ->
      f env e' |> Env.set_var env v
  | List [Atom "define"; Atom v; e'] ->
      f env e' |> Env.define_var env v
  (* 省略 *)

単なるAtom xは変数xが束縛された値として評価される。set!defineは変数環境を変更して、束縛された値を評価結果として返す。

あとは変数環境をREPLで使えるようbin/ex.mlを変更:

let f env s =
  try Lexing.from_string s
  |> Parser.f Lexer.f
  |> Eval.f env
  |> Exp.to_string
  |> print_endline
  with
  (* 省略 *)

let rec repl env =
  let s = (print_string "Lisp>>> "; read_line ()) in
  if s = "quit" then ()
  else (f env s; repl env)

let _ = repl (Env.create ())

freplenvをとるようにし、プログラムスタート時に新しく変数環境を作ってreplに渡す。

これで

Lisp>>> (define x 5)
5
Lisp>>> (define y (+ x 1))
6
Lisp>>> (set! x 3)
3
Lisp>>> (+ x y)
9

のように変数を定義・代入して使える。

第八章: 関数定義

第八章はユーザが関数を自作できるようにする。defineで直接名前に束縛する・lambdaで無名関数として定義する、といった選択肢を用意し、またmultiarityにも対応する。さらには以前定義したprimitivesもある程度統一的なアーキテクチャで呼び出されるようにしたい。

github.com

まずは変数環境を見直すところから。

というのもこのLispの関数はclosureを持つので、関数が定義された時点での変数環境を凍結させた形で関数のデータとして保持させたい。そのためには完全にミュータブルなHashtblだと少し都合が悪い。Map refに変更する。

そして関数定義を実装するためには、ExpとEnvの型を相互再帰にする必要が出てくる。(ここでも同じ話をした)

なのでまずはExpとEnvの相互再帰的な部分をくくりだしたExpenvモジュールを定義する:

module Envm = Map.Make(String)

type expt = Atom of string
          | List of expt list
          | DottedList of expt list * expt
          | Number of int
          | String of string
          | Bool of bool
          | PrimitiveFunc of (expt list -> expt)
          | Func of fn
and envt = expt Envm.t ref
and fn = {params : string list;
          varargs : string option;
          body : expt list;
          closure : envt}

環境はtype envt = (string, expt) map refになっており、式の型はFuncが追加され、その内部ではclosureにenvt型が使われている。

EnvとExpはこのEnvexp内の型定義を使って書かれている。

Evalに長々と書かれていたprimitive関数の定義はすべてPrimitivesモジュールに移し、変数環境に全部定義するための関数loadを用意しておく。これでbin/ex.mlから:

let _ = repl (Env.create () |> Primitives.load)

などとしてプログラムスタート時にPrimitivesを変数環境に加えている。

あとはEvalモジュールで関数呼び出しと関数定義に関するコードを追加する。

関数呼び出し:

let rec f env e = match e with
  (* 省略 *)
  | List (head :: tail) ->
      let func = f env head in
      let args = List.map (f env) tail in
      apply func args
  (* 省略 *)
and apply func args = match func with
  | PrimitiveFunc fn -> fn args
  | Func fn -> List.map (f (bind_args fn args)) fn.body |> List.rev |> List.hd
  | _ -> raise @@ Exception.NotFunction ("Non-function found at front position", to_string func)

先頭の要素がquoteifなどの特殊なワードではない場合、まず先頭要素を評価し、それ以外の要素を評価し、先頭要素を関数、それ以外を引数としてapplyする。先頭要素がPrimitive関数な場合はそのまま引数を渡して結果を計算する。primitiveではない関数な場合、関数のclosureに仮引数と引数を対応させる形で追加し、そのclosureをenvとして関数のbodyとなるリストを順次評価(ここでapplyEval.fが相互再帰する)、最後の結果を式全体の評価結果として返す。

「関数のclosureに仮引数と引数を対応させる形で追加」というのが少しめんどくさく、以下のヘルパー関数を定義してある:

let rec bind_args' params args env = match params, args with
  | [], [] -> env
  | p::params', a::args' -> (Env.define_var env p a |> ignore; bind_args' params' args' env)
  | _ -> raise @@ Exception.Default "Interpreter error - failed to detect NumArg mismatch"

let rec bind_vargs' params args varg env = match params, args with
  | [], [] -> env
  | p::params', a::args' -> (Env.define_var env p a |> ignore; bind_vargs' params' args' varg env)
  | [], _ ->  (Env.define_var env varg (List args) |> ignore; env)
  | _ -> raise @@ Exception.Default  "Interpreter error - failed to detect NumArg mismatch"

let bind_args (fn : Exp.fn) args =
  let pcount = List.length fn.params in
  let acount = List.length args in
  if pcount != acount && fn.varargs = None
  then raise @@ Exception.NumArgs (pcount, "" ^ string_of_int acount)
  else match fn.varargs with
    | None -> bind_args' fn.params args fn.closure
    | Some varg -> bind_vargs' fn.params args varg fn.closure

とくにmultiarity用のvarargsの存在が実装を少しややこしくしている印象。

関数定義はmake_funcというヘルパー関数を使って実装している:

let make_func paratoms vargs body env =
  let stringify_atom = function
    | Atom s -> s
    | e -> raise @@ Exception.TypeMismatch ("Function parameters must be atoms", to_string e)
  in
  Func {params=List.map stringify_atom paratoms;
        varargs=vargs;
        body=body;
        closure=(Env.copy env)}

let rec f env e = match e with
  (* 省略 *)
  | List (Atom "define" :: List (Atom v::paratoms) :: body) ->
      make_func paratoms None body env |> Env.define_var env v
  | List (Atom "define" :: DottedList (Atom v::paratoms, Atom varg) :: body) ->
      make_func paratoms (Some varg) body env |> Env.define_var env v
  | List (Atom "lambda" :: List paratoms :: body) ->
      make_func paratoms None body env
  | List (Atom "lambda" :: DottedList (paratoms, Atom varg) :: body) ->
      make_func paratoms (Some varg) body env
  | List (Atom "lambda" :: Atom varg :: body) ->
      make_func [] (Some varg) body env
  (* 省略 *)

varargs有無でdefine/lambdaによる関数定義ができる。

closureがちゃんと作動していることを示す例として:

Lisp>>> (define (count inc) (lambda (x) (set! inc (+ inc x)) inc))
(lambda (inc) ...)
Lisp>>> (define my-counter (count 1))
(lambda (x) ...)
Lisp>>> (my-counter 3)
4
Lisp>>> (my-counter 5)
9
Lisp>>> inc
UnboundVar Getting unbound var inc

inc変数はmy-counterの中には存在していて、関数呼び出しごとに破壊的代入されている。関数の外からはアクセスできない(外側の変数環境には存在しない、とエラーが出る)。

と、ここまででようやくちゃんとしたプログラミング言語らしくなってきた。再帰ができないのが非常に気がかりだが、とりあえず48時間以内に最低限のLispが実装できた、と言ってもいい気がする。

しかしもうちょっとだけ続くんじゃ。

OCamlで48 Hour Schemeをやってみる その3 (第四章、五章)

第四章:エラーハンドリング

第四章の主眼はエラーハンドリング。

Haskellだとモナドでやるのが正しい作法なようで、型チェックの恩恵に与れる。その反面、一章を割いていろんな関数の実装と型注釈を変更していく必要がある。

OCamlだと例外を投げればいいので楽。

github.com

Exceptionsモジュールで使ういろんなエラーを定義して:

exception NumArgs of int * string
exception TypeMismatch of string * string
exception LexingFail of string
exception BadSpecialForm of string * string
exception NotFunction of string * string
exception UnboundVar of string * string
exception Default of string

他のモジュールで投げるだけ。今のところは「捉えて解釈してより有用なエラーメッセージを出力する」みたいなことはしていない。

第五章:機能追加

第五章では新たにいろいろと機能を追加していく。

github.com

=, <, >, &&, ||などの二項演算子ifによる条件分岐、car, cdr, consなどのリスト処理関数、そして比較演算子eq?, eqv? equal?などを実装した。

ついでに細々とした実装の間違いが発覚したので、それも修正:

  • '(a b c)(quote a b c)とパースしていたのを(quote (a b c))になるように変更
  • "abc"といった文字列をString "\"abc\""とパースしていたのをString "abc"になるように変更

細かい修正はコミットログを見てもらえばわかるが、比較的簡単に機能が追加できるのは嬉しい。

次章はREPLを追加する話。

OCamlで48 Hour Schemeをやってみる その2 (第三章後半)

前回から続いてWrite Yourself a Scheme in 48 Hours第三章。

primitive関数適用の評価まで実装する。

github.com

src/eval.mlというモジュールを新たに作った。

open Exp

(* 省略 *)

let rec f e = match e with
  | String _ -> e
  | Number _ -> e
  | Bool _ -> e
  | List [Atom "quote"; e2] -> e2
  (* 省略 *)
  | _ -> failwith "Evaluation not implemented"

まずはこんな感じに文字列、数字、真偽値は評価されてもそのままであると定義。(quote x)のようなリストはxに評価される。

これをbin/ex.mlから使うようにする:

open Lisp

let _ =
  Lexing.from_channel stdin
  |> Parser.f Lexer.f
  |> Eval.f
  |> Exp.to_string
  |> print_endline

ここまでは簡単。次はeval.mlを拡張してprimitive関数適用を評価できるようにする。

まずはLisp式を整数値に変換する関数:

let rec to_int = function
  | Number n -> n
  | String s -> (try int_of_string s with Failure _ -> 0)
  | List [e] -> to_int e
  | _ -> 0

Number型は単純なのだが

  • 文字列は変換できれば変換する
  • 単一の要素を持つリストはその要素を整数値に変換する
  • それ以外の式はすべて0として扱う

というなんとも「弱い型」な評価方法。

二項演算子Lisp式のリストをとり、Lisp式を整数に変換してfoldするnumeric_binop関数:

let numeric_binop op params =
  let n = match List.map to_int params with
    | [] -> 0
    | x :: xs -> List.fold_left op x xs
  in
  Number n

primitive関数をnumeric_binopで定義してstring Mapに入れておく:

module P = Map.Make(String)
let primitives = P.empty
  |> P.add "+" (numeric_binop (+))
  |> P.add "-" (numeric_binop (-))
  |> P.add "*" (numeric_binop ( * ))
  |> P.add "/" (numeric_binop (/))
  |> P.add "mod" (numeric_binop (mod))

これで関数適用のためのapplyが書ける:

  • Lisp式リストのCARがprimitiveに合致するかどうかをチェック
  • もし合致していたらその関数をリストのCDRに適用する
let apply func args = match P.find_opt func primitives with
  | None -> Bool false
  | Some f -> f args

Eval.f関数内では、まずCDRの個々の要素を評価してからapplyを使う:

let rec f e = match e with
  (* 省略 *)
  | List (Atom func :: args) ->
      List.map f args
      |> apply func
  (* 省略 *)

これで

> echo "(- 54 10 2)" | dune exec bin/ex.bc
42

となる。

次回はエラーハンドリング。

OCamlで48 Hour Schemeをやってみる その1 (第一章〜第三章前半まで)

こういうことを言ってしまった:

発言に責任を持つためにもOCamlLisp処理系を実装してみようと思う。

幸いHaskellで簡単なLisp処理系を実装するためのチュートリアルが存在する:

en.wikibooks.org

Haskellを触っていた時に試して大変面白かった。これをOCamlに移植してみる。

第一章

まずは第一章でとりあえずテキストを表示できるプロジェクトを作ってコンパイルするところまで:

github.com

あまりコメントするべきことはない。ビルドツールにduneを使っているのでdune exec bin/ex.bcなどとするとbin/ex.mlのコードが実行される。

第二章

第二章ではParserを作る。ようやくLisp的なものが出てくる。

type t = Atom of string
       | List of t list
       | DottedList of t list * t
       | Number of int
       | String of string
       | Bool of bool

こんな感じのLisp式のASTを表す型を定義して、ocamllex製のlexer、menhir製のparserでそのLisp式を返すようにする。

github.com

この段階ではパースしたLisp式はignoreするだけ。ちゃんとパースされるかどうかは確認できる。

> echo "(+ 1 2 '(3 4))" | dune exec bin/ex.bc

> echo "(+ 1 2a)" | dune exec bin/ex.bc
Fatal error: exception Failure("Atoms cannot start with a digit")

第三章前半

パースした式を文字列として出力し直せるようにする。

github.com

ExpモジュールにLisp式型を文字列に変換するto_string関数を追加する:

let rec to_string = function
  | Atom a -> a
  | List es ->
      let s = List.map to_string es |> String.concat " " in
      Printf.sprintf "(%s)" s
  | DottedList (es, e) ->
      let s = List.map to_string es |> String.concat " " in
      Printf.sprintf "(%s . %s)" s (to_string e)
  | Number n -> string_of_int n
  | String s -> "\"" ^ s ^ "\""
  | Bool b -> string_of_bool b

その関数をbin/ex.mlで使ってパースした式を文字列に変換して出力する:

let _ =
  Lexing.from_channel stdin
  |> Parser.f Lexer.f
  |> Exp.to_string
  |> print_endline

使い方はこんな感じ:

> echo "1" | dune exec bin/ex.bc
1
> echo "abc" | dune exec bin/ex.bc
abc
> echo "(+ abc 1)" | dune exec bin/ex.bc 
(+ abc 1)
> echo "(+ abc 1 '(x y z))" | dune exec bin/ex.bc
(+ abc 1 (quote x y z))

続く

今週末中に全部実装して記事にできたらいいな・・・ (続き

let多相と型制約と型推論

こういう(けっこう前の)記事があって面白かった:

no-maddojp.hatenablog.com

大変面白かったのと、何故こうなるのかが微妙に理解し切れなかったのと、で少し自分でも調べてみた。

ちょっと例を簡略化すると

let f x = x in f 1, f true

は型検査を通るけど

let f x : 'a = x in f 1, f true
let g (x : 'a) = x in g 1, g true

などは通らない、という話だ。

(ちなみにOCaml 4.06.1だと"Error: This expression has type bool but an expression was expected of type int"と怒られる)

'aという型「注釈」をつけた途端に型検査が通らなくなる、ように見える。

さらにいうとutopなどで

let f x = x;;

としてみるとval f : 'a -> 'a = <fun>だと言ってくる。その型と合致する注釈をつけているのに何故?

ポイントは上記の記事で@camloebaさんが言っている通り、let f x : 'a ...は型注釈ではなく型制約だという点のようだ。

つまりlet f x : 'a = ... in ...というような記述は

このf xは'a型(パラメトリック多相)として扱ってね

という型注釈ではなく

型推論のunificationの時にとりあえずf xには'aという型変数を振っておいてね

という型制約だということ。.mliファイルやモジュールのsignatureでval f : 'a -> 'aと指定するのとは本質的に異なる記述のようだ。

そう考えると、この制約があると

let f x : 'a = x in f 1, f true

f 1の時点で'a = intだとunifyされて、f trueで型検査が失敗する、というのは直観的だと思う。

ではなぜこの型制約がないと型検査を通るか?

let多相と型推論についてTaPLの22.6章にこう書いてあった:

A better alternative (to allow programmers to completely omit type annotations on lambda-abstractions) is to add un-annotated abstractions to the syntax of terms and a corresponding rule to the constraint typing relation. ...

This account of un-annotated abstractions is ... more expressive, in a small but useful way: if we make copies on an un-annotated abstraction, the CT-ABS_INF (type constraint) rule will allow us to choose a different variable as the argument type of each copy. By contrast, if we regard a bare abstraction as being annotated with an invisible type variable, then making copies will yield several expressions sharing the same argument type. This difference is important for the discussion of let-polymorphism... - Benjamin Pierce, Types and Programming Languages, Chapter 22.6

そもそもlet多相を実現するためにlet x = t1 in t2という記述に対して型推論時にxに型変数を振らないでおくということらしい。ちなみに22.7章はその考えで具体的にどうlet多相を実現するかというトピック。

せっかく型推論が空気を読んで(?)letで定義される変数に型変数を振らずに解決しようとしているのに、let f x : 'a ...などとしたせいで振らざるを得なくなってしまって、その結果unificationで「int = boolになるので型検査失敗です」とエラーが出てしまう、というのが真相のようだ。

ocamllexのlexerとmenhirのparserの間に任意のOCamlコードによる変換を挿入する

OCamlでパーサを書く場合

  • lexerをocamllexで書く
  • そのlexerを受け取るparserをmenhirで書く

というのが最近の鉄板のようだ。

let lexbuf = Lexing.from_channel stdin in
let exp = Parser.f Lexer.f lexbuf in
print (eval exp)

というような流れ。

ocamllexもmenhirも構文が普通のOCamlではなく、いったん独自構文で書かれた.mll/.mlyファイルを両ツールでOCamlの.mlに変換してから普通のOCamlモジュールとして使う。

なので長らくぱっと見どうやってocamllex製のlexerが返すトークンに対して任意の変換を行ってからmenhir製のparserに渡せばいいのか、イメージが湧かなかった。

しかし実際にやってみたら拍子抜けするほど簡単。

パースしたい言語

たし算をネストしたインデントで表現するこんな言語を考えてみたい:

+
  1
  2
  +
    3
    4
  5

これが(+ 1 2 (+ 3 4) 5)のようにパースされてほしい。

インデントをパースするための方針としては

  • lexerは改行後のスペースの数を数えてSPACE nというトークンを作成する
  • parserに渡す前にlexerのトークンを解析し、SPACE nINDENTDEDENTBRといった新しいトークンに変換する
  • 変換済みのトークンをparserに渡す。parserの規則にはSPACEは出て来ず、INDENTDEDENTBRでマッチする

lexer

ocamllexで定義するlexerはこんな感じ:

{
open Parser
}

let digit = ['0'-'9']
let num = (digit | ['1'-'9'] digit*)
let indent = '\n' ' '*
let whitespace = [' ' '\t']

rule f = parse
  | indent as s { SPACE (String.length s - 1) }
  | whitespace+ { f lexbuf }
  | num as n { INT (int_of_string n) }
  | "+" { ADD }
  | eof { EOF }

'\n' ' '*という文字列がマッチされ、SPACE (String.length s - 1)で(改行を除いた)空白の文字数を保持するSPACEトークンが作成されている。

これをocamllexに通すとLexerというモジュールが作成され、その中のf関数が目的のlexerである。

Lexer.fの型は

val f : Lexing.lexbuf -> Parser.token

Lexing.lexbufというOCaml標準ライブラリ内のlexer用の文字列データ型を引数として、menhirに渡す予定のparser.mlyで定義されているtoken型を一つ返す。

ミュータブルなlexbufを受け取り、副作用的にlexbufから文字を必要なだけ「消費」して一つのtokenを返す、という仕様だ。

終端tokenが帰ってくるまで何回でも同じlexbufを引数にLexer.fが呼ばれる想定となる。

parser

parser.mlyはこんな感じ:

%token <int> INT
%token ADD
%token EOF
%token <int> SPACE
%token INDENT
%token DEDENT
%token BR

%start f <Exp.t>

%%

f : e = expr; EOF { e }

expr :
  | n = INT; BR { Exp.Int n }
  | ADD; BR; INDENT; es = list(expr); DEDENT { Exp.Add es }

これもmenhirを通すとParserというモジュールになり、その中のf関数がparserとなる。

型は:

val f : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Exp.t

lexerとlexbufを受け取り、別モジュールで定義されているExp.t型のASTを返す。

この関数の内部実装は確認していないが、前述の通りLexing.lexbuf -> token型の第一引数を第二引数のlexbufに対して何回も(終端トークンがでてくるまで)適用しているようだ。

ならLexer.fをラップしたLexing.lexbuf -> token型の関数を用意してやればいい。

indenter

それがIndenter.f関数:

module P = Parser

let convert_space_to_indent width f =
  let indent = ref 0 in
  let make_indent _ = [P.BR; P.INDENT] in
  let make_dedent _ = [P.BR; P.DEDENT] in
  let g h a b = List.init (a - b) h |> List.concat in
  fun lexbuf -> match f lexbuf with
    | P.SPACE n ->
        let m = n / width in
        let k = !indent in
        if m > k then (indent := m; g make_indent m k)
        else if m < k then (indent := m; g make_dedent k m)
        else [P.BR]
    | P.EOF ->
        let k = !indent in
        (indent := 0; g make_dedent k 0 @ [P.EOF])
    | e -> [e]

let flatten f =
  let xs = ref [] in
  fun lexbuf -> match !xs with
    | x::xs' -> xs := xs'; x
    | [] -> (match f lexbuf with
      | x::xs' -> xs := xs'; x
      | [] -> failwith "Lexer did not return EOF token")

let f = Lexer.f |> convert_space_to_indent 2 |> flatten

convert_space_to_indent関数はindent一つ分のスペース数の指定と、lexbuf -> tokenな関数(この場合はLexer.fを想定している)を引数に取り、lexbuf ->  token listな関数を返す。

その返ってきた関数はlexbufを受け取り、Lexer.fに渡し、戻ってきたトークンが:

  • SPACEなら現在のインデントレベル(クロージャにrefとして保持されている)と比較し、インデントレベルの変更があればクロージャを変更したのちINDENT, DEDENT, BRトークンを必要なだけ返す。インデントに変更がなければBRだけのリストを返す。
  • EOFなら現在のインデントレベル分のDEDENTとEOFの入ったリストを返す
  • SPACEかEOF以外ならそのトークンだけが入ったリストを返す

flattenlexbuf ->  token listな関数を引数に取り、lexbuf -> tokenな関数を返す。

クロージャに保持しているlist refにいったんtoken listを格納して、そのlistが空じゃない場合はlexbufをまったく消費せずにそのlistからトークンを返す仕様になっている。

この二つをLexer.fと組み合わせてIndenter.fを作っている。

ただ、見返してみると、この実装だとIndenterモジュールの中にmutable stateを持ち込んでいてあまりよろしくない。

let f n = Lexer.f |> convert_space_to_indent n |> flatten

として呼び出す側で(Indenter.f 2)などと新しくクロージャを作成するようにしたほうがいい。

使い方

あとはまあ使うだけ:

let rec eval = function
| Exp.Int n -> n
| Exp.Add ns -> List.map eval ns |> List.fold_left (+) 0

let _ =
Lexing.from_channel stdin
|> Parser.f Indenter.f
|> eval
|> string_of_int
|> print_endline

普通だったらParser.f Lexer.fとしてるところをParser.f Indenter.fとしている。

まとめ

基本的にmenhirで作ったパーサにはLexing.lexbuf -> token型で呼び出すごとにtokenが返ってくるような関数を渡してやればいいだけなので、内部状態をクロージャとして持つ関数でocamllex製のlexerをラップしてしまえば任意のコードでトークンストリームを変換できることがわかった。

今回のgist:

gist.github.com

OCamlで相互再帰な型を二つのModuleにわける方法二つ

Essentials of Programming LanguageをOCamlで実装するのをぼちぼちとすすめている。

前回LETを実装した時「式を評価した結果の値」を表す型とその型に対する関数を集めたValと「変数とそれに対応する値の対応関係を保持する環境」のモジュールEnvを作った。

上記の説明からも推測できると思うが、Envの定義にVal.tが使われている:

type t = (string * Val.t) list

次に実装するPROC言語では第一級関数が定義できる。関数が変数の値となりえるのでVal.tのバリアントの一つとしてProcが追加される。そしてそのProcクロージャを持つ、つまり変数環境を保持する必要がある。

type t = Num of int
       | Bool of bool
       | Proc of string * Exp.t * Env.t

しかしEnvの定義にVal.tが使われており、Val.tの定義にEnv.tを使おうとすると相互再帰になってしまう。どうしよう。

解決策が二つわかった(一つは@camloebaさんに教えてもらった。ありがとうございます!)のでメモ。

相互再帰的なモジュール

一つ目のやりかたはモジュール自体を相互再帰的にしてしまうことだ。

PROC言語はその方法で実装してみた:

github.com

Valenv.mlというモジュールでmodule rec ... and ...という構文を使ってValEnvを相互再帰的に実装する:

module rec Val : sig
  type t = Num of int
         | Bool of bool
         | Proc of string * Exp.t * Env.t

  val to_str : t -> string
end = struct
  type t = Num of int
         | Bool of bool
         | Proc of string * Exp.t * Env.t

  let to_str = function
    | Num n -> string_of_int n
    | Bool b -> if b then "True" else "False"
    | Proc _ -> "Proc"
end

and Env : sig
  type t

  val empty : t
  val find : t -> string -> Val.t option
  val extend : t -> string -> Val.t -> t
end = struct
  type t = (string * Val.t) list

  let empty = []
  
  let rec find env s = match env with
    | [] -> None
    | (s', v')::env' -> if s = s' then Some v' else find env' s
  
  let extend env s v = (s, v)::env
end

あとはValenv.mliでsignatureだけ明示して、Val.mlEnv.mlinclude Valenv.Valinclude Valenv.Envするだけ。

少々かったるい点としては相互再帰的モジュールはValenv.ml内で実装を定義するときもsignatureが必要なので同じものが.ml.mliで重複すること。

相互再帰的な型を定義し、それを使ってモジュールを定義する

相互再帰的な型とモジュールについてツイッターでつぶやいたら以下のようにご教示いただいた:

type t = t1 = Foo of t2の構文が私が躓いていたポイントで、こう書かないとA.Foo x2のようにコンストラクタが使えなくなってしまう。

LETREC言語はこのデザインで実装してみた:

github.com

Valenv.mlはこんな感じ:

type valt = Num of int
          | Bool of bool
          | Proc of string * Exp.t * envt
and envt = Empty
         | Extend of string * valt * envt
         | ExtendRec of string * string * Exp.t * envt
 
module Val = struct
  type t = valt = Num of int
                | Bool of bool
                | Proc of string * Exp.t * envt

  let to_str = function
    | Num n -> string_of_int n
    | Bool b -> if b then "True" else "False"
    | Proc _ -> "Proc"
end

module Env = struct
  type t = envt

  let empty = Empty
  
  let rec find env s = match env with
    | Empty -> None
    | Extend (s', v', env') ->
        if s = s' then Some v'
        else find env' s
    | ExtendRec (fname, arg, body, env') ->
        if s = fname then Some (Val.Proc (arg, body, env)) 
        else find env' s 
  
  let extend env s v = Extend (s, v, env)
  let extend_rec env f a b = ExtendRec (f, a, b, env)
end

Valenv.mliにはvaltの具体型、envtの抽象型そしてValEnvのsignatureを書く:

type envt
type valt = Num of int
          | Bool of bool
          | Proc of string * Exp.t * envt

module Val : sig
  type t = valt = Num of int
                | Bool of bool
                | Proc of string * Exp.t * envt
  val to_str : t -> string
end

module Env : sig
  type t = envt
  val empty : t
  val find : t -> string -> valt option
  val extend : t -> string -> valt -> t
  val extend_rec : t -> string -> string -> Exp.t -> t
end

Val.mlEnv.mlinclude Valenv.Valinclude Valenv.EnvするだけなのはPROCと同じ。

雑考

実はValenvではvaltenvtの定義だけをしてVal.mlEnv.mlで各モジュールの内容を定義できれば、と考えていたのだが、その場合うまくenvtを抽象型にする方法が思い浮かばなかったので断念。Env.mlの中ではenvtの実装を使う必要があるので・・・ C++のFriend的な定義ができれば(EnvモジュールがVarenvの実装に特権的にアクセスできるような指定ができれば)解決するのだが、そういう言語機能はなさそう。