diff --git a/infer/src/IR/DecompiledExp.ml b/infer/src/IR/DecompiledExp.ml
index 0764fac85..be5e092b0 100644
--- a/infer/src/IR/DecompiledExp.ml
+++ b/infer/src/IR/DecompiledExp.ml
@@ -140,8 +140,8 @@ let to_string de = F.asprintf "%a" pp de
let pp_vpath pe fmt vpath =
let pp fmt = function Some de -> pp fmt de | None -> () in
if Pp.equal_print_kind pe.Pp.kind Pp.HTML then
- F.fprintf fmt " %a{vpath: %a}%a" Io_infer.Html.pp_start_color Pp.Orange pp vpath
- Io_infer.Html.pp_end_color ()
+ let pp f vpath = F.fprintf f "{vpath: %a}" pp vpath in
+ Io_infer.Html.with_color Orange pp fmt vpath
else pp fmt vpath
diff --git a/infer/src/IR/Io_infer.ml b/infer/src/IR/Io_infer.ml
index 3bbaa166c..bc4f68845 100644
--- a/infer/src/IR/Io_infer.ml
+++ b/infer/src/IR/Io_infer.ml
@@ -98,11 +98,9 @@ h1 { font-size:14pt }
(** Print a horizontal line *)
let pp_hline fmt () = F.pp_print_string fmt "\n
\n"
- (** Print start color *)
- let pp_start_color fmt color = F.fprintf fmt "" (Pp.color_string color)
+ let with_color color pp f x =
+ F.fprintf f "%a" (Pp.color_string color) pp x
- (** Print end color *)
- let pp_end_color fmt () = F.pp_print_string fmt ""
let pp_link ?(name = None) ?(pos = None) ~path fmt text =
let link_str =
diff --git a/infer/src/IR/Io_infer.mli b/infer/src/IR/Io_infer.mli
index ebe2ed12b..6bcba8d98 100644
--- a/infer/src/IR/Io_infer.mli
+++ b/infer/src/IR/Io_infer.mli
@@ -39,9 +39,6 @@ module Html : sig
val pp_hline : Format.formatter -> unit -> unit
(** Print a horizontal line *)
- val pp_end_color : Format.formatter -> unit -> unit
- (** Print end color *)
-
val pp_node_link :
DB.Results_dir.path
-> Typ.Procname.t
@@ -71,8 +68,8 @@ module Html : sig
-> unit
(** Print an html link given node id and session *)
- val pp_start_color : Format.formatter -> Pp.color -> unit
- (** Print start color *)
+ val with_color : Pp.color -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a -> unit
+ (** Print using color *)
end
(** Create and print xml trees *)
diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml
index d25a53fe1..2f996cbe9 100644
--- a/infer/src/IR/Sil.ml
+++ b/infer/src/IR/Sil.ml
@@ -225,15 +225,14 @@ end)
let color_wrapper pe ppf x ~f =
if Config.print_using_diff && pe.Pp.kind <> Pp.TEXT then
let color = pe.Pp.cmap_norm (Obj.repr x) in
- if color <> pe.Pp.color then (
- Io_infer.Html.pp_start_color ppf color ;
+ if color <> pe.Pp.color then
let pe' =
if Pp.equal_color color Pp.Red then
(* All subexpressions red *)
Pp.{pe with cmap_norm= colormap_red; color= Red}
else Pp.{pe with color}
in
- f pe' ppf x ; Io_infer.Html.pp_end_color ppf () )
+ Io_infer.Html.with_color color (f pe') ppf x
else f pe ppf x
else f pe ppf x
@@ -774,9 +773,7 @@ let update_inst inst_old inst_new =
(** describe an instrumentation with a string *)
let pp_inst_if_trace pe f inst =
if Config.trace_error then
- if Pp.equal_print_kind pe.Pp.kind Pp.HTML then
- F.fprintf f " %a%a%a" Io_infer.Html.pp_start_color Pp.Orange pp_inst inst
- Io_infer.Html.pp_end_color ()
+ if Pp.equal_print_kind pe.Pp.kind Pp.HTML then Io_infer.Html.with_color Orange pp_inst f inst
else F.fprintf f "%s%a%s" (Binop.str pe Lt) pp_inst inst (Binop.str pe Gt)
diff --git a/infer/src/backend/Summary.ml b/infer/src/backend/Summary.ml
index bc2077f0e..c10976480 100644
--- a/infer/src/backend/Summary.ml
+++ b/infer/src/backend/Summary.ml
@@ -116,9 +116,8 @@ let pp_text fmt summary =
let pp_html source fmt summary =
- Io_infer.Html.pp_start_color fmt Black ;
- F.fprintf fmt "@\n%a" pp_no_stats_specs summary ;
- Io_infer.Html.pp_end_color fmt () ;
+ F.pp_force_newline fmt () ;
+ Io_infer.Html.with_color Black pp_no_stats_specs fmt summary ;
F.fprintf fmt "
%a
@\n" Stats.pp summary.stats ;
Errlog.pp_html source [] fmt (get_err_log summary) ;
Io_infer.Html.pp_hline fmt () ;
diff --git a/infer/src/biabduction/BiabductionSummary.ml b/infer/src/biabduction/BiabductionSummary.ml
index 98b79065c..f13a882ed 100644
--- a/infer/src/biabduction/BiabductionSummary.ml
+++ b/infer/src/biabduction/BiabductionSummary.ml
@@ -258,9 +258,9 @@ let pp_spec0 pe num_opt fmt spec =
| HTML ->
F.fprintf fmt "--------------------------- %a ---------------------------@\n" pp_num_opt
num_opt ;
- F.fprintf fmt "PRE:@\n%a%a%a@\n" Io_infer.Html.pp_start_color Pp.Blue
- (Prop.pp_prop (Pp.html Blue))
- pre Io_infer.Html.pp_end_color () ;
+ F.fprintf fmt "PRE:@\n" ;
+ Io_infer.Html.with_color Blue (Prop.pp_prop (Pp.html Blue)) fmt pre ;
+ F.pp_force_newline fmt () ;
Propgraph.pp_proplist pe_post "POST" (pre, true) fmt post_list ;
F.pp_print_string fmt "----------------------------------------------------------------"
diff --git a/infer/src/biabduction/Prop.ml b/infer/src/biabduction/Prop.ml
index 34f29de2d..a3b4796d8 100644
--- a/infer/src/biabduction/Prop.ml
+++ b/infer/src/biabduction/Prop.ml
@@ -291,7 +291,7 @@ let prop_pred_env prop =
(** Pretty print a proposition. *)
let pp_prop pe0 f prop =
let pe = prop_update_obj_sub pe0 prop in
- let do_print f =
+ let do_print f () =
let subl = Sil.sub_to_list prop.sub in
(* since prop diff is based on physical equality, we need to extract the sub verbatim *)
let pi = prop.pi in
@@ -315,10 +315,9 @@ let pp_prop pe0 f prop =
in
match pe0.Pp.kind with
| Pp.HTML ->
- F.fprintf f "%a%t%a" Io_infer.Html.pp_start_color Pp.Blue do_print Io_infer.Html.pp_end_color
- ()
+ Io_infer.Html.with_color Blue do_print f ()
| TEXT ->
- do_print f
+ do_print f ()
let pp_prop_with_typ pe f p = pp_prop {pe with opt= SIM_WITH_TYP} f p