Tigerインタプリタで関数を宣言・呼び出しできるようにしたい

code:diff

diff --git a/bin/main.ml b/bin/main.ml

index 147fa59..631e1e0 100644

--- a/bin/main.ml

+++ b/bin/main.ml

@@ -3,6 +3,6 @@ let () =

let buff = Lexing.from_channel stdin in

let expr = Tiger.Parser.program Tiger.Lexer.token buff in

let result, _ = Tiger.Eval.f expr [] in

- print_string "Result: ";

+ print_string "#=> ";

Tiger.Eval.print_val result;

print_newline ()

diff --git a/lib/eval.ml b/lib/eval.ml

index 54bfd68..1aa1f6e 100644

--- a/lib/eval.ml

+++ b/lib/eval.ml

@@ -1,6 +1,6 @@

-type val_t = IntVal of int | StringVal of string

type id = string

-type table = (id * val_t) list

+and table = (id * val_t) list

+and val_t = IntVal of int | StringVal of string | FunctionDec of id list * Syntax.t

let rec f expr env: val_t * table =

match expr with

@@ -13,12 +13,28 @@ let rec f expr env: val_t * table =

env

decs

in f body new_env

+ | Syntax.CallExp (id, args) ->

+ (let func = List.assoc id env in

+ match func with

+ | FunctionDec (field_names, body) ->

+ let rec get_args (args:Syntax.t list) (env:table) (field_names:id list) =

+ match args, field_names with

+ | [], [] -> env

+ | arg::args, field_name::field_names ->

+ let v, env = f arg env in

+ get_args args ((field_name, v)::env) field_names

+ | _ -> failwith "type error"

+ in

+ let new_env = get_args args env field_names in

+ f body new_env

+ | _ -> failwith "type error")

| Syntax.OpExp (e1, op, e2) ->

match op with

| Syntax.PlusOp | Syntax.MinusOp | Syntax.TimesOp | Syntax.DivideOp ->

calc op e1 e2 env

| Syntax.EqOp | Syntax.NeqOp | Syntax.LtOp | Syntax.GtOp | Syntax.LeOp | Syntax.GeOp ->

compare op e1 e2 env

+

and calc op e1 e2 env =

let v1, env = f e1 env in

let v2, env = f e2 env in

@@ -28,7 +44,8 @@ and calc op e1 e2 env =

| Syntax.TimesOp, IntVal v1, IntVal v2 -> IntVal(v1 * v2), env

| Syntax.DivideOp, IntVal v1, IntVal v2 -> IntVal(v1 / v2), env

| _ -> failwith "type error"

-and compare op e1 e2 env =

+

+ and compare op e1 e2 env =

let v1, env = f e1 env in

let v2, env = f e2 env in

match op, v1, v2 with

@@ -41,11 +58,26 @@ and compare op e1 e2 env =

| Syntax.EqOp, StringVal s1, StringVal s2 -> if s1 = s2 then IntVal(1), env else IntVal(0), env

| Syntax.NeqOp, StringVal s1, StringVal s2 -> if s1 <> s2 then IntVal(1), env else IntVal(0), env

| _ -> failwith "type error"

-and eval_dec dec env =

+

+ and eval_dec dec env =

match dec with

| Syntax.VarDec (id, e) ->

let (v, _) = f e env in

(id, v) :: env

+ | Syntax.FunctionDec (id, fields, body) ->

+ let rec get_field_names (fields:Syntax.field_t list) =

+ match fields with

+ | [] -> []

+ | Field (id, _) :: rest -> id :: get_field_names rest

+ in

+ let field_names = get_field_names fields in

+ let func = FunctionDec (field_names, body) in

+ (id, func) :: env

+

and string_of_val v =

- match v with IntVal n -> string_of_int n | StringVal s -> s

+ match v with

+ IntVal n -> string_of_int n

+ | StringVal s -> s

+ | FunctionDec _ -> "<fun>"

+

and print_val v = print_string (string_of_val v)

diff --git a/lib/lexer.mll b/lib/lexer.mll

index cac6880..afc70b0 100644

--- a/lib/lexer.mll

+++ b/lib/lexer.mll

@@ -18,6 +18,7 @@ rule token = parse

| "in" { Parser.IN }

| "end" { Parser.END }

| "var" { Parser.VAR }

+ | "function" { Parser.FUNCTION }

| "+" { Parser.PLUS }

| "-" { Parser.MINUS }

| "*" { Parser.TIMES }

@@ -29,6 +30,10 @@ rule token = parse

| ">" { Parser.GT }

| ">=" { Parser.GE }

| ":=" { Parser.ASSIGN }

+ | "(" { Parser.LPAREN }

+ | ")" { Parser.RPAREN }

+ | "," { Parser.COMMA }

+ | ":" { Parser.COLON }

| digit+ { Parser.INT(int_of_string(Lexing.lexeme lexbuf)) }

| letter (letter|digit)* { Parser.ID(Lexing.lexeme lexbuf) }

| "\"" (printable | space)* "\"" {

diff --git a/lib/parser.mly b/lib/parser.mly

index 449c024..27a74d9 100644

--- a/lib/parser.mly

+++ b/lib/parser.mly

@@ -9,7 +9,8 @@

%token PLUS MINUS TIMES DIVIDE

%token EQ NEQ LT LE GT GE

%token LET IN END

-%token VAR ASSIGN

+%token VAR FUNCTION ASSIGN

+%token LPAREN RPAREN COMMA COLON

%token EOF

// あとで使う

@@ -48,9 +49,24 @@ exp:

| exp GT exp { Syntax.OpExp($1, Syntax.GtOp, $3) }

| exp GE exp { Syntax.OpExp($1, Syntax.GeOp, $3) }

| LET decs IN exp END { Syntax.LetExp($2, $4) }

+| ID LPAREN args RPAREN { Syntax.CallExp($1, $3) }

+

+args:

+ { [] } // 空の場合

+

+tyfield:

+ ID COLON ID { Syntax.Field($1, $3) }

+

+tyfields:

+ { [] } // 空の場合

dec:

VAR ID ASSIGN exp { Syntax.VarDec($2, $4) }

+| FUNCTION ID LPAREN tyfields RPAREN EQ exp { Syntax.FunctionDec($2, $4, $7) }

decs:

{ [] } // 空の場合

diff --git a/lib/syntax.ml b/lib/syntax.ml

index 88af7c1..c91c6e5 100644

--- a/lib/syntax.ml

+++ b/lib/syntax.ml

@@ -1,15 +1,5 @@

type symbol = string

-type t =

- | IntExp of int (* 整数 *)

- | StringExp of string (* 文字列 *)

- | LetExp of dec_t list * t

- | VarExp of string

- | OpExp of t * op_t * t (* 二項演算子 *)

-

-and dec_t =

- | VarDec of symbol * t (* 変数宣言 *)

-

and op_t =

| PlusOp

| MinusOp

@@ -22,3 +12,17 @@ and op_t =

| GtOp

| GeOp

+ and t =

+ | IntExp of int (* 整数 *)

+ | StringExp of string (* 文字列 *)

+ | LetExp of dec_t list * t

+ | VarExp of string

+ | CallExp of string * t list (* 関数呼び出し *)

+ | OpExp of t * op_t * t (* 二項演算子 *)

+

+and dec_t =

+ | VarDec of symbol * t (* 変数宣言 *)

+ | FunctionDec of symbol * field_t list * t (* 関数宣言 *)

+

+(* 関数の引数 *)

+and field_t = Field of symbol * symbol

diff --git a/test/tiger_test.expected b/test/tiger_test.expected

index 1468dd9..9c6d8c4 100644

--- a/test/tiger_test.expected

+++ b/test/tiger_test.expected

@@ -23,3 +23,5 @@ result: 1

result: 4649

result: 30

result: 99

+result: 5678

+result: 100

diff --git a/test/tiger_test.ml b/test/tiger_test.ml

index 56ef358..8800e2b 100644

--- a/test/tiger_test.ml

+++ b/test/tiger_test.ml

@@ -183,3 +183,31 @@ let () =

in print_string "result: ";

Tiger.Eval.print_val (eval src);

print_newline ()

+

+(* 引数なしの関数の呼び出し *)

+let () =

+ let src = {|

+ let

+ function foo() = 5678

+ in

+ foo ()

+ end

+ |}

+ in

+ print_string "result: ";

+ Tiger.Eval.print_val (eval src);

+ print_newline ()

+

+(* 引数ありの関数の呼び出し *)

+let () =

+ let src = {|

+ let

+ function square(n:int) = n * n

+ in

+ square(10)

+ end

+ |}

+ in

+ print_string "result: ";

+ Tiger.Eval.print_val (eval src);

+ print_newline ()

登場人物

CallExp(id, args:exp list)

FunctionDec