[sledge] Add Trace.{printf,fprintf,kprintf}

Reviewed By: mbouaziz

Differential Revision: D10389478

fbshipit-source-id: 4fd3ff6da

sledge/src/ppx_trace/ppx_trace.ml

@@ -81,15 +81,10 @@ let mapper =
     match exp.pexp_desc with
     | Pexp_extension ({txt= "debug"; loc}, PStr []) -> ebool ~loc !debug
     | Pexp_extension
-        ( {txt= "Trace.call"; loc= call_loc}
+        ( { txt=
-        , PStr [{pstr_desc= Pstr_eval (call_fun, []); _}] ) ->
+              ( "Trace.info" | "Trace.printf" | "Trace.fprintf"
-        if not !debug then eunit ~loc:exp.pexp_loc
+              | "Trace.kprintf" ) as txt
-        else
+          ; loc }
-          pexp_apply ~loc:exp.pexp_loc
-            (evar ~loc:call_loc "Trace.call")
-            (append_here_args [(Nolabel, call_fun)])
-    | Pexp_extension
-        ( {txt= "Trace.info"; loc= info_loc}
         , PStr [{pstr_desc= Pstr_eval (arg, []); _}] ) ->
         if not !debug then eunit ~loc:exp.pexp_loc
         else
@@ -98,9 +93,16 @@ let mapper =
             | Pexp_apply (op, args) -> (Nolabel, op) :: args
             | _ -> [(Nolabel, arg)]
           in
-          pexp_apply ~loc:exp.pexp_loc
+          pexp_apply ~loc:exp.pexp_loc (evar ~loc txt)
-            (evar ~loc:info_loc "Trace.info")
             (append_here_args args)
+    | Pexp_extension
+        ( {txt= "Trace.call"; loc= call_loc}
+        , PStr [{pstr_desc= Pstr_eval (call_fun, []); _}] ) ->
+        if not !debug then eunit ~loc:exp.pexp_loc
+        else
+          pexp_apply ~loc:exp.pexp_loc
+            (evar ~loc:call_loc "Trace.call")
+            (append_here_args [(Nolabel, call_fun)])
     | Pexp_extension
         ( {txt= "Trace.retn"; loc= retn_loc}
         , PStr [{pstr_desc= Pstr_eval (retn_fun, []); _}] ) ->

sledge/src/trace/trace.ml

@@ -54,6 +54,16 @@ let enabled mod_name fun_name =
       | None -> trace_all ) )
   | None -> trace_all
 
+let kprintf mod_name fun_name k fmt =
+  if enabled mod_name fun_name then Format.kfprintf k fs fmt
+  else Format.ifprintf fs fmt
+
+let fprintf mod_name fun_name fs fmt =
+  if enabled mod_name fun_name then Format.fprintf fs fmt
+  else Format.ifprintf fs fmt
+
+let printf mod_name fun_name fmt = fprintf mod_name fun_name fs fmt
+
 let info mod_name fun_name fmt =
   if enabled mod_name fun_name then (
     Format.fprintf fs "@\n@[<2>| " ;

sledge/src/trace/trace.mli

@@ -27,6 +27,15 @@ val init : ?margin:int -> config:config -> unit -> unit
 type 'a printf = ('a, Formatter.t, unit) format -> 'a
 type pf = {pf: 'a. 'a printf}
 
+val printf : string -> string -> 'a printf
+(** Like [Format.printf], if enabled, otherwise like [Format.iprintf]. *)
+
+val fprintf : string -> string -> Formatter.t -> 'a printf
+(** Like [Format.fprintf], if enabled, otherwise like [Format.ifprintf]. *)
+
+val kprintf : string -> string -> (Formatter.t -> unit) -> 'a printf
+(** Like [Format.kprintf], if enabled, otherwise like [Format.ifprintf]. *)
+
 val info : string -> string -> 'a printf
 (** Emit a message at the current indentation level, if enabled. *)