Commit 0ccf090d authored by Per Lindgren's avatar Per Lindgren

type checker commented

parent 9b126046
......@@ -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);;
......@@ -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
......
# 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
......
......@@ -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
......
(* 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
(* 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment