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が実装できた、と言ってもいい気がする。

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