• syntax.ml: 抽象構文のためのデータ型
• parser.mly, lexer.mll: 字句解析と構文解析
• environment.ml, eval.ml: 環境の実現，解釈部
• main.ml

3;;
true;;
x;;
3 + x';;
(3 + x1) * false;;

---

(* ML interpreter / type reconstruction *) type id = string type binOp = Plus | Mult | Lt type exp = Var of id | ILit of int | BLit of bool | BinOp of binOp * exp * exp | IfExp of exp * exp * exp type program = Exp of exp

Figure 1: ML¹インタプリタ: syntax.ml

---

%{
  <ヘッダ>
%}
  <宣言>
%%
  <文法規則>
%%
  <トレイラ>

---

%{ open Syntax %} %token LPAREN RPAREN SEMISEMI %token PLUS MULT LT EQ COLONCOLON %token IF THEN ELSE TRUE FALSE %token <int> INTV %token <Syntax.id> ID %start toplevel %type <Syntax.program> toplevel %% toplevel : Expr SEMISEMI { Exp $1 } Expr : IfExpr { $1 } | LTExpr { $1 } LTExpr : PExpr LT PExpr { BinOp (Lt, $1, $3) } | PExpr { $1 } PExpr : PExpr PLUS MExpr { BinOp (Plus, $1, $3) } | MExpr { $1 } MExpr : MExpr MULT AExpr { BinOp (Mult, $1, $3) } | AExpr { $1 } AExpr : INTV { ILit $1 } | TRUE { BLit true } | FALSE { BLit false } | ID { Var $1 } | LPAREN Expr RPAREN { $2 } IfExpr : IF Expr THEN Expr ELSE Expr { IfExp ($2, $4, $6) }

Figure 2: ML¹ インタプリタ: parser.mly

---

• ヘッダにある open 宣言は，文法規則宣言部で syntax.ml 中で宣 言されているコンストラクタ・型の名前をモジュール名無しで使えるように している．(これがないと，いちいち Syntax.Varなどの長い名前で参照し なくてはならない．)
• %token <トークン名> ... は，属性を持たないトークンの宣言である．ここでは括弧 ``(''， ``)'' と，入力の終了を示す ``;;'' に対応するトークン LPAREN, RPAREN，SEMISEMIと，プリミティブ (+, *, <)に対応するトークン PLUS, MULT, LT, 予約語 if, then, else, true, false に対応す るトークンが宣言されている．(図1に現れる構文木のコ ンストラク タ Plus などとの区別に注意すること．トークン名は全て英 大文字としている．) この宣言で宣言されたトークン名はocamlyaccの出力 する parser.ml 中で，token 型の(引数なし)コンストラクタになる． 字句解析プログラムは文字列を読み込んで，この型の値(の列)を出力する ことになる．
  
  
• %token <<型>> <トークン名> ... は，属性つきのトークン宣言である．数値のためのトークン INTV (属性 はその数値情報なので int 型) と変数のための ID (属性は変数名を表 すSyntax.id 型³)を宣言して いる．この宣言で宣言されたトークン名は parser.ml 中で，<型> を引数とする token 型のコンストラクタになる．
  
  
• %start <開始記号名> ... で(一つ以上の) 開始記号の名前を指定する．ocamlyacc が生成する， parser.ml ファイルでは，同名の関数が構文解析関数として宣言される． ここでは toplevel という名前を宣言しているので， 後述する main.ml では Parser.toplevel という関数を使用して 構文解析をしている．開始記号の名前は，次の %type 宣言でも宣言されていなくてはならない．
  
  
• %type <<型>> <名前> ... 名前の属性を指定する宣言である，toplevel はひとつのプログラムの抽 象構文木を表すので属性はSyntax.program 型となっている．
  
  
• 文法規則は，

  <非終端記号名> : 
     <記号名11> ... <記号名1n1> { <還元時アクション1> }
   | <記号名21> ... <記号名2n2> { <還元時アクション2> }
   ...
  

  のように記述する．<還元時アクション>には Objective Caml の式を記述する． $i で，i番目の記号の属性を参照することができる．式全体の評価結果がこ の非終端記号の属性となるので，式の型は全て一致している必要がある．例え ば Exp は Syntax.exp 型の値(つまり ML¹ の式の抽象構文木)を属 性として持ち，各アクションでは，その生成規則に対応する抽象構文木を生成 するような式が書かれている．

{ <ヘッダ> }

let <名前> = <正則表現>
...

rule <エントリポイント名> =
  parse <正則表現> { <アクション> }
    |   <正則表現> { <アクション> }
    |   ...
and <エントリポイント名> =
  parse ...
and ...
{ <トレイラ> }

• Lexing.lexeme lexbuf で，正則表現にマッチした文字列を取り出す．
• Lexing.lexeme_char lexbuf n で，マッチした文字列の n 番目の 文字を取り出す．
• Lexing.lexeme_start lexbuf で，マッチした文字列の先頭が入力文 字列全体でどこに位置するかを返す．末尾の位置は Lexing.lexeme_end lexbuf で知ることができる．
• <エントリポイント> lexbuf で，<エントリポイン ト>規則を呼び出す．

---

{ let reservedWords = [ (* Keywords in the alphabetical order *) ("else", Parser.ELSE); ("false", Parser.FALSE); ("if", Parser.IF); ("then", Parser.THEN); ("true", Parser.TRUE); ] } rule main = parse (* ignore spacing and newline characters *) [' ' '\009' '\012' '\n']+ { main lexbuf } | "-"? ['0'-'9']+ { Parser.INTV (int_of_string (Lexing.lexeme lexbuf)) } | "(" { Parser.LPAREN } | ")" { Parser.RPAREN } | ";;" { Parser.SEMISEMI } | "+" { Parser.PLUS } | "*" { Parser.MULT } | "<" { Parser.LT } | ['a'-'z'] ['a'-'z' '0'-'9' '_' '']* { let id = Lexing.lexeme lexbuf in try List.assoc id reservedWords with _ -> Parser.ID id } | eof { exit 0 }

Figure 3: ML¹ インタプリタ: lexer.mll

---

式の表す値

(* Expressed values *)
type exval = 
    IntV of int
  | BoolV of bool
and dnval = exval

環境

type 'a t
exception Not_bound
val empty : 'a t
val extend : Syntax.id -> 'a -> 'a t -> 'a t
val lookup : Syntax.id -> 'a t -> 'a
val map : ('a -> 'b) -> 'a t -> 'b t
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b

---

type 'a t = (Syntax.id * 'a) list exception Not_bound let empty = [] let extend x v env = (x,v)::env let rec lookup x env = try List.assoc x env with Not_found -> raise Not_bound let rec map f = function [] -> [] | (id, v)::rest -> (id, f v) :: map f rest let rec fold_right f env a = match env with [] -> a | (_, v)::rest -> f v (fold_right f rest a)

Figure 4: ML¹ インタプリタ: 環境の実装 (environment.ml)

---

let initial_env = 
  Environment.extend "i" (IntV 1)
    (Environment.extend "v" (IntV 5) 
       (Environment.extend "x" (IntV 10) Environment.empty))

解釈部の主要部分

---

let rec apply_prim op arg1 arg2 = match op, arg1, arg2 with Plus, IntV i1, IntV i2 -> IntV (i1 + i2) | Plus, _, _ -> err ("Both arguments must be integer: +") | Mult, IntV i1, IntV i2 -> IntV (i1 * i2) | Mult, _, _ -> err ("Both arguments must be integer: *") | Lt, IntV i1, IntV i2 -> BoolV (i1 < i2) | Lt, _, _ -> err ("Both arguments must be integer: <") let rec eval_exp env = function Var x -> (try Environment.lookup x env with Environment.Not_bound -> err ("Variable not bound: " ^ x)) | ILit i -> IntV i | BLit b -> BoolV b | BinOp (op, exp1, exp2) -> let arg1 = eval_exp env exp1 in let arg2 = eval_exp env exp2 in apply_prim op arg1 arg2 | IfExp (exp1, exp2, exp3) -> let test = eval_exp env exp1 in (match test with BoolV true -> eval_exp env exp2 | BoolV false -> eval_exp env exp3 | _ -> err ("Test expression must be boolean: if")) let eval_decl env = function Exp e -> let v = eval_exp env e in ("-", env, v)

Figure 5: ML¹ インタプリタ: 評価部の実装(eval.ml)の抜粋

---

1. 入力文字列の読み込み・構文解析
2. 解釈
3. 結果の出力

---

open Syntax open Eval let rec read_eval_print env = print_string "# "; flush stdout; let decl = Parser.toplevel Lexer.main (Lexing.from_channel stdin) in let (id, newenv, v) = eval_decl env decl in Printf.printf "val %s = " id; pp_val v; print_newline(); read_eval_print newenv let initial_env = Environment.extend "i" (IntV 1) (Environment.extend "v" (IntV 5) (Environment.extend "x" (IntV 10) Environment.empty)) let _ = read_eval_print initial_env

Figure 6: mini Scheme¹ インタプリタ: main.ml

---