From a6c8e7c98e43ac1412077cb6afd04c9139837a01 Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Wed, 18 Dec 2019 09:32:42 -0800 Subject: [PATCH] [pp] move utility function from Sil to Pp Summary: Part of making Sil.ml about SIL only. In order to not introduce a dependency istd/Pp -> base/Config, the utilities in Pp don't know when to introduce "diff" colours. Fix it by wrapping them in Sil using the Config option. (we may want to just kill that option at some point). Similarly, move stuff from Io_infer to Pp. Reviewed By: ngorogiannis Differential Revision: D19158534 fbshipit-source-id: 8110cb7f9 --- infer/src/IR/DecompiledExp.ml | 2 +- infer/src/IR/Io_infer.ml | 4 --- infer/src/IR/Io_infer.mli | 3 -- infer/src/IR/Sil.ml | 35 +++------------------ infer/src/IR/Sil.mli | 3 -- infer/src/backend/Summary.ml | 2 +- infer/src/biabduction/BiabductionSummary.ml | 2 +- infer/src/biabduction/Prop.ml | 10 ++---- infer/src/istd/Pp.ml | 33 +++++++++++++++++++ infer/src/istd/Pp.mli | 9 ++++-- 10 files changed, 50 insertions(+), 53 deletions(-) diff --git a/infer/src/IR/DecompiledExp.ml b/infer/src/IR/DecompiledExp.ml index df28e6b29..117c18a0c 100644 --- a/infer/src/IR/DecompiledExp.ml +++ b/infer/src/IR/DecompiledExp.ml @@ -141,7 +141,7 @@ 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 let pp f vpath = F.fprintf f "{vpath: %a}" pp vpath in - Io_infer.Html.with_color Orange pp fmt vpath + Pp.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 1308253ae..e05bbe0bb 100644 --- a/infer/src/IR/Io_infer.ml +++ b/infer/src/IR/Io_infer.ml @@ -98,10 +98,6 @@ h1 { font-size:14pt } (** Print a horizontal line *) let pp_hline fmt () = F.pp_print_string fmt "\n
\n" - let with_color color pp f x = - F.fprintf f "%a" (Pp.color_string color) pp x - - let pp_link ?(name = None) ?(pos = None) ~path fmt text = let link_str = let escaped_path = List.map ~f:Escape.escape_url path in diff --git a/infer/src/IR/Io_infer.mli b/infer/src/IR/Io_infer.mli index c9cd6688e..39e60f5d5 100644 --- a/infer/src/IR/Io_infer.mli +++ b/infer/src/IR/Io_infer.mli @@ -66,9 +66,6 @@ module Html : sig -> int * int * int -> unit (** Print an html link given node id and session *) - - 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 02825595f..c4a07b9db 100644 --- a/infer/src/IR/Sil.ml +++ b/infer/src/IR/Sil.ml @@ -232,36 +232,11 @@ end) (** {2 Pretty Printing} *) -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 - 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 - Io_infer.Html.with_color color (f pe') ppf x - else f pe ppf x - else f pe ppf x - +let color_wrapper ~f = if Config.print_using_diff then Pp.color_wrapper ~f else f -(** Print a sequence with difference mode if enabled. *) -let pp_seq_diff pp pe0 f = - if not Config.print_using_diff then Pp.comma_seq pp f - else - let rec doit = function - | [] -> - () - | [x] -> - color_wrapper pe0 f x ~f:(fun _pe -> pp) - | x :: l -> - color_wrapper pe0 f x ~f:(fun _pe -> pp) ; - F.pp_print_string f ", " ; - doit l - in - doit +let pp_seq_diff pp print_env fmt l = + if Config.print_using_diff then Pp.comma_seq_diff pp print_env fmt l + else Pp.comma_seq ~print_env pp fmt l (** Pretty print an expression. *) @@ -803,7 +778,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 Io_infer.Html.with_color Orange pp_inst f inst + if Pp.equal_print_kind pe.Pp.kind Pp.HTML then Pp.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/IR/Sil.mli b/infer/src/IR/Sil.mli index 66d770828..e29cf2219 100644 --- a/infer/src/IR/Sil.mli +++ b/infer/src/IR/Sil.mli @@ -259,9 +259,6 @@ val add_with_block_parameters_flag : instr -> instr (** {2 Pretty Printing} *) -val color_wrapper : Pp.env -> F.formatter -> 'a -> f:(Pp.env -> F.formatter -> 'a -> unit) -> unit -(** Wraps a printing function with an updated printenv when using diff printing *) - val pp_exp_printenv : ?print_types:bool -> Pp.env -> F.formatter -> Exp.t -> unit (** Pretty print an expression. *) diff --git a/infer/src/backend/Summary.ml b/infer/src/backend/Summary.ml index b515af5d0..5972f2eb6 100644 --- a/infer/src/backend/Summary.ml +++ b/infer/src/backend/Summary.ml @@ -121,7 +121,7 @@ let pp_text fmt summary = let pp_html source fmt summary = F.pp_force_newline fmt () ; - Io_infer.Html.with_color Black pp_no_stats_specs fmt summary ; + Pp.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 d31feaf09..43b6c57fc 100644 --- a/infer/src/biabduction/BiabductionSummary.ml +++ b/infer/src/biabduction/BiabductionSummary.ml @@ -269,7 +269,7 @@ let pp_spec0 pe num_opt fmt spec = F.fprintf fmt "--------------------------- %a ---------------------------@\n" pp_num_opt num_opt ; F.fprintf fmt "PRE:@\n" ; - Io_infer.Html.with_color Blue (Prop.pp_prop (Pp.html Blue)) fmt pre ; + Pp.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 fafa56fa5..d7772848f 100644 --- a/infer/src/biabduction/Prop.ml +++ b/infer/src/biabduction/Prop.ml @@ -113,7 +113,7 @@ let pp_texp_simple pe = (** Pretty print a pointsto representing a stack variable as an equality *) let pp_hpred_stackvar = - Sil.color_wrapper ~f:(fun pe f (hpred : Sil.hpred) -> + Pp.color_wrapper ~f:(fun pe f (hpred : Sil.hpred) -> match hpred with | Hpointsto (Exp.Lvar pvar, se, te) -> let pe' = @@ -139,7 +139,7 @@ let pp_sub pe f sub = let d_sub (sub : Sil.subst) = L.d_pp_with_pe pp_sub sub let pp_sub_entry = - Sil.color_wrapper ~f:(fun pe f entry -> + Pp.color_wrapper ~f:(fun pe f entry -> let x, e = entry in F.fprintf f "%a = %a" Ident.pp x (Sil.pp_exp_printenv pe) e ) @@ -313,11 +313,7 @@ let pp_prop pe0 f prop = F.fprintf f "%a%a%a%a" pp_pure () (pp_sigma_simple pe env) prop.sigma (pp_footprint_simple pe env) prop pp_predicates () in - match pe0.Pp.kind with - | Pp.HTML -> - Io_infer.Html.with_color Blue do_print f () - | TEXT -> - do_print f () + match pe0.Pp.kind with HTML -> Pp.html_with_color Blue do_print f () | TEXT -> do_print f () let pp_prop_with_typ pe f p = pp_prop {pe with opt= SIM_WITH_TYP} f p diff --git a/infer/src/istd/Pp.ml b/infer/src/istd/Pp.ml index f387acc12..eda525c4e 100644 --- a/infer/src/istd/Pp.ml +++ b/infer/src/istd/Pp.ml @@ -100,6 +100,25 @@ let color_string = function "color_red" +let html_with_color color pp f x = + F.fprintf f "%a" (color_string color) pp x + + +let color_wrapper pe ppf x ~f = + match pe.kind with + | HTML when pe.cmap_norm (Obj.repr x) <> pe.color -> + let color = pe.cmap_norm (Obj.repr x) in + let pe' = + if equal_color color Red then + (* All subexpressions red *) + {pe with cmap_norm= colormap_red; color= Red} + else {pe with color} + in + html_with_color color (f pe') ppf x + | _ -> + f pe ppf x + + let seq ?(print_env = text) ?sep:(sep_text = " ") ?(sep_html = sep_text) pp = let rec aux f = function | [] -> @@ -118,6 +137,20 @@ let comma_seq ?print_env pp f l = seq ?print_env ~sep:"," pp f l let semicolon_seq ?print_env pp f l = seq ?print_env ~sep:"; " pp f l +let comma_seq_diff pp pe0 f = + let rec doit = function + | [] -> + () + | [x] -> + color_wrapper pe0 f x ~f:(fun _pe -> pp) + | x :: l -> + color_wrapper pe0 f x ~f:(fun _pe -> pp) ; + F.pp_print_string f ", " ; + doit l + in + doit + + (** Print the current time and date in a format similar to the "date" command *) let current_time f () = let tm = Unix.localtime (Unix.time ()) in diff --git a/infer/src/istd/Pp.mli b/infer/src/istd/Pp.mli index 3e9931498..21304c19e 100644 --- a/infer/src/istd/Pp.mli +++ b/infer/src/istd/Pp.mli @@ -45,12 +45,11 @@ val set_obj_sub : env -> ('a -> 'a) -> env (** Set the object substitution, which is supposed to preserve the type. Currently only used for a map from (identifier) expressions to the program var containing them *) -val colormap_red : colormap -(** red colormap *) - val extend_colormap : env -> Obj.t -> color -> env (** Extend the normal colormap for the given object with the given color *) +val color_wrapper : env -> F.formatter -> 'a -> f:(env -> F.formatter -> 'a -> unit) -> unit + val text : env (** Default text print environment *) @@ -63,6 +62,8 @@ val html : color -> env val color_string : color -> string (** string representation of colors *) +val html_with_color : color -> (F.formatter -> 'a -> unit) -> F.formatter -> 'a -> unit + val option : (F.formatter -> 'a -> unit) -> F.formatter -> 'a option -> unit val cli_args : F.formatter -> string list -> unit @@ -85,6 +86,8 @@ val seq : val comma_seq : ?print_env:env -> (F.formatter -> 'a -> unit) -> F.formatter -> 'a list -> unit (** Pretty print a comma-separated sequence. *) +val comma_seq_diff : (F.formatter -> 'a -> unit) -> env -> F.formatter -> 'a list -> unit + val semicolon_seq : ?print_env:env -> (F.formatter -> 'a -> unit) -> F.formatter -> 'a list -> unit (** Pretty print a ;-separated sequence *)