type checker commented

Cimp.ml

@@ -3,11 +3,6 @@
 
 (* local files *)
 open Common 
-open Options
-open Error
-open Cmd
-open Dump
-open Env
 
 (* extracted code (/extract) *)
 module Compile = Compiler__Compile_com
@@ -18,42 +13,36 @@ 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 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 = opt.infile };
+    lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = Options.opt.infile };
     try
       let p = Parser.prog Lexer.lex lexbuf in
-        (* p_stdout ("Decl:" ^ nl ^ T_Dump.of_prog p); *)
+      (* (* 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 opt.d_ast then
+      if Options.opt.d_ast then
         p_stderr ("Raw AST:" ^ nl ^ Dump.of_com com ^ nl);
-        if opt.d_past then
+      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 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);
+      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 opt.imp_ex then (
+      if Options.opt.imp_ex then (
         try
           p_stdout ("Execute : imp_ex" );
           let st_end = Imp_Ex.ceval_ex st_0 com in
@@ -63,7 +52,7 @@ let () =
       );
 
       (* vm_ex execution *)
-        if opt.vm_ex then (
+      if Options.opt.vm_ex then (
         try
           let _ = Vm_Ex.instr_iter_ex code (VMS (Z.of_int 0, [], st_0)) in
           ()
@@ -78,12 +67,16 @@ let () =
       p_stdout ("Done!");
 
     with
-      | Lexer.SyntaxError msg -> raise (CompilerError ("Syntax error. " ^ msg ^ parse_err_msg lexbuf));
+    | Lexer.SyntaxError msg -> 
+      raise (CompilerError ("Syntax error. " ^ msg ^ Error.parse_err_msg inBuffer lexbuf));
     | Parser.Error -> 
-        raise (CompilerError ("Parser error." ^ parse_err_msg lexbuf)); 
-        (* raise (CompilerError ("Parser error.")); *)
+      raise (CompilerError ("Parser error." ^ Error.parse_err_msg inBuffer lexbuf));
+
   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);;
 

Error.ml

@@ -20,14 +20,27 @@ let ci = {
 
 let next_line lexbuf = Lexing.new_line lexbuf
 
-let parse_err_msg lexbuf =
+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 ^
-  submatch (Bytes.to_string lexbuf.lex_buffer) pos.pos_bol '\n' ^ nl ^
+      " : 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

README.md

 # 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

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

imp_programs/tc_1.imp

+(* 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

imp_programs/tc_2.imp

+(* 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