[feedback] Add optional ?loc parameter to loggers.

This is a first step to relay location info in an uniform way, as needed
by warnings and other mechanisms.

The location info remains unused for now, but coqtop printing could take
advantage of it if so wished.

1 files changed, 13 insertions, 13 deletions

diff --git a/lib/feedback.ml b/lib/feedback.ml
index 74a18df6f..12b8b27ff 100644
--- a/lib/feedback.ml
+++ b/lib/feedback.ml
@@ -51,7 +51,7 @@ let default_route = 0
 open Pp
 open Pp_control
 
-type logger = level -> std_ppcmds -> unit
+type logger = ?loc:Loc.t -> level -> std_ppcmds -> unit
 
 let msgnl_with fmt strm = msg_with fmt (strm ++ fnl ())
 let msgnl          strm = msgnl_with !std_ft strm
@@ -84,7 +84,7 @@ let  err_str = str "Error:"   ++ spc ()
 let make_body quoter info s = quoter (hov 0 (info ++ s))
 
 (* Generic logger *)
-let gen_logger dbg err level msg = match level with
+let gen_logger dbg err ?loc level msg = match level with
   | Debug   -> msgnl (make_body dbg  dbg_str msg)
   | Info    -> msgnl (make_body dbg info_str msg)
   | Notice  -> msgnl msg
@@ -93,10 +93,10 @@ let gen_logger dbg err level msg = match level with
   | Error   -> msgnl_with !err_ft (make_body err  err_str msg)
 
 (** Standard loggers *)
-let std_logger   = gen_logger (fun x -> x) (fun x -> x)
+let std_logger  = gen_logger (fun x -> x) (fun x -> x)
 
 (* Color logger *)
-let color_terminal_logger level strm =
+let color_terminal_logger ?loc level strm =
   let msg = Ppstyle.color_msg in
   match level with
   | Debug   -> msg ~header:("Debug", Ppstyle.debug_tag) !std_ft strm
@@ -117,11 +117,11 @@ let emacs_logger = gen_logger emacs_quote_info emacs_quote_err
 let logger       = ref std_logger
 let set_logger l = logger := l
 
-let msg_info    x = !logger Info x
-let msg_notice  x = !logger Notice x
-let msg_warning x = !logger Warning x
-let msg_error   x = !logger Error x
-let msg_debug   x = !logger Debug x
+let msg_info    ?loc x = !logger Info x
+let msg_notice  ?loc x = !logger Notice x
+let msg_warning ?loc x = !logger Warning x
+let msg_error   ?loc x = !logger Error x
+let msg_debug   ?loc x = !logger Debug x
 
 (** Feeders *)
 let feeder = ref ignore
@@ -140,19 +140,19 @@ let feedback ?id ?route what =
      id    = Option.default !feedback_id id;
   }
 
-let feedback_logger lvl msg =
+let feedback_logger ?loc lvl msg =
   feedback ~route:!feedback_route ~id:!feedback_id
     (Message (lvl, Richpp.richpp_of_pp msg))
 
 (* Output to file *)
-let ft_logger old_logger ft level mesg =
+let ft_logger old_logger ft ?loc level mesg =
   let id x = x in
   match level with
   | Debug   -> msgnl_with ft (make_body id  dbg_str mesg)
   | Info    -> msgnl_with ft (make_body id info_str mesg)
   | Notice  -> msgnl_with ft mesg
-  | Warning -> old_logger level mesg
-  | Error   -> old_logger level mesg
+  | Warning -> old_logger ?loc level mesg
+  | Error   -> old_logger ?loc level mesg
 
 let with_output_to_file fname func input =
   let old_logger = !logger in