Merge pull request #8 from epatrizio/loc

Localization error in typer and compiler
epatrizio · Sep 12, 2022 · 1215a83 · 1215a83
2 parents b0efd9d + e889faa
commit 1215a83
Show file tree

Hide file tree

Showing 7 changed files with 179 additions and 156 deletions.
diff --git a/Makefile b/Makefile
@@ -14,10 +14,9 @@ all:
 	ocamlc -c parser.mli;
 	ocamlc -c parser.ml;
 	ocamlc -c lexer.ml;
-	ocamlc -c tast.ml;
 	ocamlc -c typer.ml;
 	ocamlc -c main.ml;
-	ocamlc -o $(EXE) utils.cmo ast.cmo tast.cmo compiler.cmo lexer.cmo parser.cmo typer.cmo main.cmo
+	ocamlc -o $(EXE) utils.cmo ast.cmo compiler.cmo lexer.cmo parser.cmo typer.cmo main.cmo
 
 clean:
 	rm -rf *.cmo *.cmi lexer.ml parser.ml parser.mli $(EXE)

diff --git a/ast.ml b/ast.ml
@@ -1,5 +1,7 @@
 (* Abstract Syntax Tree *)
 
+type loc = Lexing.position * Lexing.position
+
 type ident = string
 
 type typ =
@@ -23,24 +25,24 @@ type constant =
   | Cint of int
 
 type expr =
-  | Ecst of constant
-  | Eident of ident
-  | Eref of expr
-  | Ederef of ident
-  | Eunop of unop * expr
-  | Ebinop of binop * expr * expr
-  | Earray of expr list
-  | Eaget of ident * expr
-  | Easize of ident
-
-and stmt =
-  | Sassign of ident * expr * stmt
-  | Srefassign of ident * expr
-  | Saassign of ident * expr * 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
+
+type stmt =
+  | Sassign of loc * ident * expr * stmt
+  | Srefassign of loc * ident * expr
+  | Saassign of loc * ident * expr * expr
   | Sblock of block
-  | Sif of expr * stmt * stmt
-  | Swhile of expr * block
-  | Sfor of stmt * expr * stmt * block
+  | Sif of loc * expr * stmt * stmt
+  | Swhile of loc * expr * block
+  | Sfor of loc * stmt * expr * stmt * block
   | Sprint of expr
   | Sexit
   | Sskip

diff --git a/compiler.ml b/compiler.ml
@@ -3,68 +3,68 @@
 open Ast
 open Utils
 
-exception Error of string
-let error message = raise (Error message)
+exception Error of loc * string
+let error loc message = raise (Error (loc,message))
 
 let counter = counter_from 0
 
 let rec compile_expr ?(label = "") e env k li =
   let compile_binop_expr e1 e2 prim env k li =
     (compile_expr e2 env k li) @ ["PUSH"] @ (compile_expr e1 env (k+1) li) @ ["PRIM " ^ prim]
   in
-  let rec compile_array_expr la env k li =
+  let rec compile_array_expr la env k li loc =
     match la with
-    | [] -> error "empty array"
+    | [] -> 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
+    | 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 i ->
-    if not (List.mem i env) then error ("unbound local var: " ^ 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 (Bdiv,e1,Ecst (Cint 0)) -> error "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 i -> compile_expr (Eident i) env k li @ ["GETFIELD 0"] @ li
-  | Earray [] -> error "empty array"
-  | Earray l -> compile_array_expr (List.rev l) env k li @ ["MAKEBLOCK " ^ string_of_int (List.length l)] @ li
-  | Eaget (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 (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) ->
     let tmp = "_tmp_" ^ string_of_int (counter ()) in
-      compile_stmt (Sassign (tmp, e, Sif (Ebinop (Bge, (Eident tmp), (Easize i)), Sexit, Sskip))) env li @ 
-        compile_expr e env k li @ ["PUSH"] @ compile_expr (Eident i) env (k+1) li @  ["GETVECTITEM"] @ li
-  | Easize i -> compile_expr (Eident i) env k li @ ["VECTLENGTH"] @ li
+      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
 
   and compile_stmt ?(label = "") s env li =
   match s with
-  | Sassign(i,e,s) ->
-    if List.mem i env then error ("local var already bound: " ^ i);
+  | 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(i,e) -> compile_expr e env 0 li @ ["PUSH"] @ compile_expr (Eident i) env 1 li @ ["SETFIELD 0"] @ li
-  | Saassign(i,e1,e2) ->
-    compile_expr e2 env 0 li @ ["PUSH"] @ compile_expr e1 env 1 li @ ["PUSH"] @ compile_expr (Eident i) env 2 li @ ["SETVECTITEM"] @ li
+  | 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
   | Sblock b -> compile_block ~label:label b env li
-  | Sif (e,s1,s2) ->
+  | Sif (_,e,s1,s2) ->
     let sct = string_of_int (counter ()) in
     compile_expr e env 0 li @ ["BRANCHIFNOT f" ^ sct] @ compile_stmt s1 env li @ ["BRANCH t" ^ sct] @ compile_stmt ~label:("f"^sct) s2 env li @ labeled_inst ~label:("t"^sct) ""
-  | Swhile (e,b) ->
+  | Swhile (_,e,b) ->
     let sct = string_of_int (counter ()) in
     compile_expr e env 0 li @ labeled_inst ~label:("wcond"^sct) ("BRANCHIFNOT wdone"^sct) @ compile_block b env li @ compile_expr e env 0 li @ ["BRANCH wcond" ^ sct] @ labeled_inst ~label:("wdone"^sct) ""
-  | Sfor (s1,e,s2,b) -> compile_stmt s1 env li @ compile_stmt (Swhile (e, Bseq_r (b,s2))) env li
+  | Sfor (loc,s1,e,s2,b) -> compile_stmt s1 env li @ compile_stmt (Swhile (loc,e, Bseq_r (b,s2))) env li
   | Sprint e -> (compile_expr ~label:label e env 0 li) @ ["PRIM print"]
   | Sexit -> labeled_inst ~label:label ("STOP") @ li
   | Sskip -> labeled_inst ~label:label ("CONST 0") @ li

diff --git a/main.ml b/main.ml
@@ -27,11 +27,17 @@ let process source_code_file no_typing =
         localisation (Lexing.lexeme_start_p lexbuf) source_code_file;
         eprintf "Syntax error@.";
         exit 1
-    | Typer.Error s ->
+    | Typer.Error ((l1,l2),s) ->
+        localisation l1 source_code_file;
+        localisation l2 source_code_file;
         eprintf "Typing error: %s@." s;
+        extract_in_file source_code_file l1 l2;
         exit 1
-    | Compiler.Error s ->
+    | Compiler.Error ((l1,l2),s) ->
+        localisation l1 source_code_file;
+        localisation l2 source_code_file;
         eprintf "Compilation error: %s@." s;
+        extract_in_file source_code_file l1 l2;
         exit 1
 
 let _ =

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