From 18fd68f60a3b451fd7aa939a7a54fc9c0fe93f04 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Fri, 10 Jan 2020 15:46:28 -0800
Subject: [PATCH] [sledge] Add Trace.infok

Summary:
Trace.infok is like Trace.info but accepts a polymorphic printf
continuation instead of directly taking a format string and its
args. This is useful to write wrappers such as:
```
let trace k = [%Trace.infok k]
```

Reviewed By: ngorogiannis

Differential Revision: D19221883

fbshipit-source-id: 88e939b26
---
 sledge/src/ppx_trace/ppx_trace.ml | 4 ++--
 sledge/src/trace/trace.ml         | 3 +++
 sledge/src/trace/trace.mli        | 7 +++++--
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/sledge/src/ppx_trace/ppx_trace.ml b/sledge/src/ppx_trace/ppx_trace.ml
index 1d7f24163..411738550 100644
--- a/sledge/src/ppx_trace/ppx_trace.ml
+++ b/sledge/src/ppx_trace/ppx_trace.ml
@@ -88,8 +88,8 @@ let mapper =
     | Pexp_extension ({txt= "debug"; loc}, PStr []) -> ebool ~loc !debug
     | Pexp_extension
         ( { txt=
-              ( "Trace.info" | "Trace.printf" | "Trace.fprintf"
-              | "Trace.kprintf" ) as txt
+              ( "Trace.info" | "Trace.infok" | "Trace.printf"
+              | "Trace.fprintf" | "Trace.kprintf" ) as txt
           ; loc }
         , PStr [{pstr_desc= Pstr_eval (arg, []); _}] ) ->
         if not !debug then eunit ~loc:exp.pexp_loc
diff --git a/sledge/src/trace/trace.ml b/sledge/src/trace/trace.ml
index dcad48441..4de7f6956 100644
--- a/sledge/src/trace/trace.ml
+++ b/sledge/src/trace/trace.ml
@@ -146,6 +146,9 @@ let info mod_name fun_name fmt =
     Format.kfprintf (fun fs -> Format.fprintf fs "@]") fs fmt )
   else Format.ifprintf fs fmt
 
+let infok mod_name fun_name k =
+  k {pf= (fun fmt -> info mod_name fun_name fmt)}
+
 let incf mod_name fun_name fmt =
   if enabled mod_name fun_name then (
     Format.fprintf fs "@\n@[<2>@[<hv 2>( %s:@ " fun_name ;
diff --git a/sledge/src/trace/trace.mli b/sledge/src/trace/trace.mli
index c58469d41..c136bc2af 100644
--- a/sledge/src/trace/trace.mli
+++ b/sledge/src/trace/trace.mli
@@ -51,10 +51,13 @@ val kprintf : string -> string -> (Formatter.t -> unit) -> 'a printf
 val info : string -> string -> 'a printf
 (** Emit a message at the current indentation level, if enabled. *)
 
-val call : string -> string -> (pf -> 'b) -> 'b
+val infok : string -> string -> (pf -> 'a) -> 'a
+(** Emit a message at the current indentation level, if enabled. *)
+
+val call : string -> string -> (pf -> 'a) -> 'a
 (** Increase indentation level and emit a message, if enabled. *)
 
-val retn : string -> string -> (pf -> 'b -> unit) -> 'b -> 'b
+val retn : string -> string -> (pf -> 'a -> unit) -> 'a -> 'a
 (** Decrease indentation level and emit a message, if enabled. *)
 
 val flush : unit -> unit