Tigerインタプリタで変数を宣言・参照できるようにしたい

https://gyazo.com/2ae940516cccf9af5a760be03523a8d9

code:diff

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

index 6da3359..147fa59 100644

--- a/bin/main.ml

+++ b/bin/main.ml

@@ -2,7 +2,7 @@

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

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

print_string "Result: ";

Tiger.Eval.print_val result;

print_newline ()

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

index 917e420..e5ae530 100644

--- a/lib/eval.ml

+++ b/lib/eval.ml

@@ -1,47 +1,44 @@

type val_t = IntVal of int | StringVal of string

+type id = string

+type table = (id * val_t) list

-let compare op v1 v2 =

- match (v1, v2) with

- | IntVal n1, IntVal n2 -> (

- match op with

- | Syntax.EqOp -> IntVal (if n1 = n2 then 1 else 0)

- | Syntax.NeqOp -> IntVal (if n1 <> n2 then 1 else 0)

- | Syntax.LtOp -> IntVal (if n1 < n2 then 1 else 0)

- | Syntax.GtOp -> IntVal (if n1 > n2 then 1 else 0)

- | Syntax.LeOp -> IntVal (if n1 <= n2 then 1 else 0)

- | Syntax.GeOp -> IntVal (if n1 >= n2 then 1 else 0)

- | _ -> failwith "invalid value")

- | StringVal s1, StringVal s2 -> (

- match op with

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

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

- | Syntax.LtOp -> IntVal (if s1 < s2 then 1 else 0)

- | Syntax.GtOp -> IntVal (if s1 > s2 then 1 else 0)

- | Syntax.LeOp -> IntVal (if s1 <= s2 then 1 else 0)

- | Syntax.GeOp -> IntVal (if s1 >= s2 then 1 else 0)

- | _ -> failwith "invalid value")

- | _ -> failwith "invalid value"

-

-let rec f expr =

+let rec f expr env: val_t * table =

match expr with

- | Syntax.IntExp n -> IntVal n

- | Syntax.StringExp s -> StringVal s

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

- let getInt intVal =

- match intVal with

- | IntVal n -> n

- | _ -> failwith "integer value expected"

- in

+ | Syntax.IntExp n -> (IntVal n, env)

+ | Syntax.StringExp s -> (StringVal s, env)

+ | Syntax.IdExp s -> (List.assoc s env, env)

+ | Syntax.LetExp (VarDec(id, e1), e2) ->

+ let (v1, _) = f e1 env in

+ let new_env: table = (id, v1) :: env in

+ f e2 new_env

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

match op with

- | Syntax.PlusOp -> IntVal (getInt (f e1) + getInt (f e2))

- | Syntax.MinusOp -> IntVal (getInt (f e1) - getInt (f e2))

- | Syntax.TimesOp -> IntVal (getInt (f e1) * getInt (f e2))

- | Syntax.DivideOp -> IntVal (getInt (f e1) / getInt (f e2))

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

- | Syntax.GeOp ->

- compare op (f e1) (f e2))

-

-let string_of_val v =

+ | 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

+ match op, v1, v2 with

+ | Syntax.PlusOp, IntVal v1, IntVal v2 -> IntVal(v1 + v2), env

+ | Syntax.MinusOp, IntVal v1, IntVal v2 -> IntVal(v1 - v2), 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 =

+ let v1, env = f e1 env in

+ let v2, env = f e2 env in

+ match op, v1, v2 with

+ | Syntax.EqOp, IntVal v1, IntVal v2 -> if v1 = v2 then IntVal(1), env else IntVal(0), env

+ | Syntax.NeqOp, IntVal v1, IntVal v2 -> if v1 <> v2 then IntVal(1), env else IntVal(0), env

+ | Syntax.LtOp, IntVal v1, IntVal v2 -> if v1 < v2 then IntVal(1), env else IntVal(0), env

+ | Syntax.GtOp, IntVal v1, IntVal v2 -> if v1 > v2 then IntVal(1), env else IntVal(0), env

+ | Syntax.LeOp, IntVal v1, IntVal v2 -> if v1 <= v2 then IntVal(1), env else IntVal(0), env

+ | Syntax.GeOp, IntVal v1, IntVal v2 -> if v1 >= v2 then IntVal(1), env else IntVal(0), 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 string_of_val v =

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

-

-let print_val v = print_string (string_of_val v)

+and print_val v = print_string (string_of_val v)

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

index 22a488b..cac6880 100644

--- a/lib/lexer.mll

+++ b/lib/lexer.mll

@@ -14,7 +14,10 @@ let printable = symbol | letter | digit

(* 字句解析の規則 *)

rule token = parse

space+ { token lexbuf } (* 空白は読み飛ばす *)

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

+ | "let" { Parser.LET }

+ | "in" { Parser.IN }

+ | "end" { Parser.END }

+ | "var" { Parser.VAR }

| "+" { Parser.PLUS }

| "-" { Parser.MINUS }

| "*" { Parser.TIMES }

@@ -25,11 +28,13 @@ rule token = parse

| "<=" { Parser.LE }

| ">" { Parser.GT }

| ">=" { Parser.GE }

- | eof { Parser.EOF }

- (* 文字列リテラル *)

+ | ":=" { Parser.ASSIGN }

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

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

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

- (* 両端のダブルクォートを取り除く *)

+ (* 文字列リテラル *)

let str = String.sub (Lexing.lexeme lexbuf) 1 ((String.length (Lexing.lexeme lexbuf)) - 2) in

Parser.STRING(str)

}

+ | eof { Parser.EOF }

| _ { failwith ("invalid character " ^ (Lexing.lexeme lexbuf)) }

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

index e55e490..8face5f 100644

--- a/lib/parser.mly

+++ b/lib/parser.mly

@@ -5,18 +5,20 @@

%token EOF

%token <int> INT

%token <string> STRING

+%token <string> ID

%token PLUS MINUS TIMES DIVIDE

%token EQ NEQ LT LE GT GE

+%token LET IN END

+%token VAR ASSIGN

%token EOF

// あとで使う

-// %token <string> ID

// %token COMMA COLON SEMICOLON LPAREN RPAREN LBRACK RBRACK

// %token LBRACE RBRACE DOT

-// %token AND OR ASSIGN

-// %token ARRAY IF THEN ELSE WHILE FOR TO DO LET IN END OF

+// %token AND OR

+// %token ARRAY IF THEN ELSE WHILE FOR TO DO OF

// %token BREAK NIL

-// %token FUNCTION VAR TYPE

+// %token FUNCTION TYPE

// エントリーボイントの定義

%start program

@@ -34,6 +36,7 @@ program: exp EOF { $1 }

exp:

INT { Syntax.IntExp($1) }

| STRING { Syntax.StringExp($1) }

+| ID { Syntax.IdExp($1) }

| exp PLUS exp { Syntax.OpExp($1, Syntax.PlusOp, $3) }

| exp MINUS exp { Syntax.OpExp($1, Syntax.MinusOp, $3) }

| exp TIMES exp { Syntax.OpExp($1, Syntax.TimesOp, $3) }

@@ -44,3 +47,7 @@ exp:

| exp LE exp { Syntax.OpExp($1, Syntax.LeOp, $3) }

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

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

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

+

+dec:

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

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

index 5eef2fb..07444a8 100644

--- a/lib/syntax.ml

+++ b/lib/syntax.ml

@@ -1,4 +1,16 @@

-type op_t =

+type symbol = string

+

+type t =

+ | IntExp of int (* 整数 *)

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

+ | LetExp of dec_t * t

+ | IdExp of string

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

+

+and dec_t =

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

+

+and op_t =

| PlusOp

| MinusOp

| TimesOp

@@ -10,7 +22,3 @@ type op_t =

| GtOp

| GeOp

-type t =

- | IntExp of int (* 整数 *)

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

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

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

index a91ea47..9b29e41 100644

--- a/test/tiger_test.expected

+++ b/test/tiger_test.expected

@@ -20,3 +20,5 @@ result: 0

result: 1

result: 0

result: 1

+result: 4649

+result: 200

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

index 9aad24e..a67abe7 100644

--- a/test/tiger_test.ml

+++ b/test/tiger_test.ml

@@ -1,7 +1,11 @@

-let eval src =

+let eval_with_env src env =

let buff = Lexing.from_string src in

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

- Tiger.Eval.f expr

+ let result, _ = Tiger.Eval.f expr env in

+ result

+

+let eval src =

+ eval_with_env src []

(* 整数リテラル *)

let () =

@@ -146,3 +150,17 @@ let () =

print_string "result: ";

Tiger.Eval.print_val (eval src);

print_newline ()

+

+(* 変数の参照 *)

+let () =

+ let src = "foo" in

+ print_string "result: ";

+ print_newline ()

+

+(* let による変数宣言 *)

+let () =

+ let src = "let var foo := 100 in foo + foo end" in

+ print_string "result: ";

+ Tiger.Eval.print_val (eval src);

+ print_newline ()

code:ml