From b6323db37b2b57517a4196b7d71a7b22245da72f Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Tue, 30 Oct 2018 16:25:30 -0700 Subject: [PATCH] Some pp functions Reviewed By: jeremydubreil Differential Revision: D12840576 fbshipit-source-id: 0beebcc63 --- infer/src/IR/Ident.ml | 15 ++++--- infer/src/IR/Sil.ml | 47 +++++++++++----------- infer/src/IR/Sil.mli | 3 ++ infer/src/biabduction/Paths.ml | 19 +++------ infer/src/biabduction/RetainCycles.ml | 2 +- infer/src/biabduction/RetainCyclesType.ml | 28 ++++++------- infer/src/biabduction/RetainCyclesType.mli | 2 +- 7 files changed, 54 insertions(+), 62 deletions(-) diff --git a/infer/src/IR/Ident.ml b/infer/src/IR/Ident.ml index 14f0ba358..464926659 100644 --- a/infer/src/IR/Ident.ml +++ b/infer/src/IR/Ident.ml @@ -220,22 +220,21 @@ let create_path pathstring = (** {2 Pretty Printing} *) -(** Convert an identifier to a string. *) -let to_string id = - if has_kind id KNone then "_" +(** Pretty print an identifier. *) +let pp f id = + if has_kind id KNone then F.pp_print_char f '_' else let base_name = name_to_string id.name in let prefix = if has_kind id KFootprint then "@" else if has_kind id KNormal then "" else "_" in - let suffix = "$" ^ string_of_int id.stamp in - prefix ^ base_name ^ suffix + F.fprintf f "%s%s$%d" prefix base_name id.stamp + +(** Convert an identifier to a string. *) +let to_string id = F.asprintf "%a" pp id (** Pretty print a name. *) let pp_name f name = F.pp_print_string f (name_to_string name) -(** Pretty print an identifier. *) -let pp f id = F.pp_print_string f (to_string id) - (** pretty printer for lists of identifiers *) let pp_list = Pp.comma_seq pp diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml index 6234054d7..f0aa44404 100644 --- a/infer/src/IR/Sil.ml +++ b/infer/src/IR/Sil.ml @@ -638,37 +638,39 @@ let inst_new_loc loc inst = Ireturn_from_call loc.Location.line -(** return a string representing the inst *) -let inst_to_string inst = - let zero_flag_to_string = function Some true -> "(z)" | _ -> "" in - let null_case_flag_to_string ncf = if ncf then "(ncf)" else "" in +(** pretty-print an inst *) +let pp_inst f inst = + let pp_zero_flag f = function Some true -> F.pp_print_string f "(z)" | _ -> () in + let pp_null_case_flag f ncf = if ncf then F.pp_print_string f "(ncf)" in match inst with | Iabstraction -> - "abstraction" + F.pp_print_string f "abstraction" | Iactual_precondition -> - "actual_precondition" + F.pp_print_string f "actual_precondition" | Ialloc -> - "alloc" + F.pp_print_string f "alloc" | Iformal (zf, ncf) -> - "formal" ^ zero_flag_to_string zf ^ null_case_flag_to_string ncf + F.fprintf f "formal%a%a" pp_zero_flag zf pp_null_case_flag ncf | Iinitial -> - "initial" + F.pp_print_string f "initial" | Ilookup -> - "lookup" + F.pp_print_string f "lookup" | Inone -> - "none" + F.pp_print_string f "none" | Inullify -> - "nullify" + F.pp_print_string f "nullify" | Irearrange (zf, ncf, n, _) -> - "rearrange:" ^ zero_flag_to_string zf ^ null_case_flag_to_string ncf ^ string_of_int n + F.fprintf f "rearrange:%a%a%d" pp_zero_flag zf pp_null_case_flag ncf n | Itaint -> - "taint" + F.pp_print_string f "taint" | Iupdate (zf, ncf, n, _) -> - "update:" ^ zero_flag_to_string zf ^ null_case_flag_to_string ncf ^ string_of_int n + F.fprintf f "update:%a%a%d" pp_zero_flag zf pp_null_case_flag ncf n | Ireturn_from_call n -> - "return_from_call: " ^ string_of_int n + F.fprintf f "return_from_call: %d" n +let inst_to_string inst = F.asprintf "%a" pp_inst inst + exception JoinFail (** join of instrumentations, can raise JoinFail *) @@ -779,14 +781,13 @@ let update_inst inst_old inst_new = (** describe an instrumentation with a string *) -let pp_inst pe f inst = - let str = inst_to_string inst in - if Pp.equal_print_kind pe.Pp.kind Pp.HTML then - F.fprintf f " %a%s%a" Io_infer.Html.pp_start_color Pp.Orange str Io_infer.Html.pp_end_color () - else F.fprintf f "%s%s%s" (Binop.str pe Lt) str (Binop.str pe Gt) - +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 () + else F.fprintf f "%s%a%s" (Binop.str pe Lt) pp_inst inst (Binop.str pe Gt) -let pp_inst_if_trace pe f inst = if Config.trace_error then pp_inst pe f inst (** pretty print a strexp with an optional predicate env *) let rec pp_sexp_env pe0 envo f se = diff --git a/infer/src/IR/Sil.mli b/infer/src/IR/Sil.mli index 01cc77bf5..bf9b642df 100644 --- a/infer/src/IR/Sil.mli +++ b/infer/src/IR/Sil.mli @@ -303,6 +303,9 @@ val d_atom : atom -> unit val inst_to_string : inst -> string (** return a string representing the inst *) +val pp_inst : F.formatter -> inst -> unit +(** pretty-print an inst *) + val pp_sexp : Pp.env -> F.formatter -> strexp -> unit (** Pretty print a strexp. *) diff --git a/infer/src/biabduction/Paths.ml b/infer/src/biabduction/Paths.ml index baa44652e..cdeecbeda 100644 --- a/infer/src/biabduction/Paths.ml +++ b/infer/src/biabduction/Paths.ml @@ -381,23 +381,16 @@ end = struct Option.value_exn max_rep_opt - let stats_string path = + let pp_stats f path = Invariant.compute_stats true (fun _ -> true) path ; let repetitions, node = repetitions path in - let str = - "linear paths: " - ^ string_of_float (Invariant.get_stats path).linear_num - ^ " max length: " - ^ string_of_int (Invariant.get_stats path).max_length - ^ " has repetitions: " ^ string_of_int repetitions ^ " of node " - ^ string_of_int (Procdesc.Node.get_id node :> int) - in - Invariant.reset_stats path ; str - + F.fprintf f "linear paths: %f max length: %d has repetitions: %d of node %a" + (Invariant.get_stats path).linear_num (Invariant.get_stats path).max_length repetitions + Procdesc.Node.pp node ; + Invariant.reset_stats path - let pp_stats fmt path = F.pp_print_string fmt (stats_string path) - let d_stats path = L.d_str (stats_string path) + let d_stats path = L.d_str (F.asprintf "%a" pp_stats path) module PathMap = Caml.Map.Make (struct type nonrec t = t diff --git a/infer/src/biabduction/RetainCycles.ml b/infer/src/biabduction/RetainCycles.ml index dad3ba23e..9a5e8c3d1 100644 --- a/infer/src/biabduction/RetainCycles.ml +++ b/infer/src/biabduction/RetainCycles.ml @@ -238,7 +238,7 @@ let report_cycle tenv summary prop = (* When there is a cycle in objc we ignore it only if it's empty or it has weak or unsafe_unretained fields. Otherwise we report a retain cycle. *) let cycles = get_retain_cycles tenv prop in - RetainCyclesType.Set.iter RetainCyclesType.print_cycle cycles ; + RetainCyclesType.Set.iter RetainCyclesType.d_retain_cycle cycles ; if not (RetainCyclesType.Set.is_empty cycles) then ( RetainCyclesType.Set.iter (fun cycle -> diff --git a/infer/src/biabduction/RetainCyclesType.ml b/infer/src/biabduction/RetainCyclesType.ml index 844b58061..13f774696 100644 --- a/infer/src/biabduction/RetainCyclesType.ml +++ b/infer/src/biabduction/RetainCyclesType.ml @@ -94,33 +94,29 @@ let is_exp_null node = match node with Object obj -> Exp.is_null_literal obj.rc_from.rc_node_exp | Block _ -> false -let retain_cycle_node_to_string (node : retain_cycle_node) = - Format.sprintf "%s : %s" (Exp.to_string node.rc_node_exp) (Typ.to_string node.rc_node_typ) +let pp_retain_cycle_node f (node : retain_cycle_node) = + Format.fprintf f "%a : %a" Exp.pp node.rc_node_exp (Typ.pp_full Pp.text) node.rc_node_typ -let retain_cycle_field_to_string (field : retain_cycle_field) = - Format.sprintf "%s[%s]" - (Typ.Fieldname.to_string field.rc_field_name) - (Sil.inst_to_string field.rc_field_inst) +let pp_retain_cycle_field f (field : retain_cycle_field) = + Format.fprintf f "%a[%a]" Typ.Fieldname.pp field.rc_field_name Sil.pp_inst field.rc_field_inst -let retain_cycle_edge_to_string (edge : retain_cycle_edge) = +let pp_retain_cycle_edge f (edge : retain_cycle_edge) = match edge with | Object obj -> - Format.sprintf "%s ->{%s}" - (retain_cycle_node_to_string obj.rc_from) - (retain_cycle_field_to_string obj.rc_field) + Format.fprintf f "%a ->{%a}" pp_retain_cycle_node obj.rc_from pp_retain_cycle_field + obj.rc_field | Block _ -> - Format.sprintf "a block" + Format.pp_print_string f "a block" -let retain_cycle_to_string cycle = - "Cycle= \n\t" - ^ String.concat ~sep:"->" (List.map ~f:retain_cycle_edge_to_string cycle.rc_elements) +let d_retain_cycle cycle = + Logging.d_strln "Cycle=" ; + Logging.d_strln + (Format.asprintf "\t%a" (Pp.seq ~sep:"->" pp_retain_cycle_edge) cycle.rc_elements) -let print_cycle cycle = Logging.d_strln (retain_cycle_to_string cycle) - let find_minimum_element cycle = List.reduce_exn cycle.rc_elements ~f:(fun el1 el2 -> if compare_retain_cycle_edge el1 el2 < 0 then el1 else el2 ) diff --git a/infer/src/biabduction/RetainCyclesType.mli b/infer/src/biabduction/RetainCyclesType.mli index c6c41dfdb..b8a0f4afa 100644 --- a/infer/src/biabduction/RetainCyclesType.mli +++ b/infer/src/biabduction/RetainCyclesType.mli @@ -22,7 +22,7 @@ type t = {rc_head: retain_cycle_edge; rc_elements: retain_cycle_edge list} (** Set for retain cycles. *) module Set : Caml.Set.S with type elt = t -val print_cycle : t -> unit +val d_retain_cycle : t -> unit val create_cycle : retain_cycle_edge list -> t option (** Creates a cycle if the list is non-empty *)