src/logger.ml

   1 open Format
   2
   3 type t = string
   4 type level = int
   5
   6 let loggers = [ "top-down-run";
   7                 "top-down-approx";
   8                 "result-set";
   9                 "level2-jit";
  10                 "res-jit";
  11                 "grammar";
  12                 "twopass";
  13                 "transition";
  14                 "bottom-up" ]
  15 let active_loggers : (t, int) Hashtbl.t = Hashtbl.create 17
  16 let margin = List.fold_left (fun m l -> max m (String.length l)) 0 loggers
  17 let available () = loggers
  18
  19 let is_logger s = List.mem s loggers
  20 let level s = try Hashtbl.find active_loggers s with Not_found -> 0
  21 let is_active s = Hashtbl.mem active_loggers s
  22 let activate s lvl = if not (is_active s) then Hashtbl.add active_loggers s lvl
  23 let deactivate s = Hashtbl.remove active_loggers s
  24
  25 let logger_output = ref err_formatter
  26 let set_output f = logger_output := f
  27
  28 let log t l fmt =
  29   if l <= level t
  30   then begin
  31     pp_open_hovbox !logger_output (margin + 3);
  32     fprintf !logger_output "%-.*s : " margin t;
  33     kfprintf (fun _ ->
  34       pp_close_box !logger_output ();
  35       fprintf !logger_output "@?@\n";
  36     ) !logger_output fmt
  37   end
  38   else
  39     ifprintf !logger_output fmt
  40
  41 let print ppf fmt =
  42   pp_open_hovbox ppf 0;
  43   kfprintf (fun _ ->
  44     pp_close_box ppf ();
  45     fprintf ppf "@?")
  46     ppf fmt