Skip the faulty location when reading the whole compiled file

1 files changed, 45 insertions, 25 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
+  ()