Complete 1.04.p: add semantic actions to parser

FIXME: 2 more shift/reduce conflicts were introduced
       with the rules for consecutive function and type declarations

diff --git a/README.md b/README.md
index 4a57bc6..616f735 100644 (file)
--- a/README.md
+++ b/README.md
@@ -42,9 +42,9 @@ Project Plan
 | [x]    | 1.02.e.09  | ---- generate lexer tables from spec     | ---   | --       | --     | ---------- | ---------- |
 | [x]    | 1.02.e.10  | ---- design better lookahead than Aho    | ---   | --       | --     | ---------- | ---------- |
 | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- |
-| [x]    | 1.03       | -- Parsing                               | 049   | 02       | 04     | 2018-05-25 | 2018-05-29 |
+| [x]    | 1.03       | -- Parsing                               | 049   | 02       | 05     | 2018-05-25 | 2018-05-31 |
 | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- |
-| [ ]    | 1.04       | -- Abstract Syntax                       | 016   | 01       | --     | ---------- | ---------- |
+| [x]    | 1.04       | -- Abstract Syntax                       | 016   | 01       | 01     | 2018-05-30 | 2018-05-30 |
 | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- |
 | [ ]    | 1.05       | -- Semantic Analysis                     | 021   | 01       | --     | ---------- | ---------- |
 | ------ | ---------- | ---------------------------------------- | ----- | -------- | ------ | ---------- | ---------- |

diff --git a/tiger/src/exe/tiger_tests.ml b/tiger/src/exe/tiger_tests.ml
index ebdec23..d9eb050 100644 (file)
--- a/tiger/src/exe/tiger_tests.ml
+++ b/tiger/src/exe/tiger_tests.ml
@@ -313,8 +313,8 @@ let () =
         let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
         let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
         Error msg
-    | parsetree ->
-        Ok parsetree
+    | absyn ->
+        Ok (Tiger.Absyn.to_string absyn)
     )
   in
   let bar_sep = String.make 80 '-' in

diff --git a/tiger/src/exe/tigerc.ml b/tiger/src/exe/tigerc.ml
index fd58a83..708ff17 100644 (file)
--- a/tiger/src/exe/tigerc.ml
+++ b/tiger/src/exe/tigerc.ml
@@ -10,7 +10,7 @@ let () =
       Printf.printf
         "Syntax error in file %S, around line: %d, column: %d\n"
         path_to_program_file pos_lnum (pos_cnum - pos_bol)
-  | program ->
-      print_endline program
+  | absyn ->
+      print_endline (Tiger.Absyn.to_string absyn)
   );
   close_in ic;

diff --git a/tiger/src/lib/tiger/tiger.ml b/tiger/src/lib/tiger/tiger.ml
index 577e25d..1ae01c1 100644 (file)
--- a/tiger/src/lib/tiger/tiger.ml
+++ b/tiger/src/lib/tiger/tiger.ml
@@ -1,3 +1,4 @@
+module Absyn  = Tiger_absyn
 module Lexer  = Tiger_lexer
 module Parser = Tiger_parser
 module Parser_token = Tiger_parser_token

diff --git a/tiger/src/lib/tiger/tiger_absyn.ml b/tiger/src/lib/tiger/tiger_absyn.ml
new file mode 100644 (file)
index 0000000..0161a4b
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_absyn.ml
@@ -0,0 +1,144 @@
+type pos = Tiger_position.t
+
+type symbol = Tiger_symbol.t
+
+type oper =
+  | PlusOp
+  | MinusOp
+  | TimesOp
+  | DivideOp
+  | EqOp
+  | NeqOp
+  | LtOp
+  | LeOp
+  | GtOp
+  | GeOp
+
+type exp =
+  | VarExp of
+      var
+  | NilExp
+  | IntExp of
+      int
+  | StringExp of
+      { string : string
+      ; pos    : pos
+      }
+  | CallExp of
+      { func : symbol
+      ; args : exp list
+      ; pos  : pos
+      }
+  | OpExp of
+      { left  : exp
+      ; oper  : oper
+      ; right : exp
+      ; pos   : pos
+      }
+  | RecordExp of
+      { fields : (symbol * exp * pos) list
+      ; typ    : symbol
+      ; pos    : pos
+      }
+  | SeqExp of
+      (exp * pos) list
+  | AssignExp of
+      { var : var
+      ; exp : exp
+      ; pos : pos
+      }
+  | IfExp of
+      { test  : exp
+      ; then' : exp
+      ; else' : exp option
+      ; pos   : pos
+      }
+  | WhileExp of
+      { test : exp
+      ; body : exp
+      ; pos  : pos
+      }
+  | ForExp of
+      { var    : symbol
+      ; escape : bool ref  (* Whoa - why a mutable cell in AST? *)
+      ; lo     : exp
+      ; hi     : exp
+      ; body   : exp
+      ; pos    : pos
+      }
+  | BreakExp of
+      pos
+  | LetExp of
+      { decs : dec list
+      ; body : exp
+      ; pos  : pos
+      }
+  | ArrayExp of
+      { typ  : symbol
+      ; size : exp
+      ; init : exp
+      ; pos  : pos
+      }
+and var =
+  | SimpleVar of
+      { symbol : symbol
+      ; pos    : pos
+      }
+  | FieldVar of
+      { var    : var
+      ; symbol : symbol
+      ; pos    : pos
+      }
+  | SubscriptVar of
+      { var : var
+      ; exp : exp
+      ; pos : pos
+      }
+and dec =
+  | FunDecs of  (* "FunctionDec" in Appel's code *)
+      fundec list
+  | VarDec of
+      { name   : symbol
+      ; escape : bool ref  (* Again, why mutable? *)
+      ; typ    : (symbol * pos) option
+      ; init   : exp
+      ; pos    : pos
+      }
+  | TypeDecs of  (* "TypeDec" in Appel's code *)
+      typedec list
+and ty =
+  | NameTy of
+      { symbol : symbol
+      ; pos    : pos
+      }
+  | RecordTy of
+      field list
+  | ArrayTy of
+      { symbol : symbol
+      ; pos    : pos
+      }
+and field =
+  | Field of
+    { name   : symbol
+    ; escape : bool ref
+    ; typ    : symbol
+    ; pos    : pos
+    }
+and typedec =
+  | TypeDec of  (* An anonymous record in Appel's code *)
+      { name : symbol
+      ; ty   : ty
+      ; pos  : pos
+      }
+and fundec =
+  | FunDec of
+    { name   : symbol
+    ; params : field list
+    ; result : (symbol * pos) option
+    ; body   : exp
+    ; pos    : pos
+    }
+
+type t = exp
+
+let to_string _ = "TODO: implement Tiger_absyn.to_string"

diff --git a/tiger/src/lib/tiger/tiger_absyn.mli b/tiger/src/lib/tiger/tiger_absyn.mli
new file mode 100644 (file)
index 0000000..12dc6a8
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_absyn.mli
@@ -0,0 +1,144 @@
+type pos = Tiger_position.t
+
+type symbol = Tiger_symbol.t
+
+type oper =
+  | PlusOp
+  | MinusOp
+  | TimesOp
+  | DivideOp
+  | EqOp
+  | NeqOp
+  | LtOp
+  | LeOp
+  | GtOp
+  | GeOp
+
+type exp =
+  | VarExp of
+      var
+  | NilExp
+  | IntExp of
+      int
+  | StringExp of
+      { string : string
+      ; pos    : pos
+      }
+  | CallExp of
+      { func : symbol
+      ; args : exp list
+      ; pos  : pos
+      }
+  | OpExp of
+      { left  : exp
+      ; oper  : oper
+      ; right : exp
+      ; pos   : pos
+      }
+  | RecordExp of
+      { fields : (symbol * exp * pos) list
+      ; typ    : symbol
+      ; pos    : pos
+      }
+  | SeqExp of
+      (exp * pos) list
+  | AssignExp of
+      { var : var
+      ; exp : exp
+      ; pos : pos
+      }
+  | IfExp of
+      { test  : exp
+      ; then' : exp
+      ; else' : exp option
+      ; pos   : pos
+      }
+  | WhileExp of
+      { test : exp
+      ; body : exp
+      ; pos  : pos
+      }
+  | ForExp of
+      { var    : symbol
+      ; escape : bool ref  (* Whoa - why a mutable cell in AST? *)
+      ; lo     : exp
+      ; hi     : exp
+      ; body   : exp
+      ; pos    : pos
+      }
+  | BreakExp of
+      pos
+  | LetExp of
+      { decs : dec list
+      ; body : exp
+      ; pos  : pos
+      }
+  | ArrayExp of
+      { typ  : symbol
+      ; size : exp
+      ; init : exp
+      ; pos  : pos
+      }
+and var =
+  | SimpleVar of
+      { symbol : symbol
+      ; pos    : pos
+      }
+  | FieldVar of
+      { var    : var
+      ; symbol : symbol
+      ; pos    : pos
+      }
+  | SubscriptVar of
+      { var : var
+      ; exp : exp
+      ; pos : pos
+      }
+and dec =
+  | FunDecs of  (* "FunctionDec" in Appel's code *)
+      fundec list
+  | VarDec of
+      { name   : symbol
+      ; escape : bool ref  (* Again, why mutable? *)
+      ; typ    : (symbol * pos) option
+      ; init   : exp
+      ; pos    : pos
+      }
+  | TypeDecs of  (* "TypeDec" in Appel's code *)
+      typedec list
+and ty =
+  | NameTy of
+      { symbol : symbol
+      ; pos    : pos
+      }
+  | RecordTy of
+      field list
+  | ArrayTy of
+      { symbol : symbol
+      ; pos    : pos
+      }
+and field =
+  | Field of
+    { name   : symbol
+    ; escape : bool ref
+    ; typ    : symbol
+    ; pos    : pos
+    }
+and typedec =
+  | TypeDec of  (* An anonymous record in Appel's code *)
+      { name : symbol
+      ; ty   : ty
+      ; pos  : pos
+      }
+and fundec =
+  | FunDec of
+    { name   : symbol
+    ; params : field list
+    ; result : (symbol * pos) option
+    ; body   : exp
+    ; pos    : pos
+    }
+
+type t = exp
+
+val to_string : t -> string

diff --git a/tiger/src/lib/tiger/tiger_parser.mly b/tiger/src/lib/tiger/tiger_parser.mly
index 1bc0ae7..aa0178a 100644 (file)
--- a/tiger/src/lib/tiger/tiger_parser.mly
+++ b/tiger/src/lib/tiger/tiger_parser.mly
@@ -1,5 +1,11 @@
 %{
-  open Printf
+  module Ast = Tiger_absyn
+  module Sym = Tiger_symbol
+
+  let pos () =
+    Tiger_position.of_lexing_positions
+      ~pos_start:(Parsing.symbol_start_pos ())
+      ~pos_end:(Parsing.symbol_end_pos ())
 %}
 
 /* Declarations */
@@ -49,340 +55,412 @@
 %token WHILE
 
 /* from lowest precedence */
-%left THEN
-%left ELSE
+%nonassoc LOWEST
+%nonassoc THEN
+%nonassoc ELSE
 %nonassoc ASSIGN
-%left OF DO
+%nonassoc OF DO
 %left OR
 %left AND
 %nonassoc EQ NEQ GT LT GE LE
 %left PLUS MINUS
 %left TIMES DIVIDE
-%nonassoc UMINUS
+%nonassoc HIGHEST
 /* to highest precedence */
 
-%type <string> program
+%type <Tiger_absyn.t> program
 
 %start program
 
 %%
 
-program:
-  | exp EOF
-    {
-      sprintf "program[%s]" $1
-    }
-  ;
+program: exp EOF { $1 };
 
 exp:
   | NIL
-    {
-      "nil[]"
-    }
+    { Ast.NilExp }
   | INT
-    {
-      sprintf "int[%d]" $1
-    }
-  | MINUS exp %prec UMINUS
-    {
-      sprintf "negation[%s]" $2
-    }
-  | ID LBRACK exp RBRACK OF exp
+    { Ast.IntExp $1 }
+  | MINUS exp %prec HIGHEST
+    {
+      Ast.OpExp
+        { left  = Ast.IntExp 0
+        ; oper  = Ast.MinusOp
+        ; right = $2
+        ; pos   = pos ()
+        }
+    }
+  | lvalue LBRACK exp RBRACK OF exp
+    {
+      match $1 with
+      | Ast.SimpleVar {symbol=typ; _} ->
+          Ast.ArrayExp
+            { typ
+            ; size = $3
+            ; init = $6
+            ; pos  = pos ()
+            }
+      | Ast.SubscriptVar _ | Ast.FieldVar _ ->
+          raise Parse_error
+    }
+  | ID LBRACE rec_fields_bind RBRACE
     {
       let type_id = $1 in
-      let number_of_elements = $3 in
-      let initial_value = $6 in
-      sprintf
-        "array[type[%s], size[%s], val[%s]]"
-        type_id number_of_elements initial_value
-    }
-  | ID LBRACE rec_field_assignments RBRACE
-    {
-      let type_id = $1 in
-      let rec_field_assignments = $3 in
-      sprintf
-        "record[type[%s], rec_field_assignments[%s]]"
-        type_id rec_field_assignments
+      let fields  = $3 in
+      let typ     = Sym.of_string type_id in
+      let pos     = pos () in
+      Ast.RecordExp {fields; typ; pos}
     }
   | lvalue
-    {
-      $1
-    }
+    { Ast.VarExp $1 }
   | lvalue ASSIGN exp
     {
-      sprintf "assign[%s := %s]" $1 $3
+      let var = $1 in
+      let exp = $3 in
+      let pos = pos () in
+      Ast.AssignExp {var; exp; pos}
     }
   | STRING
-    {
-      sprintf "string[%S]" $1
-    }
-  | ID LPAREN RPAREN
-    {
-      let id = $1 in
-      sprintf "fun_call[%s, []]" id
-    }
+    { Ast.StringExp {string = $1; pos = pos ()} }
   | ID LPAREN fun_args RPAREN
     {
-      let id = $1 in
-      let fun_args = $3 in
-      sprintf "fun_call[%s, %s]" id fun_args
+      Ast.CallExp
+        { func = Sym.of_string $1
+        ; args = $3
+        ; pos  = pos ()
+        }
     }
   | exp PLUS exp
     {
-      sprintf "op_plus[%s + %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.PlusOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp MINUS exp
     {
-      sprintf "op_minus[%s - %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.MinusOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp TIMES exp
     {
-      sprintf "op_times[%s * %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.TimesOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp DIVIDE exp
     {
-      sprintf "op_divide[%s / %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.DivideOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp EQ exp
     {
-      sprintf "op_eq[%s = %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.EqOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp NEQ exp
     {
-      sprintf "op_neq[%s <> %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.NeqOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp GT exp
     {
-      sprintf "op_gt[%s > %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.GtOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp LT exp
     {
-      sprintf "op_lt[%s < %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.LtOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp GE exp
     {
-      sprintf "op_ge[%s >= %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.GeOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp LE exp
     {
-      sprintf "op_le[%s <= %s]" $1 $3
+      Ast.OpExp
+        { left  = $1
+        ; oper  = Ast.LeOp
+        ; right = $3
+        ; pos   = pos ()
+        }
     }
   | exp AND exp
     {
-      sprintf "op_and[%s & %s]" $1 $3
+      let e1 = $1 in
+      let e2 = $3 in
+      Ast.IfExp
+        { test  = e1
+        ; then' = e2
+        ; else' = Some (Ast.IntExp 0)
+        ; pos   = pos ()
+        }
     }
   | exp OR exp
     {
-      sprintf "op_or[%s | %s]" $1 $3
+      let e1 = $1 in
+      let e2 = $3 in
+      Ast.IfExp
+        { test  = e1
+        ; then' = Ast.IntExp 1
+        ; else' = Some e2
+        ; pos   = pos ()
+        }
     }
   | IF exp THEN exp ELSE exp
     {
       let e1 = $2 in
       let e2 = $4 in
       let e3 = $6 in
-      sprintf "if_then_else[%s, then[%s], else[%s]]" e1 e2 e3
+      Ast.IfExp
+        { test  = e1
+        ; then' = e2
+        ; else' = Some e3
+        ; pos   = pos ()
+        }
     }
   | IF exp THEN exp
     {
-      sprintf "if_then[%s, then[%s]]" $2 $4
+      let e1 = $2 in
+      let e2 = $4 in
+      Ast.IfExp
+        { test  = e1
+        ; then' = e2
+        ; else' = None
+        ; pos   = pos ()
+        }
     }
   | WHILE exp DO exp
     {
-      sprintf "while[%s, do[%s]]" $2 $4
+      let e1 = $2 in
+      let e2 = $4 in
+      Ast.WhileExp
+        { test = e1
+        ; body = e2
+        ; pos  = pos ()
+        }
     }
   | FOR ID ASSIGN exp TO exp DO exp
     {
-      let id = $2 in
-      let e1 = $4 in
-      let e2 = $6 in
-      let e3 = $8 in
-      sprintf "for[%s := %s, to[%s], do[%s]]" id e1 e2 e3
+      let var = $2 in
+      let e1  = $4 in
+      let e2  = $6 in
+      let e3  = $8 in
+      Ast.ForExp
+        { var    = Sym.of_string var
+        ; escape = ref true
+        ; lo     = e1
+        ; hi     = e2
+        ; body   = e3
+        ; pos    = pos ()
+        }
     }
   | BREAK
-    {
-      "break[]"
-    }
+    { Ast.BreakExp (pos ()) }
   | LPAREN exps RPAREN
-    {
-      sprintf "exps[%s]" $2
-    }
+    { Ast.SeqExp $2 }
   | LET decs IN exps END
     {
       let decs = $2 in
       let exps = $4 in
-      sprintf "let[decs[%s], in[exps[%s]]]" decs exps
-    }
-  | LPAREN RPAREN
-    {
-      (* Perhaps "void"? *)
-      "unit[]"
+      Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()}
     }
   ;
 
-rec_field_assignments:
-  | ID EQ exp
-    {
-      let id = $1 in
-      let exp = $3 in
-      sprintf "%S = %s" id exp
-    }
-  | ID EQ exp COMMA rec_field_assignments
-    {
-      let id = $1 in
-      let exp = $3 in
-      let rec_field_assignments = $5 in
-      sprintf "%S = %s, %s" id exp rec_field_assignments
-    }
+exps:
+  |                    {                 [] }
+  | exp                { ($1, pos ()) :: [] }
+  | exp SEMICOLON exps { ($1, pos ()) :: $3 }
   ;
 
-exps:
-  | exp
-    {
-      let exp = $1 in
-      sprintf "%s" exp
-    }
-  | exp SEMICOLON exps
-    {
-      let exp = $1 in
-      let exps = $3 in
-      sprintf "%s; %s" exp exps
-    }
+rec_fields_bind:
+  | ID EQ exp                       { (Sym.of_string $1, $3, pos ()) :: [] }
+  | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 }
   ;
 
 decs:
-  | dec
-    {
-      sprintf "%s" $1
-    }
-  | dec decs
-    {
-      sprintf "%s %s" $1 $2
-    }
+  | dec      { $1 :: [] }
+  | dec decs { $1 :: $2 }
   ;
 
 dec:
-  /* Tydec */
+  | var_dec                { $1 }
+  | typ_decs  %prec LOWEST { Ast.TypeDecs $1 }
+  | fun_decs  %prec LOWEST { Ast.FunDecs $1 }
+  ;
+
+typ_decs:
+  | typ_dec                        { $1 :: [] }
+  | typ_dec typ_decs %prec LOWEST  { $1 :: $2 }
+  ;
+
+typ_dec:
   | TYPE ID EQ ID
     {
-      let type_id_new = $2 in
-      let type_id_orig = $4 in
-      sprintf "tydec_alias[from[%s], to[%s]]" type_id_new type_id_orig
+      let type_id_left = $2 in
+      let type_id_right = $4 in
+      let pos = pos () in  (* FIXME: rhs id should have its own pos, no? *)
+      Ast.TypeDec
+        { name = Sym.of_string type_id_left
+        ; ty   = Ast.NameTy {symbol = Sym.of_string type_id_right; pos}
+        ; pos
+        }
     }
-  | TYPE ID EQ LBRACE RBRACE
+  | TYPE ID EQ LBRACE type_fields RBRACE
     {
       let type_id = $2 in
-      sprintf "tydec_empty_record[%s]" type_id
-    }
-  | TYPE ID EQ LBRACE tyfields RBRACE
-    {
-      let type_id = $2 in
-      let tyfields = $5 in
-      sprintf "tydec_record[%s, fields[%s]]" type_id tyfields
+      let type_fields = $5 in
+      Ast.TypeDec
+        { name = Sym.of_string type_id
+        ; ty   = Ast.RecordTy type_fields
+        ; pos  = pos ()
+        }
     }
   | TYPE ID EQ ARRAY OF ID
     {
-      let type_id = $2 in
-      let element_type_id = $6 in
-      sprintf "tydec_array[%s, elements_of_type[%s]]" type_id element_type_id
+      let type_id         = Sym.of_string $2 in
+      let element_type_id = Sym.of_string $6 in
+      let pos = pos () in
+      Ast.TypeDec
+        { name = type_id
+        ; ty   = Ast.ArrayTy {symbol = element_type_id; pos}
+        ; pos
+        }
     }
+  ;
 
-  /* Vardec */
-  | VAR ID ASSIGN exp
-    {
-      let id = $2 in
-      let exp = $4 in
-      sprintf "vardec[%s, exp[%s]]" id exp
-    }
-  | VAR ID COLON ID ASSIGN exp
-    {
-      let id = $2 in
-      let type_id = $4 in
-      let exp = $6 in
-      sprintf "vardec[%s, type_id[%s], exp[%s]]" id type_id exp
+var_dec:
+  | VAR ID maybe_type_sig ASSIGN exp
+    {
+      let var_id = Sym.of_string $2 in
+      let maybe_type_sig = $3 in
+      let exp = $5 in
+      let pos = pos () in
+      Ast.VarDec
+        { name   = var_id
+        ; escape = ref true
+        ; typ    = maybe_type_sig
+        ; init   = exp
+        ; pos
+        }
     }
+  ;
 
-  /* Fundec */
-  | FUNCTION ID LPAREN RPAREN EQ exp
-    {
-      let id       = $2 in
-      let exp      = $6 in
-      sprintf "fundec[%s, arguments[], exp[%s]]" id exp
-    }
-  | FUNCTION ID LPAREN tyfields RPAREN EQ exp
-    {
-      let id       = $2 in
-      let tyfields = $4 in
-      let exp      = $7 in
-      sprintf "fundec[%s, arguments[%s], exp[%s]]" id tyfields exp
-    }
-  | FUNCTION ID LPAREN tyfields RPAREN COLON ID EQ exp
+fun_decs:
+  | fun_dec                       { $1 :: [] }
+  | fun_dec fun_decs %prec LOWEST { $1 :: $2 }
+  ;
+
+fun_dec:
+  | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp
     {
-      let id       = $2 in
-      let tyfields = $4 in
-      let type_id  = $7 in
-      let exp      = $9 in
-      sprintf
-        "fundec[%s, tyfields[%s], type_id[%s], exp[%s]]"
-        id tyfields type_id exp
+      let name   = Sym.of_string $2 in
+      let params = $4 in
+      let result = $6 in
+      let body   = $8 in
+      let pos    = pos () in
+      Ast.FunDec {name; params; result; body; pos}
     }
   ;
 
-tyfields:
+maybe_type_sig:
+  |          { None }
+  | COLON ID { Some (Sym.of_string $2, pos ()) }
+  ;
+
+type_fields:
+  |
+    { [] }
   | ID COLON ID
     {
-      let id_1 = $1 in
-      let id_2 = $3 in
-      sprintf "%s : %s" id_1 id_2
-    }
-  | ID COLON ID COMMA tyfields
-    {
-      let id_1 = $1 in
-      let id_2 = $3 in
-      let tyfield = sprintf "%s : %s" id_1 id_2 in
-      let tyfields = $5 in
-      sprintf "%s, %s" tyfield tyfields
+      let field =
+        Ast.Field
+          { name   = Sym.of_string $1
+          ; escape = ref true
+          ; typ    = Sym.of_string $3
+          ; pos    = pos ()
+          }
+      in
+      field :: []
+    }
+  | ID COLON ID COMMA type_fields
+    {
+      let field =
+        Ast.Field
+          { name   = Sym.of_string $1
+          ; escape = ref true
+          ; typ    = Sym.of_string $3
+          ; pos    = pos ()
+          }
+      in
+      field :: $5
     }
   ;
 
 fun_args:
-  | exp
-    {
-      $1
-    }
-  | exp COMMA fun_args
-    {
-      sprintf "%s, %s" $1 $3
-    }
+  |                    {       [] }
+  | exp                { $1 :: [] }
+  | exp COMMA fun_args { $1 :: $3 }
   ;
 
 lvalue:
-  | ID lvalue_part
+  | ID
     {
-      let id = $1 in
-      let part = $2 in
-      sprintf "lvalue[%s, part[%s]]" id part
+      Ast.SimpleVar
+        { symbol = Sym.of_string $1
+        ; pos    = pos ()
+        }
     }
-  ;
-
-lvalue_part:
-  | {"epsilon[]"}
-  | lvalue_subscript {$1}
-  | lvalue_field_access {$1}
-  ;
-
-lvalue_subscript:
-  | LBRACK exp RBRACK
+  | lvalue LBRACK exp RBRACK
     {
-      let exp = $2 in
-      sprintf "subscript[%s]" exp
+      Ast.SubscriptVar
+        { var = $1
+        ; exp = $3
+        ; pos = pos ()
+        }
     }
-  ;
-
-lvalue_field_access:
-  | DOT ID
+  | lvalue DOT ID
     {
-      let field = $2 in
-      sprintf "field_access[%s]" field
+      Ast.FieldVar
+        { var    = $1
+        ; symbol = Sym.of_string $3
+        ; pos    = pos ()
+        }
     }
   ;
 

diff --git a/tiger/src/lib/tiger/tiger_position.ml b/tiger/src/lib/tiger/tiger_position.ml
new file mode 100644 (file)
index 0000000..01c230c
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_position.ml
@@ -0,0 +1,21 @@
+type t =
+  { file       : string
+  ; start_char : int
+  ; start_line : int
+  ; end_char   : int
+  ; end_line   : int
+  }
+
+let of_lexing_positions
+  ~pos_start:
+    Lexing.({pos_fname=sfile; pos_lnum=sline; pos_bol=sbol; pos_cnum=scnum})
+  ~pos_end:
+    Lexing.({pos_fname=efile; pos_lnum=eline; pos_bol=ebol; pos_cnum=ecnum})
+  =
+    assert (sfile = efile);
+    { file       = sfile
+    ; start_char = scnum - sbol
+    ; start_line = sline
+    ; end_char   = ecnum - ebol
+    ; end_line   = eline
+    }

diff --git a/tiger/src/lib/tiger/tiger_position.mli b/tiger/src/lib/tiger/tiger_position.mli
new file mode 100644 (file)
index 0000000..dab4067
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_position.mli
@@ -0,0 +1,12 @@
+type t =
+  { file       : string
+  ; start_char : int
+  ; start_line : int
+  ; end_char   : int
+  ; end_line   : int
+  }
+
+val of_lexing_positions
+  :  pos_start:Lexing.position
+  -> pos_end:Lexing.position
+  -> t

diff --git a/tiger/src/lib/tiger/tiger_symbol.ml b/tiger/src/lib/tiger/tiger_symbol.ml
new file mode 100644 (file)
index 0000000..eb32942
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_symbol.ml
@@ -0,0 +1,23 @@
+module H = MoreLabels.Hashtbl
+
+type t =
+  { name   : string
+  ; symbol : int
+  }
+
+let nextsym = ref 0
+
+let symbols = H.create 16
+
+let of_string name =
+  match H.find_opt symbols name with
+  | Some symbol ->
+      {name; symbol}
+  | None ->
+      incr nextsym;
+      let symbol = !nextsym in
+      H.replace symbols ~key:name ~data:symbol;
+      {name; symbol}
+
+let to_string {name; _} =
+  name

diff --git a/tiger/src/lib/tiger/tiger_symbol.mli b/tiger/src/lib/tiger/tiger_symbol.mli
new file mode 100644 (file)
index 0000000..8605047
--- /dev/null
+++ b/tiger/src/lib/tiger/tiger_symbol.mli
@@ -0,0 +1,5 @@
+type t
+
+val of_string : string -> t
+
+val to_string : t -> string