improvement over error messages (with code ;) )

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
 

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
   | ([], []) -> ()