Merge pull request #10 from epatrizio/ast_type

AST type expression decoration
epatrizio · Sep 15, 2022 · 0cd0a50 · 0cd0a50
2 parents 1215a83 + dcb36a8
commit 0cd0a50
Show file tree

Hide file tree

Showing 9 changed files with 194 additions and 141 deletions.
diff --git a/ast.ml b/ast.ml
@@ -2,14 +2,15 @@
 
 type loc = Lexing.position * Lexing.position
 
-type ident = string
-
 type typ =
   | Tunit
   | Tbool
   | Tint
   | Tabool
   | Taint
+  | Tunknown
+
+type ident = typ * string
 
 type unop =
   | Unot (* not e *)
@@ -25,15 +26,15 @@ type constant =
   | Cint of int
 
 type expr =
-  | Ecst of loc * constant
-  | Eident of loc * ident
-  | Eref of loc * expr
-  | Ederef of loc * ident
-  | Eunop of loc * unop * expr
-  | Ebinop of loc * binop * expr * expr
-  | Earray of loc * expr list
-  | Eaget of loc * ident * expr
-  | Easize of loc * ident
+  | Ecst of loc * typ * constant
+  | Eident of loc * typ * ident
+  | Eref of loc * typ * expr
+  | Ederef of loc * typ * ident
+  | Eunop of loc * typ * unop * expr
+  | Ebinop of loc * typ * binop * expr * expr
+  | Earray of loc * typ * expr list
+  | Eaget of loc * typ * ident * expr
+  | Easize of loc * typ * ident
 
 type stmt =
   | Sassign of loc * ident * expr * stmt

diff --git a/compiler.ml b/compiler.ml
@@ -14,49 +14,47 @@ let rec compile_expr ?(label = "") e env k li =
   in
   let rec compile_array_expr la env k li loc =
     match la with
-    | [] -> error loc "empty array"
+    | [] -> [""]
     | [e] -> compile_expr e env k li
     | e::es -> compile_expr e env k li @ ["PUSH"] @ compile_array_expr es env k li loc
   in
   match e with
-  | Ecst (_,(Cbool b)) -> labeled_inst ~label:label (if b then "CONST 1" else "CONST 0") @ li
-  | Ecst (_,(Cint i)) -> labeled_inst ~label:label ("CONST " ^ string_of_int i) @ li
-  | Ecst (_,Cunit) -> labeled_inst ~label:label ("CONST 0") @ li
-  | Eident (loc,i) ->
+  | Ecst (_,_,(Cbool b)) -> labeled_inst ~label:label (if b then "CONST 1" else "CONST 0") @ li
+  | Ecst (_,_,(Cint i)) -> labeled_inst ~label:label ("CONST " ^ string_of_int i) @ li
+  | Ecst (_,_,Cunit) -> labeled_inst ~label:label ("CONST 0") @ li
+  | Eident (loc,_,(_,i)) ->
     if not (List.mem i env) then error loc ("unbound local var: " ^ i);
     ["ACC " ^ string_of_int ((pos_list env i) + k)] @ li
-  | Eunop (_,Unot,e) -> compile_expr e env k li @ ["PRIM not"] @ li
-  | Ebinop (_,Badd,e1,e2) -> compile_binop_expr e1 e2 "+" env k li @ li
-  | Ebinop (_,Bsub,e1,e2) -> compile_binop_expr e1 e2 "-" env k li @ li
-  | Ebinop (_,Bmul,e1,e2) -> compile_binop_expr e1 e2 "*" env k li @ li
-  | Ebinop (loc,Bdiv,e1,Ecst (_,Cint 0)) -> error loc "division by zero"
-  | Ebinop (_,Bdiv,e1,e2) -> compile_binop_expr e1 e2 "/" env k li @ li
-  | Ebinop (_,Beq,e1,e2) -> compile_binop_expr e1 e2 "=" env k li @ li
-  | Ebinop (_,Bneq,e1,e2) -> compile_binop_expr e1 e2 "<>" env k li @ li
-  | Ebinop (_,Blt,e1,e2) -> compile_binop_expr e1 e2 "<" env k li @ li
-  | Ebinop (_,Ble,e1,e2) -> compile_binop_expr e1 e2 "<=" env k li @ li
-  | Ebinop (_,Bgt,e1,e2) -> compile_binop_expr e1 e2 ">" env k li @ li
-  | Ebinop (_,Bge,e1,e2) -> compile_binop_expr e1 e2 ">=" env k li @ li
-  | Ebinop (_,Band,e1,e2) -> compile_binop_expr e1 e2 "&" env k li @ li
-  | Ebinop (_,Bor,e1,e2) -> compile_binop_expr e1 e2 "or" env k li @ li
-  | Eref (_,e) -> compile_expr e env k li @ ["MAKEBLOCK 1"] @ li
-  | Ederef (loc,i) -> compile_expr (Eident (loc,i)) env k li @ ["GETFIELD 0"] @ li
-  | Earray (loc,[]) -> error loc "empty array"
-  | Earray (loc,l) -> compile_array_expr (List.rev l) env k li loc @ ["MAKEBLOCK " ^ string_of_int (List.length l)] @ li
-  | Eaget (loc,i,e) ->
+  | Eunop (_,_,Unot,e) -> compile_expr e env k li @ ["PRIM not"] @ li
+  | Ebinop (_,_,Badd,e1,e2) -> compile_binop_expr e1 e2 "+" env k li @ li
+  | Ebinop (_,_,Bsub,e1,e2) -> compile_binop_expr e1 e2 "-" env k li @ li
+  | Ebinop (_,_,Bmul,e1,e2) -> compile_binop_expr e1 e2 "*" env k li @ li
+  | Ebinop (_,_,Bdiv,e1,e2) -> compile_binop_expr e1 e2 "/" env k li @ li
+  | Ebinop (_,_,Beq,e1,e2) -> compile_binop_expr e1 e2 "=" env k li @ li
+  | Ebinop (_,_,Bneq,e1,e2) -> compile_binop_expr e1 e2 "<>" env k li @ li
+  | Ebinop (_,_,Blt,e1,e2) -> compile_binop_expr e1 e2 "<" env k li @ li
+  | Ebinop (_,_,Ble,e1,e2) -> compile_binop_expr e1 e2 "<=" env k li @ li
+  | Ebinop (_,_,Bgt,e1,e2) -> compile_binop_expr e1 e2 ">" env k li @ li
+  | Ebinop (_,_,Bge,e1,e2) -> compile_binop_expr e1 e2 ">=" env k li @ li
+  | Ebinop (_,_,Band,e1,e2) -> compile_binop_expr e1 e2 "&" env k li @ li
+  | Ebinop (_,_,Bor,e1,e2) -> compile_binop_expr e1 e2 "or" env k li @ li
+  | Eref (_,_,e) -> compile_expr e env k li @ ["MAKEBLOCK 1"] @ li
+  | Ederef (loc,_,(typ,i)) -> compile_expr (Eident (loc,typ,(typ,i))) env k li @ ["GETFIELD 0"] @ li
+  | Earray (loc,_,l) -> compile_array_expr (List.rev l) env k li loc @ ["MAKEBLOCK " ^ string_of_int (List.length l)] @ li
+  | Eaget (loc,_,(typ,i),e) ->
     let tmp = "_tmp_" ^ string_of_int (counter ()) in
-      compile_stmt (Sassign (loc, tmp, e, Sif (loc, Ebinop (loc, Bge, (Eident (loc,tmp)), (Easize (loc,i))), Sexit, Sskip))) env li @ 
-        compile_expr e env k li @ ["PUSH"] @ compile_expr (Eident (loc,i)) env (k+1) li @  ["GETVECTITEM"] @ li
-  | Easize (loc,i) -> compile_expr (Eident (loc,i)) env k li @ ["VECTLENGTH"] @ li
+      compile_stmt (Sassign (loc, (typ,tmp), e, Sif (loc, Ebinop (loc, Tunknown, Bge, (Eident (loc,typ,(typ,tmp))), (Easize (loc,Tint,(typ,i)))), Sexit, Sskip))) env li @ 
+        compile_expr e env k li @ ["PUSH"] @ compile_expr (Eident (loc,typ,(typ,i))) env (k+1) li @  ["GETVECTITEM"] @ li
+  | Easize (loc,_,(typ,i)) -> compile_expr (Eident (loc,typ,(typ,i))) env k li @ ["VECTLENGTH"] @ li
 
   and compile_stmt ?(label = "") s env li =
   match s with
-  | Sassign(loc,i,e,s) ->
+  | Sassign(loc,(_,i),e,s) ->
     if List.mem i env then error loc ("local var already bound: " ^ i);
     compile_expr e env 0 li @ ["PUSH"] @ compile_stmt s (i :: env) li @ ["POP"]
-  | Srefassign(loc,i,e) -> compile_expr e env 0 li @ ["PUSH"] @ compile_expr (Eident (loc,i)) env 1 li @ ["SETFIELD 0"] @ li
-  | Saassign(loc,i,e1,e2) ->
-    compile_expr e2 env 0 li @ ["PUSH"] @ compile_expr e1 env 1 li @ ["PUSH"] @ compile_expr (Eident (loc,i)) env 2 li @ ["SETVECTITEM"] @ li
+  | Srefassign(loc,(typ,i),e) -> compile_expr e env 0 li @ ["PUSH"] @ compile_expr (Eident (loc,typ,(typ,i))) env 1 li @ ["SETFIELD 0"] @ li
+  | Saassign(loc,(typ,i),e1,e2) ->
+    compile_expr e2 env 0 li @ ["PUSH"] @ compile_expr e1 env 1 li @ ["PUSH"] @ compile_expr (Eident (loc,typ,(typ,i))) env 2 li @ ["SETVECTITEM"] @ li
   | Sblock b -> compile_block ~label:label b env li
   | Sif (_,e,s1,s2) ->
     let sct = string_of_int (counter ()) in

diff --git a/main.ml b/main.ml
@@ -16,8 +16,8 @@ let process source_code_file no_typing =
   try
     let ast = Parser.prog Lexer.token lexbuf in
       close_in ic;
-      if not no_typing then Typer.typing ast;
-      Compiler.compile ast source_code_file
+      let ast = if not no_typing then Typer.typing ast else ast in
+        Compiler.compile ast source_code_file
   with
     | Lexer.Lexing_error c -> 
         localisation (Lexing.lexeme_start_p lexbuf) source_code_file;

diff --git a/parser.mly b/parser.mly
@@ -37,9 +37,9 @@ prog : s=stmt EOF { s };
 
 stmt :
      | BEGIN b=block END { Ast.Sblock b }
-     | LET i=IDENT EQUAL e=expr IN s=stmt { Ast.Sassign(($startpos,$endpos), i, e, s) }
-     | i=IDENT REF_EQUAL e=expr { Ast.Srefassign(($startpos,$endpos), i, e) }
-     | i=IDENT LSQ e1=expr RSQ REF_EQUAL e2=expr { Ast.Saassign(($startpos,$endpos), i, e1, e2) }
+     | LET i=IDENT EQUAL e=expr IN s=stmt { Ast.Sassign(($startpos,$endpos), (Ast.Tunknown, i), e, s) }
+     | i=IDENT REF_EQUAL e=expr { Ast.Srefassign(($startpos,$endpos), (Ast.Tunknown, i), e) }
+     | i=IDENT LSQ e1=expr RSQ REF_EQUAL e2=expr { Ast.Saassign(($startpos,$endpos), (Ast.Tunknown, i), e1, e2) }
      | IF e=expr THEN s1=stmt ELSE s2=stmt { Ast.Sif (($startpos,$endpos), e, s1, s2) }
      | WHILE e=expr DO b=block DONE { Ast.Swhile (($startpos,$endpos), e, b) }
      | FOR s1=stmt SEMICOLON e=expr SEMICOLON s2=stmt DO b=block DONE { Ast.Sfor (($startpos,$endpos), s1, e, s2, b) }
@@ -55,29 +55,30 @@ block :
      ;
 
 expr :
-     | c=CST { Ast.Ecst (($startpos,$endpos), c) }
-     | i=IDENT { Ast.Eident (($startpos,$endpos), i) }
-     | LP NOT e=expr RP { Ast.Eunop (($startpos,$endpos), Unot, e) }
-     | LP e1=expr PLUS e2=expr RP { Ast.Ebinop (($startpos,$endpos), Badd, e1, e2) }
-     | LP e1=expr MINUS e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bsub, e1, e2) }
-     | LP e1=expr MULT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bmul, e1, e2) }
-     | LP e1=expr DIV e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bdiv, e1, e2) }
-     | LP e1=expr CMP_EQ e2=expr RP { Ast.Ebinop (($startpos,$endpos), Beq, e1, e2) }
-     | LP e1=expr CMP_NEQ e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bneq, e1, e2) }
-     | LP e1=expr CMP_LT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Blt, e1, e2) }
-     | LP e1=expr CMP_LE e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ble, e1, e2) }
-     | LP e1=expr CMP_GT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bgt, e1, e2) }
-     | LP e1=expr CMP_GE e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bge, e1, e2) }
-     | LP e1=expr AND e2=expr RP { Ast.Ebinop (($startpos,$endpos), Band, e1, e2) }
-     | LP e1=expr OR e2=expr RP { Ast.Ebinop (($startpos,$endpos), Bor, e1, e2) }
-     | LP REF e=expr RP { Ast.Eref (($startpos,$endpos), e) }
-     | LP EXCL i=IDENT RP { Ast.Ederef (($startpos,$endpos), i) }
-     | LCU l=expr_list RCU { Ast.Earray (($startpos,$endpos), l) }
-     | i=IDENT LSQ e=expr RSQ { Ast.Eaget (($startpos,$endpos), i, e) }
-     | LP ARRAY_SIZE i=IDENT RP { Ast.Easize (($startpos,$endpos), i) }
+     | c=CST { Ast.Ecst (($startpos,$endpos), Ast.Tunknown, c) }
+     | i=IDENT { Ast.Eident (($startpos,$endpos), Ast.Tunknown, (Ast.Tunknown, i)) }
+     | LP NOT e=expr RP { Ast.Eunop (($startpos,$endpos), Ast.Tunknown, Unot, e) }
+     | LP e1=expr PLUS e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Badd, e1, e2) }
+     | LP e1=expr MINUS e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bsub, e1, e2) }
+     | LP e1=expr MULT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bmul, e1, e2) }
+     | LP e1=expr DIV e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bdiv, e1, e2) }
+     | LP e1=expr CMP_EQ e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Beq, e1, e2) }
+     | LP e1=expr CMP_NEQ e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bneq, e1, e2) }
+     | LP e1=expr CMP_LT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Blt, e1, e2) }
+     | LP e1=expr CMP_LE e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Ble, e1, e2) }
+     | LP e1=expr CMP_GT e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bgt, e1, e2) }
+     | LP e1=expr CMP_GE e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bge, e1, e2) }
+     | LP e1=expr AND e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Band, e1, e2) }
+     | LP e1=expr OR e2=expr RP { Ast.Ebinop (($startpos,$endpos), Ast.Tunknown, Bor, e1, e2) }
+     | LP REF e=expr RP { Ast.Eref (($startpos,$endpos), Ast.Tunknown, e) }
+     | LP EXCL i=IDENT RP { Ast.Ederef (($startpos,$endpos), Ast.Tunknown, (Ast.Tunknown, i)) }
+     | LCU l=expr_list RCU { Ast.Earray (($startpos,$endpos), Ast.Tunknown, l) }
+     | i=IDENT LSQ e=expr RSQ { Ast.Eaget (($startpos,$endpos), Ast.Tunknown, (Ast.Tunknown, i), e) }
+     | LP ARRAY_SIZE i=IDENT RP { Ast.Easize (($startpos,$endpos), Ast.Tunknown, (Ast.Tunknown, i)) }
      ;
 
 expr_list :
+     | { [] }
      | e=expr { [e] }
      | e=expr COMMA l=expr_list { e :: l }
      ;

diff --git a/tests/ty_err_1-0.txt b/tests/ty_err_1-0.txt
@@ -0,0 +1 @@
+print (42/0)
diff --git a/tests/ty_err_41-0.txt b/tests/ty_err_41-0.txt
@@ -0,0 +1,2 @@
+let a = {} in
+  print a[0]
diff --git a/tests/ty_err_8.2.txt → tests/ty_err_8-2.txt b/tests/ty_err_8.2.txt → tests/ty_err_8-2.txt
diff --git a/tests/ty_err_8.3.txt → tests/ty_err_8-3.txt b/tests/ty_err_8.3.txt → tests/ty_err_8-3.txt