feat(log): if Profile is enabled, forward messages to it

This commit is contained in:
Simon Cruanes 2022-08-18 22:02:52 -04:00
parent 2bd555d11b
commit a21389063a
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 16 additions and 3 deletions

View file

@ -7,12 +7,25 @@ let set_debug l = debug_level_ := l
let get_debug () = !debug_level_
let debug_fmt_ = ref Format.err_formatter
let set_debug_out f = debug_fmt_ := f
let buf_ = Buffer.create 128
let buf_fmt_ = Format.formatter_of_buffer buf_
let start_ = Unix.gettimeofday ()
(* does the printing, inconditionally *)
let[@inline never] debug_real_ l k =
k (fun fmt ->
Format.fprintf !debug_fmt_ "@[<2>@{<Blue>[%d|%.3f]@}@ " l (Sys.time ());
Format.kfprintf (fun fmt -> Format.fprintf fmt "@]@.") !debug_fmt_ fmt)
let now = Unix.gettimeofday () -. start_ in
Buffer.clear buf_;
let once_done _fmt =
Format.fprintf _fmt "@]@?";
let msg = Buffer.contents buf_ in
(* forward to profiling *)
if Profile.enabled () then Profile.instant msg;
Format.fprintf !debug_fmt_ "@[<2>@{<Blue>[%d|%.3f]@}@ %s@]@." l now msg
in
Format.fprintf buf_fmt_ "@[<2>";
Format.kfprintf once_done buf_fmt_ fmt)
let[@inline] debugf l k = if enabled && l <= !debug_level_ then debug_real_ l k
let[@inline] debug l msg = debugf l (fun k -> k "%s" msg)

View file

@ -2,4 +2,4 @@
(name sidekick_util)
(public_name sidekick.util)
(flags :standard -warn-error -a+8)
(libraries containers iter sidekick.sigs bigarray))
(libraries containers iter sidekick.sigs bigarray unix))