aboutsummaryrefslogtreecommitdiffhomepage
path: root/checker/checker.ml
diff options
context:
space:
mode:
authorGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2017-11-06 14:52:12 +0100
committerGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2017-11-06 14:55:21 +0100
commit4197eb4f94f0bd57b4e9cd391a19968eed373a0d (patch)
tree0087e7eb7d8bdc137c922aa923928e98ba724b06 /checker/checker.ml
parente029cf5b417b22ebc65a8193469bbbe450f725ce (diff)
[feedback] Helper to print feedback messages in the console.
This is useful for tools such as `coqchk` or `coq_makefile` that want to handle feedback on their own.
Diffstat (limited to 'checker/checker.ml')
-rw-r--r--checker/checker.ml37
1 files changed, 1 insertions, 36 deletions
diff --git a/checker/checker.ml b/checker/checker.ml
index 247a98e63..e960a55fd 100644
--- a/checker/checker.ml
+++ b/checker/checker.ml
@@ -367,46 +367,11 @@ let initialized = ref false
(* XXX: At some point we need to either port the checker to use the
feedback system or to remove its use completely. *)
-let init_feedback_listener () =
- let open Format in
- let pp_lvl fmt lvl = let open Feedback in match lvl with
- | Error -> fprintf fmt "Error: "
- | Info -> fprintf fmt "Info: "
- | Debug -> fprintf fmt "Debug: "
- | Warning -> fprintf fmt "Warning: "
- | Notice -> fprintf fmt ""
- in
- let pp_loc fmt loc = let open Loc in match loc with
- | None -> fprintf fmt ""
- | Some loc ->
- let where =
- match loc.fname with InFile f -> f | ToplevelInput -> "Toplevel input" in
- fprintf fmt "\"%s\", line %d, characters %d-%d:@\n"
- where loc.line_nb (loc.bp-loc.bol_pos) (loc.ep-loc.bol_pos) in
- let checker_feed (fb : Feedback.feedback) = let open Feedback in
- match fb.contents with
- | Processed -> ()
- | Incomplete -> ()
- | Complete -> ()
- | ProcessingIn _ -> ()
- | InProgress _ -> ()
- | WorkerStatus (_,_) -> ()
- | AddedAxiom -> ()
- | GlobRef (_,_,_,_,_) -> ()
- | GlobDef (_,_,_,_) -> ()
- | FileDependency (_,_) -> ()
- | FileLoaded (_,_) -> ()
- | Custom (_,_,_) -> ()
- (* Re-enable when we switch back to feedback-based error printing *)
- | Message (lvl,loc,msg) ->
- Format.eprintf "@[%a@]%a@[%a@]\n%!" pp_loc loc pp_lvl lvl Pp.pp_with msg
- in ignore(Feedback.add_feeder checker_feed)
-
let init_with_argv argv =
if not !initialized then begin
initialized := true;
Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *)
- init_feedback_listener ();
+ let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in
try
parse_args argv;
if !Flags.debug then Printexc.record_backtrace true;