src/logger.ml

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