From ef0effeb1fe3aabe3211591371e936277733ebf1 Mon Sep 17 00:00:00 2001
From: Arnaud DABY-SEESARAM <ds-ac@crans.org>
Date: Tue, 13 Dec 2022 10:26:55 +0100
Subject: [PATCH] improvement over error messages (with code ;) )

---
 src/main.ml |  8 +++++---
 src/pp.ml   | 25 +++++++++++++++++++------
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/src/main.ml b/src/main.ml
index 5ff0068..5d85cfa 100644
--- a/src/main.ml
+++ b/src/main.ml
@@ -65,19 +65,21 @@ let _ =
   (** Main functionality below *)
   print_verbose "Parsing the source file...";
   let ast =
+    let inchan = open_in !source_file in
     try
       begin
-      let inchan = open_in !source_file in
       let res = Parser.main Lexer.token (Lexing.from_channel inchan) in
       close_in inchan; res
       end
     with
     | Lexer.Lexing_error s ->
-        (exit_error (Format.sprintf "Error code:\n\t%s\n\n" s); exit 0)
+        (close_in_noerr inchan;
+          exit_error (Format.sprintf "Error code:\n\t%s\n\n" s); exit 0)
     | Utils.MyParsingError (s, l) ->
       begin
+        close_in_noerr inchan;
         Format.printf "Syntax error at %a: %s\n\n"
-          Pp.pp_loc l s;
+          Pp.pp_loc (l, !source_file) s;
         exit 0
       end in
 
diff --git a/src/pp.ml b/src/pp.ml
index a4b0c43..cda000b 100644
--- a/src/pp.ml
+++ b/src/pp.ml
@@ -6,12 +6,25 @@ open Ast
   | TBool :: t -> Format.fprintf fmt "bool %a" debug_type_pp t
   | TReal :: t -> Format.fprintf fmt "real %a" debug_type_pp t
 
-let pp_loc fmt (start, stop) =
-  Lexing.(
-    Format.fprintf fmt "%s: <l: %d, c: %d> -- <l: %d, c: %d>"
-      start.pos_fname
-      start.pos_lnum start.pos_cnum
-      stop.pos_lnum stop.pos_cnum)
+let pp_loc fmt ((start, stop), file) =
+  let spos, epos = 
+    Lexing.(start.pos_cnum, stop.pos_cnum) in
+  let f = open_in file in
+  try
+    begin
+      let rec aux linenum curpos =
+        let line = input_line f in
+        let nextpos = curpos + (String.length line) + 1 in
+        if nextpos >= epos then
+          Format.fprintf fmt "<line %d: %s >" linenum line
+        else
+          aux (linenum + 1) nextpos
+        in
+      aux 1 0;
+      close_in f
+    end
+  with e ->
+    (close_in_noerr f; Format.fprintf fmt "???")
 
 let rec pp_varlist fmt : t_varlist -> unit = function
   | ([], []) -> ()