From 7c14a966d15aab098a4239b6ae6a3fc207504e7f Mon Sep 17 00:00:00 2001
From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Tue, 5 Jun 2018 21:14:22 -0400
Subject: [PATCH] Centralize error message construction

---
 compiler/src/exe/tigerc.ml                | 16 +++++++++-------
 compiler/src/lib/tiger/tiger.ml           |  1 +
 compiler/src/lib/tiger/tiger_error.ml     |  7 +++++++
 compiler/src/lib/tiger/tiger_error.mli    |  3 +++
 compiler/src/lib/tiger/tiger_parser.mly   |  5 ++++-
 compiler/src/lib/tiger/tiger_position.ml  | 12 ++++++++++++
 compiler/src/lib/tiger/tiger_position.mli |  2 ++
 7 files changed, 38 insertions(+), 8 deletions(-)
 create mode 100644 compiler/src/lib/tiger/tiger_error.ml
 create mode 100644 compiler/src/lib/tiger/tiger_error.mli

diff --git a/compiler/src/exe/tigerc.ml b/compiler/src/exe/tigerc.ml
index 708ff17..42fcf00 100644
--- a/compiler/src/exe/tigerc.ml
+++ b/compiler/src/exe/tigerc.ml
@@ -1,15 +1,17 @@
+let lexbuf_set_filename lb filename : unit =
+  let Lexing.({lex_start_p; lex_curr_p}) = lb in
+  lb.Lexing.lex_start_p <- {lex_start_p with Lexing.pos_fname = filename};
+  lb.Lexing.lex_curr_p  <- {lex_curr_p  with Lexing.pos_fname = filename}
+
 let () =
   let path_to_program_file = Sys.argv.(1) in
   let ic = open_in path_to_program_file in
   let lexbuf = Lexing.from_channel ic in
+  lexbuf_set_filename lexbuf path_to_program_file;
   (match Tiger.Parser.program Tiger.Lexer.token lexbuf with
-  | exception Parsing.Parse_error ->
-      let
-        Lexing.({lex_curr_p = {pos_lnum; pos_bol; pos_cnum; _}; _}) = lexbuf
-      in
-      Printf.printf
-        "Syntax error in file %S, around line: %d, column: %d\n"
-        path_to_program_file pos_lnum (pos_cnum - pos_bol)
+  | exception Tiger.Error.T msg ->
+      Printf.eprintf "%s\n" msg;
+      exit 1;
   | absyn ->
       print_endline (Tiger.Absyn.to_string absyn)
   );
diff --git a/compiler/src/lib/tiger/tiger.ml b/compiler/src/lib/tiger/tiger.ml
index 08eac82..2b415b0 100644
--- a/compiler/src/lib/tiger/tiger.ml
+++ b/compiler/src/lib/tiger/tiger.ml
@@ -1,4 +1,5 @@
 module Absyn  = Tiger_absyn
+module Error  = Tiger_error
 module Lexer  = Tiger_lexer
 module Parser = Tiger_parser
 module Parser_token = Tiger_parser_token
diff --git a/compiler/src/lib/tiger/tiger_error.ml b/compiler/src/lib/tiger/tiger_error.ml
new file mode 100644
index 0000000..eb2c177
--- /dev/null
+++ b/compiler/src/lib/tiger/tiger_error.ml
@@ -0,0 +1,7 @@
+module Pos = Tiger_position
+
+exception T of string
+
+let exn ~pos ~msg =
+  let msg = Printf.sprintf "Error: %s. In %s." msg (Pos.to_string pos) in
+  raise (T msg)
diff --git a/compiler/src/lib/tiger/tiger_error.mli b/compiler/src/lib/tiger/tiger_error.mli
new file mode 100644
index 0000000..25072b4
--- /dev/null
+++ b/compiler/src/lib/tiger/tiger_error.mli
@@ -0,0 +1,3 @@
+exception T of string
+
+val exn : pos:Tiger_position.t -> msg:string -> 'a
diff --git a/compiler/src/lib/tiger/tiger_parser.mly b/compiler/src/lib/tiger/tiger_parser.mly
index 1bb9388..78d56a0 100644
--- a/compiler/src/lib/tiger/tiger_parser.mly
+++ b/compiler/src/lib/tiger/tiger_parser.mly
@@ -73,7 +73,10 @@
 
 %%
 
-program: exp EOF { $1 };
+program:
+  | exp EOF { $1 }
+  | error {Tiger_error.exn ~pos:(pos ()) ~msg:"invalid syntax"}
+  ;
 
 exp:
   | NIL
diff --git a/compiler/src/lib/tiger/tiger_position.ml b/compiler/src/lib/tiger/tiger_position.ml
index 01c230c..217de6b 100644
--- a/compiler/src/lib/tiger/tiger_position.ml
+++ b/compiler/src/lib/tiger/tiger_position.ml
@@ -19,3 +19,15 @@ let of_lexing_positions
     ; end_char   = ecnum - ebol
     ; end_line   = eline
     }
+
+let to_string
+  { file
+  ; start_char
+  ; start_line
+  ; end_char
+  ; end_line
+  }
+=
+  Printf.sprintf
+    "file: %S, between (line/char) %d/%d and %d/%d"
+    file start_line start_char end_line end_char
diff --git a/compiler/src/lib/tiger/tiger_position.mli b/compiler/src/lib/tiger/tiger_position.mli
index dab4067..4f9d230 100644
--- a/compiler/src/lib/tiger/tiger_position.mli
+++ b/compiler/src/lib/tiger/tiger_position.mli
@@ -10,3 +10,5 @@ val of_lexing_positions
   :  pos_start:Lexing.position
   -> pos_end:Lexing.position
   -> t
+
+val to_string : t -> string
-- 
2.20.1