Skip the faulty location when reading the whole compiled file

4 files changed, 62 insertions, 56 deletions

diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index 0459fe2..1d846e0 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -38,6 +38,39 @@ let filter_report : filters -> Report.t list -> Report.t -> Report.t list =
 
   match is_ok with true -> r :: reports | _ -> reports
 
+(** Read the source file until getting a report (the whole location has been
+    read properly), or until the first syntax error. 
+    *)
+let parse_location :
+    (module Qparser.Lexer.Encoding) -> Sedlexing.lexbuf -> filters -> unit =
+ fun encoding lexbuf filters ->
+  let result =
+    Qparser.Analyzer.parse (module Qsp_syntax.Type_of) encoding lexbuf
+  in
+
+  let result =
+    Result.map
+      (fun f -> List.fold_left (f []) ~init:[] ~f:(filter_report filters))
+      result
+  in
+  match result with
+  | Ok report -> (
+      (* Display the result *)
+      match report with
+      | [] -> ()
+      | _ ->
+          let start_position, _ = Sedlexing.lexing_positions lexbuf in
+          Format.fprintf Format.std_formatter "Location %s@;@[%a@]@."
+            start_position.Lexing.pos_fname pp_result report;
+          let () =
+            match Sys.os_type with "Win32" -> ignore @@ read_line () | _ -> ()
+          in
+          ())
+  | Error e ->
+      let start_position, _ = Sedlexing.lexing_positions lexbuf in
+      Format.fprintf Format.std_formatter "Location %s@;@[%a]@."
+        start_position.Lexing.pos_fname Report.pp e
+
 let () =
   let file_names, filters = Args.parse () in
   let file_name = List.hd file_names in
@@ -53,32 +86,19 @@ let () =
     | ".txt" ->
         ( Sedlexing.Utf16.from_channel ic (Some Little_endian),
           (module struct
-            let lexeme lexbuf = Sedlexing.Utf16.lexeme lexbuf Little_endian true
+            let lexeme lexbuf = Sedlexing.Utf8.lexeme lexbuf
           end : Qparser.Lexer.Encoding) )
     | _ -> raise (Failure "unknown extension")
   in
 
-  let result = Qparser.Analyzer.parse (module Qsp_syntax.Type_of) mod_ lexer in
-  match result with
-  | Ok f -> (
-      let report = List.fold_left (f []) ~init:[] ~f:(filter_report filters) in
-
-      (* Display the result *)
-      match report with
-      | [] -> exit 0
-      | _ ->
-          Format.fprintf Format.std_formatter "Location %s@;%a@." file_name
-            pp_result report;
-          let () =
-            match Sys.os_type with "Win32" -> ignore @@ read_line () | _ -> ()
-          in
-          exit 1)
-  | Error e ->
-      Format.fprintf Format.std_formatter "\nError in location %s\n%a" file_name
-        Qparser.Analyzer.format_error e;
-
-      let () =
-        match Sys.os_type with "Win32" -> ignore @@ read_line () | _ -> ()
-      in
-
-      exit 1
+  let () =
+    try
+      while true do
+        parse_location mod_ lexer filters
+      done
+    with Qparser.Lexer.EOF -> ()
+  in
+  let () =
+    match Sys.os_type with "Win32" -> ignore @@ read_line () | _ -> ()
+  in
+  ()
diff --git a/lib/analyzer.ml b/lib/analyzer.ml
index e4fc272..a6f5e51 100644
--- a/lib/analyzer.ml
+++ b/lib/analyzer.ml
@@ -1,21 +1,3 @@
-type error = {
-  message : string;
-  start_pos : Lexing.position;
-  end_pos : Lexing.position;
-}
-(** Error reported when the syntax is invalid *)
-
-let format_error : Format.formatter -> error -> unit =
- fun f e ->
-  let start_c = e.start_pos.Lexing.pos_cnum - e.start_pos.Lexing.pos_bol
-  and end_c = e.end_pos.Lexing.pos_cnum - e.end_pos.Lexing.pos_bol
-  and start_line = e.start_pos.Lexing.pos_lnum
-  and end_line = e.end_pos.Lexing.pos_lnum in
-
-  if start_line != end_line then
-    Format.fprintf f "Lines %d-%d %s" start_line end_line e.message
-  else Format.fprintf f "Line %d %d:%d %s" start_line start_c end_c e.message
-
 (** 
     Run the QSP parser and apply the analyzer over it.
 
@@ -25,7 +7,7 @@ let parse :
     (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) ->
     (module Encoding.S) ->
     Sedlexing.lexbuf ->
-    ('a, error) Result.t =
+    ('a, Qsp_syntax.Report.t) Result.t =
  fun (type a) (module S : Qsp_syntax.S.Analyzer with type Location.repr = a)
      (module E : Encoding.S) ->
   let module Parser = Parser.Make (S) in
@@ -39,10 +21,22 @@ let parse :
            let message =
              match e.IncrementalParser.code with
              | Interpreter.InvalidSyntax -> "Invalid Syntax"
+             | Interpreter.UnrecoverableError -> "UnrecoverableError"
              | Interpreter.MenhirCode c ->
                  String.concat ""
                    [
-                     "(Code "; string_of_int c; ")\n"; Parser_messages.message c;
+                     String.trim @@ Parser_messages.message c;
+                     " (Error code ";
+                     string_of_int c;
+                     ")";
                    ]
            in
-           { message; start_pos = e.start_pos; end_pos = e.end_pos })
+           let report =
+             Qsp_syntax.Report.error (e.start_pos, e.end_pos) message
+           in
+
+           (* Discard the remaining file to read. The parser is now in a blank
+              state, it does not make sense to keep feeding it with the new
+              tokens. *)
+           Lexer.discard lexbuf;
+           report)
diff --git a/lib/analyzer.mli b/lib/analyzer.mli
index 43509ba..e7efdb0 100644
--- a/lib/analyzer.mli
+++ b/lib/analyzer.mli
@@ -1,16 +1,8 @@
-type error = {
-  message : string;
-  start_pos : Lexing.position;
-  end_pos : Lexing.position;
-}
-
-val format_error : Format.formatter -> error -> unit
-
 val parse :
   (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) ->
   (module Encoding.S) ->
   Sedlexing.lexbuf ->
-  ('a, error) Result.t
+  ('a, Qsp_syntax.Report.t) Result.t
 (** Read the source and build a analyzis over it. 
 
 This method make the link between the source file and how to read it
diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml
index c37c7f1..3e4a96b 100644
--- a/test/qsp_parser_test.ml
+++ b/test/qsp_parser_test.ml
@@ -20,7 +20,7 @@ let parse : string -> T.pos location =
   with
   | Ok e -> e
   | Error e ->
-      let msg = Format.asprintf "%a" Qparser.Analyzer.format_error e in
+      let msg = Format.asprintf "%a" Qsp_syntax.Report.pp e in
       raise (Failure msg)
 
 let location : T.pos location Alcotest.testable =