[typ] make use of pretty printers instead of strings

Summary:
As per previous diff, attempt to allocate fewer strings. This doesn't
seem to affect perf although allocating less might reduce memory
pressure.

Reviewed By: mityal

Differential Revision: D17423973

fbshipit-source-id: e2e37b071

infer/src/IR/Const.ml

@@ -43,9 +43,9 @@ let pp pe f = function
   | Cfun fn -> (
     match pe.Pp.kind with
     | HTML ->
-        F.fprintf f "_fun_%s" (Escape.escape_xml (Typ.Procname.to_string fn))
+        F.fprintf f "_fun_%s" (Escape.escape_xml (F.asprintf "%a" Typ.Procname.pp fn))
     | _ ->
-        F.fprintf f "_fun_%s" (Typ.Procname.to_string fn) )
+        F.fprintf f "_fun_%a" Typ.Procname.pp fn )
   | Cstr s ->
       F.fprintf f "\"%s\"" (String.escaped s)
   | Cfloat v ->

infer/src/IR/ProcAttributes.ml

@@ -170,7 +170,7 @@ let pp f
     F.fprintf f "; objc_accessor= %a@," (Pp.option pp_objc_accessor_type) objc_accessor ;
   (* always print ret type *)
   F.fprintf f "; ret_type= %a @," (Typ.pp_full Pp.text) ret_type ;
-  F.fprintf f "; proc_id= %s }@]" (Typ.Procname.to_unique_id proc_name)
+  F.fprintf f "; proc_id= %a }@]" Typ.Procname.pp_unique_id proc_name
 
 
 module SQLite = SqliteUtils.MarshalledDataNOTForComparison (struct

infer/src/IR/Procdesc.ml

@@ -745,18 +745,17 @@ let pp_objc_accessor fmt accessor =
 let pp_signature fmt pdesc =
   let attributes = get_attributes pdesc in
   let pname = get_proc_name pdesc in
-  let pname_string = Typ.Procname.to_string pname in
   let defined_string = match is_defined pdesc with true -> "defined" | false -> "undefined" in
-  Format.fprintf fmt "@[%s [%s, Return type: %s, %aFormals: %a, Locals: %a" pname_string
+  Format.fprintf fmt "@[%a [%s, Return type: %a, %aFormals: %a, Locals: %a" Typ.Procname.pp pname
-    defined_string
+    defined_string (Typ.pp_full Pp.text) (get_ret_type pdesc) pp_objc_accessor
-    (Typ.to_string (get_ret_type pdesc))
+    attributes.ProcAttributes.objc_accessor pp_variable_list (get_formals pdesc) pp_locals_list
-    pp_objc_accessor attributes.ProcAttributes.objc_accessor pp_variable_list (get_formals pdesc)
+    (get_locals pdesc) ;
-    pp_locals_list (get_locals pdesc) ;
   if not (List.is_empty (get_captured pdesc)) then
     Format.fprintf fmt ", Captured: %a" pp_variable_list (get_captured pdesc) ;
   let method_annotation = attributes.ProcAttributes.method_annotation in
-  if not (Annot.Method.is_empty method_annotation) then
+  ( if not (Annot.Method.is_empty method_annotation) then
-    Format.fprintf fmt ", Annotation: %a" (Annot.Method.pp pname_string) method_annotation ;
+    let pname_string = Typ.Procname.to_string pname in
+    Format.fprintf fmt ", Annotation: %a" (Annot.Method.pp pname_string) method_annotation ) ;
   Format.fprintf fmt "]@]@;"
 
 

infer/src/IR/Pvar.ml

@@ -38,7 +38,8 @@ type t = {pv_hash: int; pv_name: Mangled.t; pv_kind: pvar_kind} [@@deriving comp
 let get_name_of_local_with_procname var =
   match var.pv_kind with
   | Local_var pname ->
-      Mangled.from_string (Mangled.to_string var.pv_name ^ "_" ^ Typ.Procname.to_string pname)
+      Mangled.from_string
+        (F.asprintf "%s_%a" (Mangled.to_string var.pv_name) Typ.Procname.pp pname)
   | _ ->
       var.pv_name
 
@@ -247,12 +248,14 @@ let mk_tmp name pname =
 
 (** create an abduced return variable for a call to [proc_name] at [loc] *)
 let mk_abduced_ret (proc_name : Typ.Procname.t) (loc : Location.t) : t =
-  let name = Mangled.from_string ("$RET_" ^ Typ.Procname.to_unique_id proc_name) in
+  let name = Mangled.from_string (F.asprintf "$RET_%a" Typ.Procname.pp_unique_id proc_name) in
   {pv_hash= name_hash name; pv_name= name; pv_kind= Abduced_retvar (proc_name, loc)}
 
 
 let mk_abduced_ref_param (proc_name : Typ.Procname.t) (index : int) (loc : Location.t) : t =
-  let name = Mangled.from_string ("$REF_PARAM_VAL_" ^ Typ.Procname.to_unique_id proc_name) in
+  let name =
+    Mangled.from_string (F.asprintf "$REF_PARAM_VAL_%a" Typ.Procname.pp_unique_id proc_name)
+  in
   {pv_hash= name_hash name; pv_name= name; pv_kind= Abduced_ref_param (proc_name, index, loc)}
 
 

infer/src/IR/Typ.mli

@@ -586,7 +586,10 @@ being the name of the struct, [None] means the parameter is of some other type.
       initializer, None otherwise. *)
 
   val pp : Format.formatter -> t -> unit
-  (** Pretty print a proc name. *)
+  (** Pretty print a proc name for the user to see. *)
+
+  val to_string : t -> string
+  (** Convert a proc name into a string for the user to see. *)
 
   val describe : Format.formatter -> t -> unit
   (** to use in user messages *)
@@ -597,17 +600,20 @@ being the name of the struct, [None] means the parameter is of some other type.
 
   val is_method_in_objc_protocol : t -> bool
 
-  val to_string : t -> string
+  val pp_simplified_string : ?withclass:bool -> F.formatter -> t -> unit
-  (** Convert a proc name to a string for the user to see. *)
+  (** Pretty print a proc name as an easy string for the user to see in an IDE. *)
 
   val to_simplified_string : ?withclass:bool -> t -> string
-  (** Convert a proc name into a easy string for the user to see in an IDE. *)
+  (** Convert a proc name into an easy string for the user to see in an IDE. *)
 
   val from_string_c_fun : string -> t
   (** Convert a string to a c function name. *)
 
   val hashable_name : t -> string
-  (** Print the procedure name in a format suitable for computing the bug hash *)
+  (** Convert the procedure name in a format suitable for computing the bug hash. *)
+
+  val pp_unique_id : F.formatter -> t -> unit
+  (** Print a proc name as a unique identifier. *)
 
   val to_unique_id : t -> string
   (** Convert a proc name into a unique identifier. *)

infer/src/biabduction/Paths.ml

@@ -439,7 +439,9 @@ end = struct
       | Pcall (_, pname, ExecSkipped (reason, loc_opt), _), Some curr_node ->
           let curr_loc = Procdesc.Node.get_loc curr_node in
           let descr =
-            Format.sprintf "Skipping %s: %s" (Typ.Procname.to_simplified_string pname) reason
+            Format.asprintf "Skipping %a: %s"
+              (Typ.Procname.pp_simplified_string ~withclass:false)
+              pname reason
           in
           let node_tags = [] in
           trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace ;
@@ -447,7 +449,9 @@ end = struct
             ~f:(fun loc ->
               if Typ.Procname.is_java pname && not (SourceFile.is_invalid loc.Location.file) then
                 let definition_descr =
-                  Format.sprintf "Definition of %s" (Typ.Procname.to_simplified_string pname)
+                  Format.asprintf "Definition of %a"
+                    (Typ.Procname.pp_simplified_string ~withclass:false)
+                    pname
                 in
                 trace := Errlog.make_trace_element (level + 1) loc definition_descr [] :: !trace )
             loc_opt
@@ -458,7 +462,11 @@ end = struct
               () (* omit join nodes from error traces *)
           | Procdesc.Node.Start_node ->
               let pname = Procdesc.Node.get_proc_name curr_node in
-              let descr = "start of procedure " ^ Typ.Procname.to_simplified_string pname in
+              let descr =
+                F.asprintf "start of procedure %a"
+                  (Typ.Procname.pp_simplified_string ~withclass:false)
+                  pname
+              in
               let node_tags = [Errlog.Procedure_start pname] in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
           | Procdesc.Node.Prune_node (is_true_branch, if_kind, _) ->
@@ -485,7 +493,7 @@ end = struct
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
           | Procdesc.Node.Exit_node ->
               let pname = Procdesc.Node.get_proc_name curr_node in
-              let descr = "return from a call to " ^ Typ.Procname.to_string pname in
+              let descr = F.asprintf "return from a call to %a" Typ.Procname.pp pname in
               let node_tags = [Errlog.Procedure_end pname] in
               trace := Errlog.make_trace_element level curr_loc descr node_tags :: !trace
           | _ ->

infer/src/biabduction/RetainCyclesType.ml

@@ -174,7 +174,7 @@ let pp_dotty fmt cycle =
           (Typ.to_string obj.rc_from.rc_node_typ)
           Typ.Fieldname.pp obj.rc_field.rc_field_name
     | Block (name, _) ->
-        Format.pp_print_string fmt (Typ.Procname.to_unique_id name)
+        Typ.Procname.pp_unique_id fmt name
   in
   let pp_dotty_field fmt element =
     match element with

infer/src/bufferoverrun/symb.ml

@@ -142,7 +142,7 @@ module SymbolPath = struct
         BufferOverrunField.pp ~pp_lhs:(pp_partial_paren ~paren:true)
           ~pp_lhs_alone:(pp_partial_paren ~paren) ~sep:"." fmt p fn
     | Callsite {cs} ->
-        F.fprintf fmt "%s" (Typ.Procname.to_simplified_string ~withclass:true (CallSite.pname cs))
+        Typ.Procname.pp_simplified_string ~withclass:true fmt (CallSite.pname cs)
     | StarField {last_field; prefix} ->
         BufferOverrunField.pp ~pp_lhs:(pp_star ~paren:true) ~pp_lhs_alone:(pp_star ~paren) ~sep:"."
           fmt prefix last_field

infer/src/clang/cGeneral_utils.ml

@@ -6,6 +6,7 @@
  *)
 
 open! IStd
+module F = Format
 
 (** General utility functions such as functions on lists *)
 
@@ -159,7 +160,8 @@ let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname o
           if var_decl_info.Clang_ast_t.vdi_is_static_local then
             Some
               (fun name_string _ ->
-                Mangled.from_string (Typ.Procname.to_string outer_procname ^ "." ^ name_string) )
+                Mangled.from_string (F.asprintf "%a.%s" Typ.Procname.pp outer_procname name_string)
+                )
           else None
         in
         mk_sil_global_var trans_unit_ctx ?mk_name decl_info named_decl_info var_decl_info qt

infer/src/clang/cMethod_trans.ml

@@ -200,7 +200,6 @@ let create_local_procdesc ?(set_objc_accessor_attr = false) trans_unit_ctx cfg t
     captured =
   let defined = not (List.is_empty fbody) in
   let proc_name = ms.CMethodSignature.name in
-  let pname = Typ.Procname.to_string proc_name in
   let attributes = sil_func_attributes_of_attributes ms.CMethodSignature.attributes in
   let clang_method_kind = ms.CMethodSignature.method_kind in
   let is_cpp_nothrow = ms.CMethodSignature.is_cpp_nothrow in
@@ -233,7 +232,8 @@ let create_local_procdesc ?(set_objc_accessor_attr = false) trans_unit_ctx cfg t
       get_const_params_indices ~shift:(List.length captured_mangled) all_params
     in
     let source_range = ms.CMethodSignature.loc in
-    L.(debug Capture Verbose) "@\nCreating a new procdesc for function: '%s'@\n@." pname ;
+    L.(debug Capture Verbose)
+      "@\nCreating a new procdesc for function: '%a'@\n@." Typ.Procname.pp proc_name ;
     L.(debug Capture Verbose) "@\nms = %a@\n@." CMethodSignature.pp ms ;
     let loc_start =
       CLocation.location_of_source_range trans_unit_ctx.CFrontend_config.source_file source_range

infer/src/java/jFrontend.ml

@@ -142,9 +142,7 @@ let create_icfg source_file linereader program tenv icfg cn node =
     JClasspath.set_callee_translated program proc_name ;
     if JClasspath.is_model proc_name then
       (* do not translate the method if there is a model for it *)
-      L.(debug Capture Verbose)
+      L.debug Capture Verbose "Skipping method with a model: %a@." Typ.Procname.pp proc_name
-        "Skipping method with a model: %s@."
-        (Typ.Procname.to_string proc_name)
     else
       try
         (* each procedure has different scope: start names from id 0 *)

infer/src/nullsafe/AnnotatedSignature.ml

@@ -114,9 +114,9 @@ let pp proc_name fmt annotated_signature =
       Mangled.pp mangled
   in
   let {ret_annotation_deprecated; ret_nullsafe_type} = annotated_signature.ret in
-  F.fprintf fmt "%a%a %s (%a )" pp_ia ret_annotation_deprecated NullsafeType.pp ret_nullsafe_type
+  F.fprintf fmt "%a%a %a (%a )" pp_ia ret_annotation_deprecated NullsafeType.pp ret_nullsafe_type
-    (Typ.Procname.to_simplified_string proc_name)
+    (Typ.Procname.pp_simplified_string ~withclass:false)
-    (Pp.comma_seq pp_annotated_param) annotated_signature.params
+    proc_name (Pp.comma_seq pp_annotated_param) annotated_signature.params
 
 
 let mk_ann_str s = {Annot.class_name= s; parameters= []}
@@ -154,9 +154,8 @@ let set_modelled_nullability proc_name asig (nullability_for_ret, params_nullabi
   let final_params =
     let fail () =
       L.die InternalError
-        "Annotation for procedure %s has wrong number of arguments.@\n  Annotated signature: %a"
+        "Annotation for procedure %a has wrong number of arguments.@\n  Annotated signature: %a"
-        (Typ.Procname.to_unique_id proc_name)
+        Typ.Procname.pp_unique_id proc_name (pp proc_name) asig
-        (pp proc_name) asig
     in
     let rec model_param_nullability original_params params_nullability =
       match (original_params, params_nullability) with