From 5df11674dc27a7eac78e75df1d4abcfa0b0e7af8 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Thu, 3 Jan 2019 08:44:40 -0800 Subject: [PATCH] Io_infer.with_color Reviewed By: jvillard Differential Revision: D13572262 fbshipit-source-id: eb40fa96b --- infer/src/IR/DecompiledExp.ml | 4 ++-- infer/src/IR/Io_infer.ml | 6 ++---- infer/src/IR/Io_infer.mli | 7 ++----- infer/src/IR/Sil.ml | 9 +++------ infer/src/backend/Summary.ml | 5 ++--- infer/src/biabduction/BiabductionSummary.ml | 6 +++--- infer/src/biabduction/Prop.ml | 7 +++---- 7 files changed, 17 insertions(+), 27 deletions(-) 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