diff --git a/infer/src/base/Logging.ml b/infer/src/base/Logging.ml
index 4fe94f451..b15e5e011 100644
--- a/infer/src/base/Logging.ml
+++ b/infer/src/base/Logging.ml
@@ -346,110 +346,93 @@ let setup_log_file () =
============================================================"
-(** delayable print action *)
-type print_action =
- | PTdecrease_indent : print_action
- | PTincrease_indent : print_action
- | PTstr : {s: string; color: Pp.color option; ln: bool} -> print_action
- | PTwarning : string -> print_action
- | PTerror : string -> print_action
- | PTinfo : string -> print_action
- | PT_generic : (Format.formatter -> 'a -> unit) * 'a -> print_action
- | PT_generic_with_pe :
- Pp.color option * (Pp.env -> Format.formatter -> 'a -> unit) * 'a
- -> print_action
+type delayed_prints = Buffer.t * F.formatter
-type delayed_prints = print_action list
+let new_delayed_prints () =
+ let b = Buffer.create 16 in
+ let f = F.formatter_of_buffer b in
+ (b, f)
-let delayed_actions = ref []
-let pp_with_html_color color pp fmt x =
- F.fprintf fmt "%a" (Pp.color_string color) pp x
+let delayed_prints = ref (new_delayed_prints ())
+(** reset the delayed prints *)
+let reset_delayed_prints () = delayed_prints := new_delayed_prints ()
-let pp_maybe_with_color ?color pp fmt x =
+(** return the delayed prints *)
+let get_and_reset_delayed_prints () =
+ let res = !delayed_prints in
+ reset_delayed_prints () ; res
+
+
+let force_and_reset_delayed_prints f =
+ let delayed_prints_buffer, delayed_prints_formatter = get_and_reset_delayed_prints () in
+ F.pp_print_flush delayed_prints_formatter () ;
+ F.pp_print_string f (Buffer.contents delayed_prints_buffer)
+
+
+(** set the delayed prints *)
+let set_delayed_prints new_delayed_prints = delayed_prints := new_delayed_prints
+
+let get_f () =
+ if Config.write_html then Some (snd !delayed_prints)
+ else if not Config.only_cheap_debug then Option.map ~f:fst !log_file
+ else None
+
+
+let d_kfprintf ?color k f fmt =
match color with
| Some color when Config.write_html ->
- pp_with_html_color color pp fmt x
+ F.fprintf f "" (Pp.color_string color) ;
+ F.kfprintf (fun f -> F.pp_print_string f "" ; k f) f fmt
| _ ->
- pp fmt x
-
-
-(** Execute the delayed print actions *)
-let force_delayed_print fmt = function
- | PTdecrease_indent ->
- F.pp_close_box fmt ()
- | PTincrease_indent ->
- F.fprintf fmt " @["
- | PTstr {s; color; ln} ->
- pp_maybe_with_color ?color F.pp_print_string fmt s ;
- if ln then F.pp_force_newline fmt ()
- | PTerror s ->
- pp_maybe_with_color ~color:Pp.Red (fun fmt -> F.fprintf fmt "ERROR: %s") fmt s
- | PTwarning s ->
- pp_maybe_with_color ~color:Pp.Orange (fun fmt -> F.fprintf fmt "WARNING: %s") fmt s
- | PTinfo s ->
- pp_maybe_with_color ~color:Pp.Blue (fun fmt -> F.fprintf fmt "INFO: %s") fmt s
- | PT_generic (pp, x) ->
- pp fmt x
- | PT_generic_with_pe (None, pp, x) ->
- let pe_default = if Config.write_html then Pp.html Black else Pp.text in
- pp pe_default fmt x
- | PT_generic_with_pe (Some color, pp, x) ->
- if Config.write_html then pp_with_html_color color (pp (Pp.html color)) fmt x
- else pp Pp.text fmt x
-
-
-(** reset the delayed print actions *)
-let reset_delayed_prints () = delayed_actions := []
-
-(** return the delayed print actions *)
-let get_and_reset_delayed_prints () =
- let res = !delayed_actions in
- reset_delayed_prints () ; res
+ F.kfprintf k f fmt
+
+
+let d_iprintf fmt = Format.ikfprintf ignore Format.err_formatter fmt
+
+let d_kprintf ?color k fmt =
+ match get_f () with Some f -> d_kfprintf ?color k f fmt | None -> d_iprintf fmt
-(** extend the current print log *)
-let add_print_action pact =
- if Config.write_html then delayed_actions := pact :: !delayed_actions
- else if not Config.only_cheap_debug then
- Option.iter !log_file ~f:(function file_fmt, _ -> force_delayed_print file_fmt pact)
+let d_kasprintf k fmt =
+ match get_f () with Some f -> F.kasprintf (fun s -> k f s) fmt | None -> d_iprintf fmt
-let d_pp pp x = add_print_action (PT_generic (pp, x))
+let d_printf ?color fmt = d_kprintf ?color ignore fmt
-let d_pp_with_pe ?color pp x = add_print_action (PT_generic_with_pe (color, pp, x))
+let k_force_newline f = F.pp_force_newline f ()
-let force_and_reset_delayed_prints fmt =
- get_and_reset_delayed_prints () |> List.rev |> List.iter ~f:(force_delayed_print fmt)
+let d_printfln ?color fmt = d_kprintf ?color k_force_newline fmt
+let d_pp pp x = d_printf "%a" pp x
+
+let d_pp_with_pe ?color pp x =
+ let pe = if Config.write_html then Pp.html (Option.value ~default:Pp.Black color) else Pp.text in
+ d_printf ?color "%a" (pp pe) x
-(** set the delayed print actions *)
-let set_delayed_prints new_delayed_actions = delayed_actions := new_delayed_actions
(** dump a string *)
-let d_str ?color (s : string) = add_print_action (PTstr {s; color; ln= false})
+let d_str ?color s = d_printf ?color "%s" s
(** dump an error string *)
-let d_error (s : string) = add_print_action (PTerror s)
+let d_error s = d_printf ~color:Pp.Red "ERROR: %s" s
(** dump a warning string *)
-let d_warning (s : string) = add_print_action (PTwarning s)
+let d_warning s = d_printf ~color:Pp.Orange "WARNING: %s" s
(** dump an info string *)
-let d_info (s : string) = add_print_action (PTinfo s)
-
-(** dump a string plus newline *)
-let d_strln ?color (s : string) = add_print_action (PTstr {s; color; ln= true})
+let d_info s = d_printf ~color:Pp.Blue "INFO: %s" s
(** dump a newline *)
-let d_ln () = d_strln ""
+let d_ln () = d_printf "@\n"
-let d_printf ?color fmt = F.kasprintf (d_str ?color) fmt
+(** dump a string plus newline *)
+let d_strln ?color s = d_kprintf ?color k_force_newline "%s" s
-let d_printfln ?color fmt = F.kasprintf (d_strln ?color) fmt
+let d_printfln_escaped ?color fmt =
+ d_kasprintf (fun f s -> d_kfprintf ?color k_force_newline f "%s" (Escape.escape_xml s)) fmt
-let d_printfln_escaped ?color fmt = F.kasprintf (fun s -> d_strln ?color (Escape.escape_xml s)) fmt
(** dump an indentation *)
let d_indent indent =
@@ -459,7 +442,7 @@ let d_indent indent =
(** dump command to increase the indentation level *)
-let d_increase_indent () = add_print_action PTincrease_indent
+let d_increase_indent () = d_printf " @["
(** dump command to decrease the indentation level *)
-let d_decrease_indent () = add_print_action PTdecrease_indent
+let d_decrease_indent () = d_printf "@]"