diff --git a/Cimp.ml b/Cimp.ml
index 503bc62cf4e4022858891ef599ffb680c51b736a..6271819f91890b1624415ef417bec16e293bf3ba 100644
--- a/Cimp.ml
+++ b/Cimp.ml
@@ -2,12 +2,7 @@
(* for the full license governing this code. *)
(* local files *)
-open Common
-open Options
-open Error
-open Cmd
-open Dump
-open Env
+open Common
(* extracted code (/extract) *)
module Compile = Compiler__Compile_com
@@ -18,72 +13,70 @@ module State = State__State
module Imp = Imp__Imp
let () =
-
- cmd; (* parse command line options and put into opt *)
- p_stderr (string_of_opt opt);
-
- let inBuff =
- try Some (open_in opt.infile)
- with _ -> None
- in
-
+ Cmd.cmd; (* parse command line options and put into opt *)
+ p_stderr (Options.string_of_opt Options.opt);
try
- match inBuff with
- | None -> raise (CompilerError("File open error :" ^ opt.infile))
- | Some inBuffer ->
- let lexbuf = Lexing.from_channel inBuffer in
- lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = opt.infile };
- try
- let p = Parser.prog Lexer.lex lexbuf in
- (* p_stdout ("Decl:" ^ nl ^ T_Dump.of_prog p); *)
-
- let com = T_Check.tc_prog inBuffer p in
-
- if opt.d_ast then
- p_stderr ("Raw AST:" ^ nl ^ Dump.of_com com ^ nl);
- if opt.d_past then
- p_stderr ("Pretty AST:" ^ nl ^ Dump.pretty_of_com 0 com ^ nl);
-
- let code = Compile.compile_program com in
- if opt.d_code then
- p_stderr ("Raw Code : \n" ^ of_code false code ^ nl);
- if opt.d_pcode then
- p_stderr ("Pretty Code : \n" ^ of_code true code ^ nl);
-
- let st_0 = State.const (Z.of_int 0) in (* assume all variables 0 *)
-
- (* imp_ex execution *)
- if opt.imp_ex then (
- try
- p_stdout ("Execute : imp_ex" );
- let st_end = Imp_Ex.ceval_ex st_0 com in
- p_stdout ("ceval_ex" ^ nl ^ Env.to_string st_end ^ nl);
- with
- | _ -> p_stdout "ceval : Exited with an error\n";
- );
-
- (* vm_ex execution *)
- if opt.vm_ex then (
- try
- let _ = Vm_Ex.instr_iter_ex code (VMS (Z.of_int 0, [], st_0)) in
- ()
- with
- | Vm_Ex.Err -> p_stderr ("execution error")
- | Vm_Ex.Halt (VMS (pos, stack, st_halt)) ->
- p_stdout ("execution halted");
- p_stdout ("instr_iter_ex" ^ nl ^ Env.to_string st_halt ^ nl);
- ()
- );
-
- p_stdout ("Done!");
+ let inBuffer = open_in Options.opt.infile in
+ let lexbuf = Lexing.from_channel inBuffer in
+ lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = Options.opt.infile };
+ try
+ let p = Parser.prog Lexer.lex lexbuf in
+ (* (* Comment out to get a Dump of the T_Imp with (some) span information *)
+
+ p_stdout ("Decl:" ^ nl ^ T_Dump.of_prog p);
+ *)
+
+ let com = T_Check.tc_prog inBuffer p in
+
+ if Options.opt.d_ast then
+ p_stderr ("Raw AST:" ^ nl ^ Dump.of_com com ^ nl);
+ if Options.opt.d_past then
+ p_stderr ("Pretty AST:" ^ nl ^ Dump.pretty_of_com 0 com ^ nl);
+
+ let code = Compile.compile_program com in
+ if Options.opt.d_code then
+ p_stderr ("Raw Code : \n" ^ Dump.of_code false code ^ nl);
+ if Options.opt.d_pcode then
+ p_stderr ("Pretty Code : \n" ^ Dump.of_code true code ^ nl);
+
+ let st_0 = State.const (Z.of_int 0) in (* assume all variables 0 *)
+
+ (* imp_ex execution *)
+ if Options.opt.imp_ex then (
+ try
+ p_stdout ("Execute : imp_ex" );
+ let st_end = Imp_Ex.ceval_ex st_0 com in
+ p_stdout ("ceval_ex" ^ nl ^ Env.to_string st_end ^ nl);
+ with
+ | _ -> p_stdout "ceval : Exited with an error\n";
+ );
+
+ (* vm_ex execution *)
+ if Options.opt.vm_ex then (
+ try
+ let _ = Vm_Ex.instr_iter_ex code (VMS (Z.of_int 0, [], st_0)) in
+ ()
+ with
+ | Vm_Ex.Err -> p_stderr ("execution error")
+ | Vm_Ex.Halt (VMS (pos, stack, st_halt)) ->
+ p_stdout ("execution halted");
+ p_stdout ("instr_iter_ex" ^ nl ^ Env.to_string st_halt ^ nl);
+ ()
+ );
+
+ p_stdout ("Done!");
+
+ with
+ | Lexer.SyntaxError msg ->
+ raise (CompilerError ("Syntax error. " ^ msg ^ Error.parse_err_msg inBuffer lexbuf));
+ | Parser.Error ->
+ raise (CompilerError ("Parser error." ^ Error.parse_err_msg inBuffer lexbuf));
- with
- | Lexer.SyntaxError msg -> raise (CompilerError ("Syntax error. " ^ msg ^ parse_err_msg lexbuf));
- | Parser.Error ->
- raise (CompilerError ("Parser error." ^ parse_err_msg lexbuf));
- (* raise (CompilerError ("Parser error.")); *)
with
| CompilerError msg -> p_stderr msg;
+ exit (-1);
| Failure msg -> p_stderr ("Failure (internal error): " ^ msg);
+ exit (-1);
+ | Sys_error msg -> p_stderr("File open error :" ^ Options.opt.infile ^ msg);
exit (-1);;
diff --git a/Error.ml b/Error.ml
index d48c0d55d476114bcaeebc81170c67325b4d2827..a5057c0f1ed43ea33f4301af070b1e56636a940d 100644
--- a/Error.ml
+++ b/Error.ml
@@ -20,14 +20,27 @@ let ci = {
let next_line lexbuf = Lexing.new_line lexbuf
-let parse_err_msg lexbuf =
- let pos = lexbuf.lex_curr_p in
- let index = pos.pos_cnum - pos.pos_bol -1 in
- " File " ^ pos.pos_fname ^
- " : Line " ^ string_of_int pos.pos_lnum ^
- " : Position " ^ string_of_int index ^ nl ^
- submatch (Bytes.to_string lexbuf.lex_buffer) pos.pos_bol '\n' ^ nl ^
- (String.make index ' ' ) ^ "^" ^ nl
+let parse_err_msg ch lexbuf =
+ try
+ let pos = lexbuf.lex_curr_p in
+ let index = pos.pos_cnum - pos.pos_bol -1 in
+ let info =
+ " File " ^ pos.pos_fname ^
+ " : Line " ^ string_of_int pos.pos_lnum ^
+ " : Position " ^ string_of_int index ^ nl in
+ let _ = seek_in ch pos.pos_bol in
+ let line = input_line ch in (* might raise End_of_file *)
+ info ^ line ^ nl ^
+ (String.make index ' ' ) ^ "^" ^ nl
+ with
+ End_of_file ->
+ let pos = lexbuf.lex_curr_p in
+ let index = pos.pos_cnum - pos.pos_bol -1 in
+
+ " File " ^ pos.pos_fname ^
+ " : Line " ^ string_of_int pos.pos_lnum ^
+ " : Position " ^ string_of_int index ^ nl ^
+ " Error at EOF" ^ nl
let set_info lexbuf =
let pos = lexbuf.lex_curr_p in
diff --git a/README.md b/README.md
index 9a7415653e79b893ba3d9c1164da7092bf329111..149099a5d0c309ef9dfc9785b93555025a4cea68 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,31 @@
# Cimp, compiler harness for D7011E, Compiler Construction
+This (new) version includes span information in the 'T_Imp.ml' AST, along with a simle type checker.
+
+## Todo:
+
+The examples are not updated, you need to add type information, e.g.
+
+```
+(* tc_1.imp passes type checking *)
+a : SINT; (* types must be declared *)
+b : UINT32;
+a := a + 1;
+b := b +u 1
+```
+
+and
+```
+(* tc_2.imp fails type checking *)
+a : SINT; (* types must be declared *)
+b : UINT32;
+a := a + 1;
+b := a +u 1
+
+Type error: Expected UINT32 got SINT in:<105..106> a
+in command: <100..111> b := a +u 1
+```
+
## Requirements:
Dependencies:
@@ -117,6 +143,9 @@ Files:
├── Lexer.mll Lexer rules
├── Options.ml Command line options (used by Cmd)
├── Parser.mly Parser rules
+├── T_Check.ml Type checker
+├── T_Dump.ml Printing of T_AST (the input language AST)
+├── T_Imp.ml The input language AST
├── README.md This file
├── _build Build directory for OCaml
├── examples Some examples
diff --git a/T_Check.ml b/T_Check.ml
index 566f79541a1f6c9963ea278dc9faf4f344848f00..c3832e7f5e935854a218e6383c30c504115c0753 100644
--- a/T_Check.ml
+++ b/T_Check.ml
@@ -10,28 +10,34 @@ open State__State
module Imp = Imp__Imp
+(* converting a span to a string *)
let of_span inb (start, stop) =
let _ = seek_in inb start in
let s = really_input_string inb (stop - start) in
"<" ^ string_of_int start ^ ".." ^ string_of_int stop ^ "> " ^ s
+(* report a duplicate definition *)
let unique_id chan (id1, (t1, s1)) (id2, (t2, s2)) =
if id1 = id2 then
raise (CompilerError("Dupclicate variable definition: " ^
of_span chan s1 ^ " already declared at " ^ of_span chan s2))
else ()
+(* build a type environment in acc *)
let rec idt_acc ch sp acc = function
- | Dseq (d1, d2) -> (idt_acc_span ch (idt_acc_span ch acc d1) d2)
- | Ddecl (id, t) -> List.iter (unique_id ch (id, (t, sp))) acc;
+ | Dseq (d1, d2) ->
+ idt_acc_span ch (idt_acc_span ch acc d1) d2
+ | Ddecl (id, t) ->
+ (* check that the identifier is not yet declared *)
+ List.iter (unique_id ch (id, (t, sp))) acc;
+ (* add the identifier to acc *)
(id, (t, sp)) :: acc
-
and idt_acc_span c acc (d, s) = idt_acc c s acc d
let of_idt ch (id, (t,s)) =
of_id id ^ ":" ^ of_types t ^ of_span ch s
-
+(* unify t2 to be compatible to the expected type t1 *)
let tc_unify ch t1 t2 s2 : types =
match t1, t2 with
| Tsint, Tsint -> Tsint
@@ -43,6 +49,7 @@ let tc_unify ch t1 t2 s2 : types =
"Type error: Expected " ^ of_types t1 ^
" got " ^ of_types t2 ^ " in:" ^ of_span ch s2))
+(* unify types t1 and t2 *)
let tc_unify2 ch t1 s1 t2 s2 : types =
match t1, t2 with
| Tsint, Tsint -> Tsint
@@ -54,6 +61,7 @@ let tc_unify2 ch t1 s1 t2 s2 : types =
"Type error: " ^ of_types t1 ^ " in:" ^ of_span ch s1 ^
" does not match " ^ of_types t2 ^ " in:" ^ of_span ch s2))
+(* lookup of identifier id in the type environment itl *)
let get_id_type itl (id : id) : types * span =
try
List.assoc id itl
diff --git a/imp_programs/tc_1.imp b/imp_programs/tc_1.imp
new file mode 100644
index 0000000000000000000000000000000000000000..6240197afa74ad1220851ae1f29c04896e335f8d
--- /dev/null
+++ b/imp_programs/tc_1.imp
@@ -0,0 +1,5 @@
+(* tc_1.imp passes type checking *)
+a : SINT; (* types must be declared *)
+b : UINT32;
+a := a + 1;
+b := b +u 1
\ No newline at end of file
diff --git a/imp_programs/tc_2.imp b/imp_programs/tc_2.imp
new file mode 100644
index 0000000000000000000000000000000000000000..0a9dcc7baf91613b3764e5d5c5e816321dbae789
--- /dev/null
+++ b/imp_programs/tc_2.imp
@@ -0,0 +1,5 @@
+(* tc_2.imp fails type checking *)
+a : SINT; (* types must be declared *)
+b : UINT32;
+a := a + 1;
+b := a +u 1
\ No newline at end of file