From a21389063aa328685e625a2a111c47ab19acb731 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 18 Aug 2022 22:02:52 -0400
Subject: [PATCH] feat(log): if Profile is enabled, forward messages to it

---
 src/util/Log.ml | 17 +++++++++++++++--
 src/util/dune   |  2 +-
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/util/Log.ml b/src/util/Log.ml
index 9aa129fb..0a116641 100644
--- a/src/util/Log.ml
+++ b/src/util/Log.ml
@@ -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)
diff --git a/src/util/dune b/src/util/dune
index c1ccf9b6..44b960dc 100644
--- a/src/util/dune
+++ b/src/util/dune
@@ -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))