• syntax.ml: 抽象構文のためのデータ型
• parser.mly, lexer.mll: 字句解析と構文解析
• core.ml: 解釈部
• main.ml

3
x
(+ 3 x')
(add1 (+ 3 x1))

---

(* abstract syntax *) type id = string type prim = Plus | Minus | Mul | Add1 | Sub1 type exp = ILit of int (* Integer LITeral *) | Var of id (* VARiable reference *) | Prim of prim * exp list (* PRIMitive application *) type program = Prog of exp

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

---

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

---

%{ open Syntax %} %token LPAREN RPAREN %token PLUS MINUS MUL ADD1 SUB1 %token <int> INTV %token <Syntax.id> ID %start toplevel %type <Syntax.program> toplevel %% toplevel : Exp { Prog $1 } Exp : INTV { ILit $1 } | ID { Var $1 } | LPAREN PrimOp Arglist RPAREN { Prim ($2, $3) } PrimOp : PLUS { Plus } | MINUS { Minus } | MUL { Mul } | ADD1 { Add1 } | SUB1 { Sub1 } Arglist : /* empty */ { [] } | Exp Arglist { $1 :: $2 }

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

---

• ヘッダにある open 宣言は，文法規則宣言部で syntax.ml 中で宣 言されているコンストラクタ・型の名前をモジュール名無しで使えるように している．(これがないと，Syntax.Varなどの長い名前で参照しなくてはなら ない．)
• %token <トークン名> ... は，属性を持たないトークンの宣言である．ここでは括弧 ``('' と ``)'' に対応するトークン LPAREN, RPARENと，プリミティブ (+, -, *, add1, sub1)に対応 するトークン PLUS, MINUS, MUL, ADD1, SUB1 が宣言されている． (図1に現れる構文木のコンストラクタ Plus などとの 区別に注意すること．)
  
  
• %token <<型>> <トークン名> ... は，属性つきのトークン宣言である．数値のためのトークン INTV (属性 はその数値情報なので int 型) と変数のための ID (属性は変数名を表 すSyntax.id 型²)を宣言して いる．このふたつの宣言で宣言されたトークン名はocamlyacc の出力する 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 型の値(つまり mini Scheme¹ の式の抽象構文木)を属 性として持ち，各アクションでは，その生成規則に対応する抽象構文木を生成 するような式が書かれている．

{ <ヘッダ> }

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 *) ("+", Parser.PLUS); ("-", Parser.MINUS); ("*", Parser.MUL); ("add1", Parser.ADD1); ("sub1", Parser.SUB1); ] } 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 } | ['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: mini Scheme¹ インタプリタ: lexer.mll

---

Expressed value と Denoted value

(* Expressed values *)
type exval = 
    IntV of int

(* Denoted values *)
and dnval = exval

環境

val empty_env : unit -> env
val extend_env : Syntax.id list -> dnval list -> env -> env
val apply_env : Syntax.id -> env -> dnval
exception UnboundVar of string

---

type env = EmptyEnv | ExtendEnv of id list * dnval array * env exception UnboundVar of string let empty_env () = EmptyEnv let extend_env ids dnvals env = (* assumes List.length syms = List.length dnvals *) ExtendEnv (ids, Array.of_list dnvals, env) let rec list_pos n = function [] -> raise Not_found | m :: rest -> if n = m then 0 else succ (list_pos n rest) let rec apply_env id = function EmptyEnv -> raise (UnboundVar id) | ExtendEnv (ids, dnvals, rest) -> (try dnvals.(list_pos id ids) with Not_found -> apply_env id rest)

Figure 4: mini Scheme¹ インタプリタ: 環境の実装 (core.ml)

---

let global_env = 
  extend_env 
    ["i"; "v"; "x"] 
    (List.map (fun i -> IntV i) [1; 5; 10]) 
    (empty_env())

解釈部の主要部分

---

let apply_prim p args = match p, args with | (Plus, [IntV i; IntV j]) -> IntV (i + j) | (Plus, _) -> failwith "Arity mismatch: +" | (Minus, [IntV i; IntV j]) -> IntV (i - j) | (Minus, _) -> failwith "Arity mismatch: -" | (Mul, [IntV i; IntV j]) -> IntV (i * j) | (Mul, _) -> failwith "Arity mismatch: *" | (Add1, [IntV i]) -> IntV (i + 1) | (Add1, _) -> failwith "Arity mismatch: add1" | (Sub1, [IntV i]) -> IntV (i - 1) | (Sub1, _) -> failwith "Arity mismatch: sub1" let rec eval_exp env = function ILit i -> IntV i | Var sym -> apply_env sym env | Prim (p, es) -> let args = eval_rands env es in apply_prim p args and eval_rands env = function [] -> [] | e :: rest -> eval_exp env e :: eval_rands env rest let eval_program (Prog e) = eval_exp global_env e

Figure 5: mini Scheme¹ インタプリタ: 評価部の実装(core.ml)

---

---

let run () = Core.eval_program (Parser.toplevel Lexer.main (Lexing.from_channel stdin)) let rec read_eval_print () = print_string "=> "; flush stdout; Core.pp (run ()); print_newline (); read_eval_print () let _ = read_eval_print ()

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

---

⇒ (+ 2 3 4)
9
⇒ (* 3 4 5)
60