src/logger.ml

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