Location: significantly rework the code printing errors and warnings

1 files changed, 18 insertions, 10 deletions

diff --git a/tools/caml_tex.ml b/tools/caml_tex.ml
index e110e3e7cf..246d46b461 100644
--- a/tools/caml_tex.ml
+++ b/tools/caml_tex.ml
@@ -132,13 +132,25 @@ module Toplevel = struct
     if startchar >= 0 then
       locs := (startchar, endchar) :: !locs
 
+  (** Record the main location instead of printing it *)
+  let printer_register_locs =
+    { Location.batch_mode_printer with
+      pp_main_loc = (fun _ _ _ loc -> register_loc loc) }
+
   (** Capture warnings and keep them in a list *)
   let warnings = ref []
-  let print_warning loc _ppf w =
-    if Warnings.report w <> `Inactive then register_loc loc;
-    Location.default_warning_printer loc (snd warning_fmt) w;
-    let w = flush_fmt warning_fmt in
-    warnings := w :: !warnings
+  let report_printer =
+    (* Extend [printer_register_locs] *)
+    let pp self ppf report =
+      match report.Location.kind with
+      | Location.Report_warning _ | Location.Report_warning_as_error _ ->
+          printer_register_locs.pp self (snd warning_fmt) report;
+          let w = flush_fmt warning_fmt in
+          warnings := w :: !warnings
+      | _ ->
+          printer_register_locs.pp self ppf report
+    in
+    { printer_register_locs with pp }
 
   let fatal ic oc fmt =
     Format.kfprintf
@@ -146,14 +158,10 @@ module Toplevel = struct
       self_error_fmt ("@[<hov 2>  Error " ^^ fmt)
 
   let init () =
-    Location.printer := (fun _ _ -> ());
-    Location.warning_printer := print_warning;
+    Location.report_printer := (fun () -> report_printer);
     Clflags.color := Some Misc.Color.Never;
     Clflags.no_std_include := true;
     Compenv.last_include_dirs := [Filename.concat !repo_root "stdlib"];
-    Location.error_reporter :=
-      (fun _ e -> register_loc e.loc;
-        Location.default_error_reporter (snd error_fmt) e);
     Compmisc.init_path false;
     try
       Toploop.initialize_toplevel_env ();