From d26b88de023d7077da7f6322014e69bc973d9f76 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 15:02:21 +0200 Subject: [PATCH 01/14] Typer skeleton --- Makefile | 11 ++++++++++- ast.ml | 5 +++++ main.ml | 25 ++++++++++++++++++++---- tests/ty_err_0-0.txt | 1 + tests/ty_err_0-1.txt | 1 + typer.ml | 46 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 84 insertions(+), 5 deletions(-) create mode 100644 tests/ty_err_0-0.txt create mode 100644 tests/ty_err_0-1.txt create mode 100644 typer.ml diff --git a/Makefile b/Makefile index d685f42..8ba16ea 100644 --- a/Makefile +++ b/Makefile @@ -14,8 +14,10 @@ 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 compiler.cmo lexer.cmo parser.cmo main.cmo + ocamlc -o $(EXE) utils.cmo ast.cmo tast.cmo compiler.cmo lexer.cmo parser.cmo typer.cmo main.cmo clean: rm -rf *.cmo *.cmi lexer.ml parser.ml parser.mli $(EXE) @@ -29,6 +31,9 @@ check_grammar: compile: @./$(EXE) tests/$(S) +compile_no_typing: + @./$(EXE) --no-typing tests/$(S) + vm: @$(VM) tests/build/bc_$(S) @@ -37,8 +42,12 @@ vm_debug: cvm: compile vm +cvm_no_typing: compile_no_typing vm + cvm_debug: compile vm_debug +cvm_debug_no_typing: compile_no_typing vm_debug + test: $(eval RES := $(shell S=$(S) make cvm)) @if [ $(RES) = ${R} ]; then echo "$(GREEN)$(S) PASSED$(NC)"; else echo "$(RED)$(S) FAILED $(RES)<>$(R)$(NC)"; fi diff --git a/ast.ml b/ast.ml index 4345834..609fe78 100644 --- a/ast.ml +++ b/ast.ml @@ -2,6 +2,11 @@ type ident = string +type typ = + | Tunit + | Tbool + | Tint + type unop = | Unot (* not e *) diff --git a/main.ml b/main.ml index 65b6890..c3fcd30 100644 --- a/main.ml +++ b/main.ml @@ -1,12 +1,22 @@ open Format open Utils -let process source_code_file = +let no_typing = ref false + +let in_file_name = ref "" +let set_file s = in_file_name := s + +let options = ["--no-typing", Arg.Set no_typing, " Compile without typing checks"] + +let usage = "usage: ./c2mz [options] tests/bc_(test).txt" + +let process source_code_file no_typing = let ic = open_in source_code_file in let lexbuf = Lexing.from_channel ic in try let ast = Parser.prog Lexer.token lexbuf in close_in ic; + if not no_typing then Typer.typing ast else Ast.Tunit; Compiler.compile ast source_code_file with | Lexer.Lexing_error c -> @@ -17,11 +27,18 @@ let process source_code_file = localisation (Lexing.lexeme_start_p lexbuf) source_code_file; eprintf "Syntax error@."; exit 1 + | Typer.Error s -> + eprintf "Typing error: %s@." s; + exit 1 | Compiler.Error s -> eprintf "Compilation error: %s@." s; exit 1 let _ = - for i = 1 to Array.length Sys.argv - 1 do - process Sys.argv.(i) - done + Arg.parse options set_file usage; + if !in_file_name="" then begin + eprintf "init error: missing test file name to compile!\n@?"; + Arg.usage options usage; + exit 1 + end; + process !in_file_name !no_typing diff --git a/tests/ty_err_0-0.txt b/tests/ty_err_0-0.txt new file mode 100644 index 0000000..221a755 --- /dev/null +++ b/tests/ty_err_0-0.txt @@ -0,0 +1 @@ +print (not 42) diff --git a/tests/ty_err_0-1.txt b/tests/ty_err_0-1.txt new file mode 100644 index 0000000..fe5baaf --- /dev/null +++ b/tests/ty_err_0-1.txt @@ -0,0 +1 @@ +print (true and 42) diff --git a/typer.ml b/typer.ml new file mode 100644 index 0000000..7fe6531 --- /dev/null +++ b/typer.ml @@ -0,0 +1,46 @@ +(* Typer *) + +open Ast + +exception Error of string +let error message = raise (Error message) + +module Tmap = Map.Make(String) + +type environment = typ Tmap.t + +let rec type_expr env e = + match e with + | Ecst Cunit -> Tunit + | Ecst (Cbool b) -> Tbool + | Ecst (Cint i) -> Tint + | Eident i -> Tmap.find i env + | Eunop (Unot,(Ecst (Cbool b))) -> Tbool + | Eunop (Unot,(Ecst _)) -> error "not boolean type (unop)" + | Eunop (Unot,e) -> type_expr env e + | Ebinop (Band,e1,e2) -> begin match type_expr env e1 with + | Tbool -> + begin match type_expr env e2 with + | Tbool -> Tbool + | _ -> error "not boolean type (and binop)" + end + | _ -> error "not boolean type (and binop)" + end + | Ebinop (Bor,e1,e2) -> begin match type_expr env e1 with + | Tbool -> + begin match type_expr env e2 with + | Tbool -> Tbool + | _ -> error "not boolean type (or binop)" + end + | _ -> error "not boolean type (or binop)" + end + | _ -> error "not implemented (call compiler with --no-typing option)" + +and type_stmt env s = + match s with + | Sprint e -> type_expr env e + | _ -> error "not implemented (call compiler with --no-typing option)" + +let typing stmt = + let env = Tmap.empty in + type_stmt env stmt From 3212037eda74e6c29d122c317bd064739b4857ad Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 16:14:58 +0200 Subject: [PATCH 02/14] Add operation typing --- typer.ml | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/typer.ml b/typer.ml index 7fe6531..a8bb990 100644 --- a/typer.ml +++ b/typer.ml @@ -33,7 +33,39 @@ let rec type_expr env e = | _ -> error "not boolean type (or binop)" end | _ -> error "not boolean type (or binop)" - end + end + | Ebinop (Badd,e1,e2) -> begin match type_expr env e1 with + | Tint -> + begin match type_expr env e2 with + | Tint -> Tint + | _ -> error "not integer type (add binop)" + end + | _ -> error "not integer type (add binop)" + end + | Ebinop (Bsub,e1,e2) -> begin match type_expr env e1 with + | Tint -> + begin match type_expr env e2 with + | Tint -> Tint + | _ -> error "not integer type (sub binop)" + end + | _ -> error "not integer type (sub binop)" + end + | Ebinop (Bmul,e1,e2) -> begin match type_expr env e1 with + | Tint -> + begin match type_expr env e2 with + | Tint -> Tint + | _ -> error "not integer type (mul binop)" + end + | _ -> error "not integer type (mul binop)" + end + | Ebinop (Bdiv,e1,e2) -> begin match type_expr env e1 with + | Tint -> + begin match type_expr env e2 with + | Tint -> Tint + | _ -> error "not integer type (div binop)" + end + | _ -> error "not integer type (div binop)" + end | _ -> error "not implemented (call compiler with --no-typing option)" and type_stmt env s = From c395cb6e6472207bbe7f732ffb123b9d19869142 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 16:19:29 +0200 Subject: [PATCH 03/14] Add operation typing error test --- tests/ty_err_1.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 tests/ty_err_1.txt diff --git a/tests/ty_err_1.txt b/tests/ty_err_1.txt new file mode 100644 index 0000000..603cc43 --- /dev/null +++ b/tests/ty_err_1.txt @@ -0,0 +1 @@ +print (((3+(4*2))-true)/2) From dbd4dece4150df0e0bdce24fd3380b24e4ef5e59 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 16:42:57 +0200 Subject: [PATCH 04/14] Add if statement typing --- tests/ty_err_2.txt | 4 ++++ typer.ml | 10 +++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 tests/ty_err_2.txt diff --git a/tests/ty_err_2.txt b/tests/ty_err_2.txt new file mode 100644 index 0000000..abfb9d9 --- /dev/null +++ b/tests/ty_err_2.txt @@ -0,0 +1,4 @@ +if 1 then + print 1 +else + print 2 \ No newline at end of file diff --git a/typer.ml b/typer.ml index a8bb990..d423b0b 100644 --- a/typer.ml +++ b/typer.ml @@ -70,7 +70,15 @@ let rec type_expr env e = and type_stmt env s = match s with - | Sprint e -> type_expr env e + | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) + | Sif (e,s1,s2) -> begin + begin match type_expr env e with + | Tbool -> Tbool + | _ -> error "not boolean type (if condition statement)" + end; + type_stmt env s1; + type_stmt env s2 + end | _ -> error "not implemented (call compiler with --no-typing option)" let typing stmt = From b6ce5c6accc5de7d339a855ebcd735d8b2b3d518 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 17:17:07 +0200 Subject: [PATCH 05/14] Add comparaison operators typing --- tests/ty_err_2-0.txt | 4 ++++ typer.ml | 24 ++++++++++++++++++++++++ 2 files changed, 28 insertions(+) create mode 100644 tests/ty_err_2-0.txt diff --git a/tests/ty_err_2-0.txt b/tests/ty_err_2-0.txt new file mode 100644 index 0000000..8c91d19 --- /dev/null +++ b/tests/ty_err_2-0.txt @@ -0,0 +1,4 @@ +if (((not true) or (false == 2)) and (1 <= true)) then + print 1 +else + print 2 diff --git a/typer.ml b/typer.ml index d423b0b..0744a2b 100644 --- a/typer.ml +++ b/typer.ml @@ -66,6 +66,30 @@ let rec type_expr env e = end | _ -> error "not integer type (div binop)" end + | Ebinop (Beq,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == ty2 then Tbool else error "not identic type (equals comparaison binop)" + | Ebinop (Bneq,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == ty2 then Tbool else error "not identic type (diff comparaison binop)" + | Ebinop (Blt,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (< comparaison binop)" + | Ebinop (Ble,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (<= comparaison binop)" + | Ebinop (Bgt,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (> comparaison binop)" + | Ebinop (Bge,e1,e2) -> + let ty1 = type_expr env e1 in + let ty2 = type_expr env e2 in + if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (>= comparaison binop)" | _ -> error "not implemented (call compiler with --no-typing option)" and type_stmt env s = From 6cf01b1c56b33c04311a3eadcb01297298e9f78c Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 18:02:28 +0200 Subject: [PATCH 06/14] Add assign statement typing --- tests/ty_err_7.txt | 3 +++ typer.ml | 1 + 2 files changed, 4 insertions(+) create mode 100644 tests/ty_err_7.txt diff --git a/tests/ty_err_7.txt b/tests/ty_err_7.txt new file mode 100644 index 0000000..de3e519 --- /dev/null +++ b/tests/ty_err_7.txt @@ -0,0 +1,3 @@ +let x = 10 in +let y = ((1<2) and (5>=2)) in + print (x+y) \ No newline at end of file diff --git a/typer.ml b/typer.ml index 0744a2b..9cd3c02 100644 --- a/typer.ml +++ b/typer.ml @@ -94,6 +94,7 @@ let rec type_expr env e = and type_stmt env s = match s with + | Sassign(i,e,s) -> let env = Tmap.add i (type_expr env e) env in type_stmt env s | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) | Sif (e,s1,s2) -> begin begin match type_expr env e with From 97138ca50ec7c4d9ede38fd7fb824a3a9f74522d Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Wed, 7 Sep 2022 18:31:38 +0200 Subject: [PATCH 07/14] Add block statement typing --- typer.ml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/typer.ml b/typer.ml index 9cd3c02..264dda4 100644 --- a/typer.ml +++ b/typer.ml @@ -14,7 +14,9 @@ let rec type_expr env e = | Ecst Cunit -> Tunit | Ecst (Cbool b) -> Tbool | Ecst (Cint i) -> Tint - | Eident i -> Tmap.find i env + | Eident i -> begin + try Tmap.find i env with Not_found -> error ("unbound local var: " ^ i) + end | Eunop (Unot,(Ecst (Cbool b))) -> Tbool | Eunop (Unot,(Ecst _)) -> error "not boolean type (unop)" | Eunop (Unot,e) -> type_expr env e @@ -95,6 +97,7 @@ let rec type_expr env e = and type_stmt env s = match s with | Sassign(i,e,s) -> let env = Tmap.add i (type_expr env e) env in type_stmt env s + | Sblock b -> type_block env b | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) | Sif (e,s1,s2) -> begin begin match type_expr env e with @@ -106,6 +109,12 @@ and type_stmt env s = end | _ -> error "not implemented (call compiler with --no-typing option)" +and type_block env b = + match b with + | Bstmt s -> type_stmt env s + | Bseq_l (s,b) -> type_stmt env s; type_block env b + | Bseq_r (b,s) -> type_block env b; type_stmt env s + let typing stmt = let env = Tmap.empty in type_stmt env stmt From 219d7fa5aa7db2c3eb6a98fd28c4d81580f0df5a Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Thu, 8 Sep 2022 11:55:42 +0200 Subject: [PATCH 08/14] Add reference assign typing --- tests/ty_err_8.2.txt | 10 ++++++++++ tests/ty_err_8.3.txt | 6 ++++++ typer.ml | 6 ++++++ 3 files changed, 22 insertions(+) create mode 100644 tests/ty_err_8.2.txt create mode 100644 tests/ty_err_8.3.txt diff --git a/tests/ty_err_8.2.txt b/tests/ty_err_8.2.txt new file mode 100644 index 0000000..5cbe224 --- /dev/null +++ b/tests/ty_err_8.2.txt @@ -0,0 +1,10 @@ +let x = (ref (40+2)) in +let y = (ref ((!x)*false)) in (* error *) +let z = true in + begin + print (!x); + print (!y); + print ((!y)/2); + print z; + print ((!x)+z) (* error *) + end diff --git a/tests/ty_err_8.3.txt b/tests/ty_err_8.3.txt new file mode 100644 index 0000000..95f319e --- /dev/null +++ b/tests/ty_err_8.3.txt @@ -0,0 +1,6 @@ +let x = (ref 42) in +let y = (ref true) in +begin + x := ((!x) + (!y)); (* error *) + print (!x) +end diff --git a/typer.ml b/typer.ml index 264dda4..0e0b5d1 100644 --- a/typer.ml +++ b/typer.ml @@ -92,11 +92,17 @@ let rec type_expr env e = let ty1 = type_expr env e1 in let ty2 = type_expr env e2 in if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (>= comparaison binop)" + | Eref e -> type_expr env e + | Ederef i -> type_expr env (Eident i) | _ -> error "not implemented (call compiler with --no-typing option)" and type_stmt env s = match s with | Sassign(i,e,s) -> let env = Tmap.add i (type_expr env e) env in type_stmt env s + | Srefassign(i,e) -> + let ty1 = type_expr env (Eident i) in + let ty2 = type_expr env e in + if ty1 == ty2 then Tunit else error "not identic type (ref assign)" | Sblock b -> type_block env b | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) | Sif (e,s1,s2) -> begin From 759b17359e576bbe5d3da3f21b3517a4184591d3 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Thu, 8 Sep 2022 12:22:31 +0200 Subject: [PATCH 09/14] Add for statement typing --- tests/t10.txt | 4 ++-- tests/ty_err_10.txt | 6 ++++++ typer.ml | 4 ++++ 3 files changed, 12 insertions(+), 2 deletions(-) create mode 100644 tests/ty_err_10.txt diff --git a/tests/t10.txt b/tests/t10.txt index 4d3ebb7..051bc04 100644 --- a/tests/t10.txt +++ b/tests/t10.txt @@ -1,5 +1,5 @@ -let i = (ref ()) in -let tmp = (ref ()) in +let i = (ref 0) in +let tmp = (ref 0) in let coef = 10 in begin print (!i); diff --git a/tests/ty_err_10.txt b/tests/ty_err_10.txt new file mode 100644 index 0000000..653436b --- /dev/null +++ b/tests/ty_err_10.txt @@ -0,0 +1,6 @@ +let i = (ref 0) in +begin + for i:=1 ; ((!i)+10) ; i:=((!i)+1) do (* error *) + print (!i) + done +end \ No newline at end of file diff --git a/typer.ml b/typer.ml index 0e0b5d1..da798f0 100644 --- a/typer.ml +++ b/typer.ml @@ -104,6 +104,10 @@ and type_stmt env s = let ty2 = type_expr env e in if ty1 == ty2 then Tunit else error "not identic type (ref assign)" | Sblock b -> type_block env b + | Sfor (s1,e,s2,b) -> begin match type_expr env e with + | Tbool -> type_stmt env s1; type_stmt env s2; type_block env b + | _ -> error "not boolean type (for statement condition)" + end | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) | Sif (e,s1,s2) -> begin begin match type_expr env e with From a58fc7c84ba1b5000f21f92704a338eef06adf33 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Thu, 8 Sep 2022 12:32:18 +0200 Subject: [PATCH 10/14] Add while statement typing --- tests/t11.txt | 2 +- tests/ty_err_11.txt | 5 +++++ typer.ml | 6 ++++++ 3 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 tests/ty_err_11.txt diff --git a/tests/t11.txt b/tests/t11.txt index 0188268..38c8b2a 100644 --- a/tests/t11.txt +++ b/tests/t11.txt @@ -1,4 +1,4 @@ -let i = (ref ()) in +let i = (ref 0) in begin while ((!i) < 10) do print (!i); diff --git a/tests/ty_err_11.txt b/tests/ty_err_11.txt new file mode 100644 index 0000000..dfb3493 --- /dev/null +++ b/tests/ty_err_11.txt @@ -0,0 +1,5 @@ +let i = (ref 0) in + while ((!i) + 10) do (* error *) + print (!i); + i := ((!i) + 1) + done diff --git a/typer.ml b/typer.ml index da798f0..cf2b4af 100644 --- a/typer.ml +++ b/typer.ml @@ -104,6 +104,10 @@ and type_stmt env s = let ty2 = type_expr env e in if ty1 == ty2 then Tunit else error "not identic type (ref assign)" | Sblock b -> type_block env b + | Swhile (e,b) -> begin match type_expr env e with + | Tbool -> type_block env b + | _ -> error "not boolean type (while statement condition)" + end | Sfor (s1,e,s2,b) -> begin match type_expr env e with | Tbool -> type_stmt env s1; type_stmt env s2; type_block env b | _ -> error "not boolean type (for statement condition)" @@ -117,6 +121,8 @@ and type_stmt env s = type_stmt env s1; type_stmt env s2 end + | Sexit -> Tunit + | Sskip -> Tunit | _ -> error "not implemented (call compiler with --no-typing option)" and type_block env b = From 3df5e867d743be64f92cd5cebbf77c94adc03941 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Thu, 8 Sep 2022 14:37:31 +0200 Subject: [PATCH 11/14] bug fix typing error --- tests/t12.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/t12.txt b/tests/t12.txt index 1c41c48..f3736d1 100644 --- a/tests/t12.txt +++ b/tests/t12.txt @@ -1,4 +1,4 @@ -let i = (ref ()) in +let i = (ref 0) in begin print 42; skip; From da1812cc1b69ea35fe7580e9f50e0a8524938f12 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Thu, 8 Sep 2022 17:02:07 +0200 Subject: [PATCH 12/14] Add array typing --- ast.ml | 2 ++ tests/ty_err_41.txt | 11 +++++++++++ typer.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 55 insertions(+) create mode 100644 tests/ty_err_41.txt diff --git a/ast.ml b/ast.ml index 609fe78..675d09b 100644 --- a/ast.ml +++ b/ast.ml @@ -6,6 +6,8 @@ type typ = | Tunit | Tbool | Tint + | Tabool + | Taint type unop = | Unot (* not e *) diff --git a/tests/ty_err_41.txt b/tests/ty_err_41.txt new file mode 100644 index 0000000..41c9cc8 --- /dev/null +++ b/tests/ty_err_41.txt @@ -0,0 +1,11 @@ +let a = {1,2,(1+2),true,5,6,7,8,9,10} in (* error *) +let x = 5 in +begin + print a[(1+1)]; + print a[true]; (* error *) + print x; + a[0] := true; (* error *) + print a[0]; + print (array_size a); + print (array_size x) (* error *) +end diff --git a/typer.ml b/typer.ml index cf2b4af..0964f60 100644 --- a/typer.ml +++ b/typer.ml @@ -10,6 +10,12 @@ module Tmap = Map.Make(String) type environment = typ Tmap.t let rec type_expr env e = + let elts_same_types = function + | [] -> (Tunit,true) + | [e] -> (type_expr env e,true) + | e1 :: rlist -> let acc = (type_expr env e1,true) in + List.fold_left (fun (ty,ok) e -> (ty,(ok && (ty == type_expr env e)))) acc rlist + in match e with | Ecst Cunit -> Tunit | Ecst (Cbool b) -> Tbool @@ -94,6 +100,32 @@ let rec type_expr env e = if ty1 == Tint && ty2 == Tint then Tbool else error "not integer type (>= comparaison binop)" | Eref e -> type_expr env e | Ederef i -> type_expr env (Eident i) + | Earray [] -> error "empty array" + | Earray l -> let (ty,b) = elts_same_types l in + begin match b with + | true -> begin match ty with + | Tint -> Taint + | Tbool -> Tabool + | Tunit -> error "unit type not authorized (array create)" + | _ -> error "array of array type not supported (array create)" + end + | false -> error "not identic type (array create)" + end + | Eaget (i,e) -> + let tya = type_expr env (Eident i) in + begin match type_expr env e with + | Tint -> begin match tya with + | Taint -> Tint + | Tabool -> Tbool + | _ -> error "incoherent array type (array accessor)" + end + | _ -> error "not integer type (array accessor)" + end + | Easize i -> begin match type_expr env (Eident i) with + | Taint -> Tint + | Tabool -> Tint + | _ -> error "not array type (array_size primitive)" + end | _ -> error "not implemented (call compiler with --no-typing option)" and type_stmt env s = @@ -103,6 +135,16 @@ and type_stmt env s = let ty1 = type_expr env (Eident i) in let ty2 = type_expr env e in if ty1 == ty2 then Tunit else error "not identic type (ref assign)" + | Saassign(i,e1,e2) -> + let tya = type_expr env (Eident i) in + begin match type_expr env e1 with + | Tint -> begin match type_expr env e2 with + | Tint -> if tya == Taint then Tunit else error "not integer type (array element assign)" + | Tbool -> if tya == Tabool then Tunit else error "not boolean type (array element assign)" + | _ -> error "incoherent type (array element assign)" + end + | _ -> error "not integer type (array assign accessor)" + end | Sblock b -> type_block env b | Swhile (e,b) -> begin match type_expr env e with | Tbool -> type_block env b From 3670072791cd58482301c20a1539e1e009ddab10 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Fri, 9 Sep 2022 11:30:19 +0200 Subject: [PATCH 13/14] Fix warning compilation --- compiler.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler.ml b/compiler.ml index 1ba9b86..8a0e34d 100644 --- a/compiler.ml +++ b/compiler.ml @@ -81,7 +81,7 @@ let compile stmt in_file_name = let oc = open_out ("tests/build/bc_" ^ (Filename.basename in_file_name)) in let fmt = Format.formatter_of_out_channel oc in let inst_processing si = - if String.starts_with "LABEL" si then + if String.starts_with ~prefix:"LABEL" si then let sl = String.split_on_char ';' si in let label_inst = List.hd sl in let label = String.sub label_inst 6 ((String.length label_inst) - 6) in @@ -91,7 +91,7 @@ let compile stmt in_file_name = Format.fprintf fmt "\t%s\n" si in let insts_processing li = - List.map (fun s -> inst_processing s) li; + let _ = List.map (fun s -> inst_processing s) li in Format.fprintf fmt "@." in let insts = compile_prog stmt in From d1f23205a0964f24fa2b35c4a1f742c85ca49d17 Mon Sep 17 00:00:00 2001 From: Eric Patrizio Date: Fri, 9 Sep 2022 11:31:54 +0200 Subject: [PATCH 14/14] unit return for type_stmt and type_block --- main.ml | 2 +- typer.ml | 19 +++++++++---------- 2 files changed, 10 insertions(+), 11 deletions(-) diff --git a/main.ml b/main.ml index c3fcd30..a7b503a 100644 --- a/main.ml +++ b/main.ml @@ -16,7 +16,7 @@ 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 else Ast.Tunit; + if not no_typing then Typer.typing ast; Compiler.compile ast source_code_file with | Lexer.Lexing_error c -> diff --git a/typer.ml b/typer.ml index 0964f60..fb7a48d 100644 --- a/typer.ml +++ b/typer.ml @@ -126,21 +126,20 @@ let rec type_expr env e = | Tabool -> Tint | _ -> error "not array type (array_size primitive)" end - | _ -> error "not implemented (call compiler with --no-typing option)" and type_stmt env s = - match s with + begin match s with | Sassign(i,e,s) -> let env = Tmap.add i (type_expr env e) env in type_stmt env s | Srefassign(i,e) -> let ty1 = type_expr env (Eident i) in let ty2 = type_expr env e in - if ty1 == ty2 then Tunit else error "not identic type (ref assign)" + if ty1 == ty2 then () else error "not identic type (ref assign)" | Saassign(i,e1,e2) -> let tya = type_expr env (Eident i) in begin match type_expr env e1 with | Tint -> begin match type_expr env e2 with - | Tint -> if tya == Taint then Tunit else error "not integer type (array element assign)" - | Tbool -> if tya == Tabool then Tunit else error "not boolean type (array element assign)" + | Tint -> if tya == Taint then () else error "not integer type (array element assign)" + | Tbool -> if tya == Tabool then () else error "not boolean type (array element assign)" | _ -> error "incoherent type (array element assign)" end | _ -> error "not integer type (array assign accessor)" @@ -154,18 +153,18 @@ and type_stmt env s = | Tbool -> type_stmt env s1; type_stmt env s2; type_block env b | _ -> error "not boolean type (for statement condition)" end - | Sprint e -> type_expr env e (* print bool (0/1) or unit (0) is ok *) + | Sprint e -> let _ = type_expr env e in () (* print bool (0/1) or unit (0) is ok *) | Sif (e,s1,s2) -> begin begin match type_expr env e with - | Tbool -> Tbool + | Tbool -> () | _ -> error "not boolean type (if condition statement)" end; type_stmt env s1; type_stmt env s2 end - | Sexit -> Tunit - | Sskip -> Tunit - | _ -> error "not implemented (call compiler with --no-typing option)" + | Sexit -> () + | Sskip -> () + end and type_block env b = match b with