Skip to content

Commit

Permalink
Merge pull request #8 from epatrizio/loc
Browse files Browse the repository at this point in the history 
Localization error in typer and compiler
  • Loading branch information
@epatrizio
epatrizio authored Sep 12, 2022
2 parents b0efd9d + e889faa commit 1215a83
Show file tree
Hide file tree
Showing 7 changed files with 179 additions and 156 deletions.
3 changes: 1 addition & 2 deletions Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
36 changes: 19 additions & 17 deletions ast.ml
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
(* Abstract Syntax Tree *)

type loc = Lexing.position * Lexing.position

type ident = string

type typ =
Expand All @@ -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
Expand Down
80 changes: 40 additions & 40 deletions compiler.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 8 additions & 2 deletions main.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ =
Expand Down
52 changes: 26 additions & 26 deletions parser.mly
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand All @@ -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 :
Expand Down
Loading

0 comments on commit 1215a83

Please sign in to comment.