[explore] print only non-default values in the attributes

Summary:
Attributes have lots of fields, but the majority is usually the same from one procedure to the other.

This attempts to print only non-default values, where the default is the
"empty" attributes (as opposed to the "most commonly seen value" for each
field), in an attempt to be predictible. This is largely something that should
be done with a ppx but since there's only one use case it didn't seem worth the
trouble.

Output of `infer explore --procedures --procedures-attributes --procedures-name` before:
```
test: examples/hello.c test <defined>
    {access= <Default>; captured= []; did_preanalysis= false; err_log= [
     ]; exceptions= []; formals= []; const_formals= []; by_vals= [];
     func_attributes= []; is_abstract= false; is_bridge_method= false;
     is_defined= true; is_cpp_noexcept_method= false;
     is_java_synchronized_method= false; is_model= false;
     is_specialized= false; is_synthetic_method= false;
     clang_method_kind= C_FUNCTION; loc= line 12, column 1;
     translation_unit= Some examples/hello.c;
     locals= [{name= s;typ= ;attributes= }]; method_annotation= <> ();
     objc_accessor= None; proc_flags= []; proc_name= test; ret_type= ;
     source_file_captured=examples/hello.c}
int Hello.test(): examples/Hello.java int Hello.test() <defined>
    {access= <Default>; captured= []; did_preanalysis= false; err_log= [
     ]; exceptions= []; formals= [(this,)]; const_formals= []; by_vals= [
     ]; func_attributes= []; is_abstract= false; is_bridge_method= false;
     is_defined= true; is_cpp_noexcept_method= false;
     is_java_synchronized_method= false; is_model= false;
     is_specialized= false; is_synthetic_method= false;
     clang_method_kind= C_FUNCTION; loc= line 11; translation_unit= None;
     locals= [{name= $irvar0;typ= ;attributes= }; {name= s;typ= ;attributes= }];
     method_annotation= <> (); objc_accessor= None; proc_flags= [];
     proc_name= int Hello.test(); ret_type= ;
     source_file_captured=examples/Hello.java}
Hello.<init>(): examples/Hello.java Hello.<init>() <defined>
    {access= <Default>; captured= []; did_preanalysis= false; err_log= [
     ]; exceptions= []; formals= [(this,)]; const_formals= []; by_vals= [
     ]; func_attributes= []; is_abstract= false; is_bridge_method= false;
     is_defined= true; is_cpp_noexcept_method= false;
     is_java_synchronized_method= false; is_model= false;
     is_specialized= false; is_synthetic_method= false;
     clang_method_kind= C_FUNCTION; loc= line 10; translation_unit= None;
     locals= []; method_annotation= <> (); objc_accessor= None;
     proc_flags= []; proc_name= Hello.<init>(); ret_type= ;
     source_file_captured=examples/Hello.java}
```

Now:
```
test
  source_file: examples/hello.c
  proc_name: test
  attribute_kind: <defined>
  attributes:
    { proc_name= test
    ; source_file_captured= examples/hello.c
    ; formals= []
    ; is_defined= true
    ; loc= line 12, column 1
    ; translation_unit= <Some examples/hello.c>
    ; locals= [{ name= s; typ= int* }]
    ; ret_type= void }

int Hello.test()
  source_file: examples/Hello.java
  proc_name: int Hello.test()
  attribute_kind: <defined>
  attributes:
    { proc_name= int Hello.test()
    ; source_file_captured= examples/Hello.java
    ; formals= [(this,Hello*)]
    ; is_defined= true
    ; loc= line 11
    ; locals= [{ name= $irvar0; typ= void };
               { name= s; typ= java.lang.String* }]
    ; ret_type= int }

Hello.<init>()
  source_file: examples/Hello.java
  proc_name: Hello.<init>()
  attribute_kind: <defined>
  attributes:
    { proc_name= Hello.<init>()
    ; source_file_captured= examples/Hello.java
    ; formals= [(this,Hello*)]
    ; is_defined= true
    ; loc= line 10
    ; ret_type= void }
```

Reviewed By: mbouaziz

Differential Revision: D7757890

fbshipit-source-id: 5507ec6

infer/src/IR/Annot.ml

@@ -78,6 +78,8 @@ module Method = struct
   (** Annotation for a method: return value and list of parameters. *)
   type t = Item.t * Item.t list [@@deriving compare]
 
+  let equal = [%compare.equal : t]
+
   (** Pretty print a method annotation. *)
   let pp s fmt (ia, ial) = F.fprintf fmt "%a %s(%a)" Item.pp ia s (Pp.seq Item.pp) ial
 

infer/src/IR/Annot.mli

@@ -52,6 +52,8 @@ module Method : sig
   (** Annotation for a method: return value and list of parameters. *)
   type t = Item.t * Item.t list [@@deriving compare]
 
+  val equal : t -> t -> bool
+
   val empty : t
   (** Empty method annotation. *)
 

infer/src/IR/Errlog.ml

@@ -125,6 +125,8 @@ let compare x y =
   [%compare : (ErrLogHash.Key.t * ErrDataSet.t) list] (bindings x) (bindings y)
 
 
+let equal x y = [%compare.equal : t] x y
+
 (** Empty error log *)
 let empty () = ErrLogHash.create 13
 

infer/src/IR/Errlog.mli

@@ -62,6 +62,8 @@ type err_data = private
 (** Type of the error log *)
 type t [@@deriving compare]
 
+val equal : t -> t -> bool
+
 val empty : unit -> t
 (** Empty error log *)
 

infer/src/IR/ProcAttributes.ml

@@ -65,7 +65,7 @@ let pp_objc_accessor_type fmt objc_accessor_type =
   F.fprintf fmt "%s<%a:%a@,[%a]>"
     (kind_of_objc_accessor_type objc_accessor_type)
     Typ.Fieldname.pp fieldname (Typ.pp Pp.text) typ
-    (Pp.semicolon_seq (Pp.pair ~fst:Annot.pp ~snd:F.pp_print_bool))
+    (Pp.semicolon_seq ~print_env:Pp.text_break (Pp.pair ~fst:Annot.pp ~snd:F.pp_print_bool))
     annots
 
 
@@ -78,10 +78,12 @@ let var_attribute_equal = [%compare.equal : var_attribute]
 type var_data = {name: Mangled.t; typ: Typ.t; attributes: var_attribute list} [@@deriving compare]
 
 let pp_var_data fmt {name; typ; attributes} =
-  F.fprintf fmt "{@[<h>name=@ %a;@,typ=@ %a;@,attributes=@ %a@]}" Mangled.pp name (Typ.pp Pp.text)
-    typ
-    (Pp.semicolon_seq (Pp.to_string ~f:string_of_var_attribute))
-    attributes
+  F.fprintf fmt "@[<h>{ name=@ %a;@ typ=@ %a" Mangled.pp name (Typ.pp_full Pp.text) typ ;
+  if not (List.is_empty attributes) then
+    F.fprintf fmt ";@ attributes=@ [@[%a@]]"
+      (Pp.semicolon_seq ~print_env:Pp.text_break (Pp.to_string ~f:string_of_var_attribute))
+      attributes ;
+  F.fprintf fmt " }@]"
 
 
 type t =
@@ -144,10 +146,12 @@ let default proc_name =
   ; source_file_captured= SourceFile.invalid __FILE__ }
 
 
-let pp_parameters = Pp.semicolon_seq (Pp.pair ~fst:Mangled.pp ~snd:(Typ.pp Pp.text))
+let pp_parameters =
+  Pp.semicolon_seq ~print_env:Pp.text_break (Pp.pair ~fst:Mangled.pp ~snd:(Typ.pp_full Pp.text))
 
-let pp fmt attributes =
-  let[@warning "+9"] { access
+
+let pp f
+    ({ access
      ; captured
      ; did_preanalysis
      ; err_log
@@ -173,33 +177,76 @@ let pp fmt attributes =
      ; proc_flags
      ; proc_name
      ; ret_type
-                     ; source_file_captured } =
-    attributes
+     ; source_file_captured }[@warning "+9"]) =
+  let default = default proc_name in
+  let pp_bool_default ~default title b f () =
+    if not (Bool.equal default b) then F.fprintf f "; %s= %b@," title b
   in
-  Format.fprintf fmt
-    "{@[access= %a;@ captured= [@[%a@]];@ did_preanalysis= %b;@ err_log= [@[%a%a@]];@ exceptions= \
-     [@[%a@]];@ formals= [@[%a@]];@ const_formals= [@[%a@]];@ by_vals= [@[%a@]];@ \
-     func_attributes= [@[%a@]];@ is_abstract= %b;@ is_bridge_method= %b;@ is_defined= %b;@ \
-     is_cpp_noexcept_method= %b;@ is_java_synchronized_method= %b;@ is_model= %b;@ \
-     is_specialized= %b;@ is_synthetic_method= %b;@ clang_method_kind= %a;@ loc= %a;@ \
-     translation_unit= %a;@ locals= [@[%a@]];@ method_annotation= %a;@ objc_accessor= %a;@ \
-     proc_flags= [@[%a@]];@ proc_name= %a;@ ret_type= %a;@ source_file_captured=%a@]}"
-    (Pp.to_string ~f:PredSymb.string_of_access)
-    access pp_parameters captured did_preanalysis Errlog.pp_errors err_log Errlog.pp_warnings
-    err_log
-    (Pp.semicolon_seq F.pp_print_string)
-    exceptions pp_parameters formals (Pp.semicolon_seq F.pp_print_int) const_formals
-    (Pp.semicolon_seq F.pp_print_int) by_vals
-    (Pp.semicolon_seq PredSymb.pp_func_attribute)
-    func_attributes is_abstract is_bridge_method is_defined is_cpp_noexcept_method
-    is_java_synchronized_method is_model is_specialized is_synthetic_method
+  F.fprintf f "@[<v>{ proc_name= %a@,; source_file_captured= %a@," Typ.Procname.pp proc_name
+    SourceFile.pp source_file_captured ;
+  if not (PredSymb.equal_access default.access access) then
+    F.fprintf f "; access= %a@," (Pp.to_string ~f:PredSymb.string_of_access) access ;
+  if not ([%compare.equal : (Mangled.t * Typ.t) list] default.captured captured) then
+    F.fprintf f "; captured= [@[%a@]]@," pp_parameters captured ;
+  pp_bool_default ~default:default.did_preanalysis "did_preanalysis" did_preanalysis f () ;
+  if not (Errlog.equal default.err_log err_log) then
+    F.fprintf f "; err_log= [@[%a%a@]]@," Errlog.pp_errors err_log Errlog.pp_warnings err_log ;
+  if not ([%compare.equal : string list] default.exceptions exceptions) then
+    F.fprintf f "; exceptions= [@[%a@]]@,"
+      (Pp.semicolon_seq ~print_env:Pp.text_break F.pp_print_string)
+      exceptions ;
+  (* always print formals *)
+  F.fprintf f "; formals= [@[%a@]]@," pp_parameters formals ;
+  if not ([%compare.equal : int list] default.const_formals const_formals) then
+    F.fprintf f "; const_formals= [@[%a@]]@,"
+      (Pp.semicolon_seq ~print_env:Pp.text_break F.pp_print_int)
+      const_formals ;
+  if not ([%compare.equal : int list] default.by_vals by_vals) then
+    F.fprintf f "; by_vals= [@[%a@]]@,"
+      (Pp.semicolon_seq ~print_env:Pp.text_break F.pp_print_int)
+      by_vals ;
+  if not ([%compare.equal : PredSymb.func_attribute list] default.func_attributes func_attributes)
+  then
+    F.fprintf f "; func_attributes= [@[%a@]]@,"
+      (Pp.semicolon_seq ~print_env:Pp.text_break PredSymb.pp_func_attribute)
+      func_attributes ;
+  pp_bool_default ~default:default.did_preanalysis "did_preanalysis" did_preanalysis f () ;
+  pp_bool_default ~default:default.is_abstract "is_abstract" is_abstract f () ;
+  pp_bool_default ~default:default.is_bridge_method "is_bridge_method" is_bridge_method f () ;
+  pp_bool_default ~default:default.is_defined "is_defined" is_defined f () ;
+  pp_bool_default ~default:default.is_cpp_noexcept_method "is_cpp_noexcept_method"
+    is_cpp_noexcept_method f () ;
+  pp_bool_default ~default:default.is_java_synchronized_method "is_java_synchronized_method"
+    is_java_synchronized_method f () ;
+  pp_bool_default ~default:default.is_model "is_model" is_model f () ;
+  pp_bool_default ~default:default.is_specialized "is_specialized" is_specialized f () ;
+  pp_bool_default ~default:default.is_synthetic_method "is_synthetic_method" is_synthetic_method f
+    () ;
+  if not ([%compare.equal : clang_method_kind] default.clang_method_kind clang_method_kind) then
+    F.fprintf f "; clang_method_kind= %a@,"
       (Pp.to_string ~f:string_of_clang_method_kind)
-    clang_method_kind Location.pp loc (Pp.option SourceFile.pp) translation_unit
-    (Pp.semicolon_seq pp_var_data) locals (Annot.Method.pp "") method_annotation
-    (Pp.option pp_objc_accessor_type) objc_accessor
+      clang_method_kind ;
+  if not (Location.equal default.loc loc) then F.fprintf f "; loc= %a@," Location.pp loc ;
+  if not ([%compare.equal : SourceFile.t option] default.translation_unit translation_unit) then
+    F.fprintf f "; translation_unit= %a@," (Pp.option SourceFile.pp) translation_unit ;
+  if not ([%compare.equal : var_data list] default.locals locals) then
+    F.fprintf f "; locals= [@[%a@]]@,"
+      (Pp.semicolon_seq ~print_env:Pp.text_break pp_var_data)
+      locals ;
+  if not (Annot.Method.equal default.method_annotation method_annotation) then
+    F.fprintf f "; method_annotation= %a@," (Annot.Method.pp "") method_annotation ;
+  if not ([%compare.equal : objc_accessor_type option] default.objc_accessor objc_accessor) then
+    F.fprintf f "; objc_accessor= %a@," (Pp.option pp_objc_accessor_type) objc_accessor ;
+  if
+    (* HACK: this hardcodes the default instead of comparing to [default.proc_flags], and tests
+       emptiness in linear time too *)
+    not (Int.equal (Hashtbl.length proc_flags) 0)
+  then
+    F.fprintf f "; proc_flags= [@[%a@]]@,"
       (Pp.hashtbl ~key:F.pp_print_string ~value:F.pp_print_string)
-    proc_flags Typ.Procname.pp proc_name (Typ.pp Pp.text) ret_type SourceFile.pp
-    source_file_captured
+      proc_flags ;
+  (* always print ret type *)
+  F.fprintf f "; ret_type= %a }@]" (Typ.pp_full Pp.text) ret_type
 
 
 module SQLite = SqliteUtils.MarshalledData (struct

infer/src/backend/Procedures.ml

@@ -36,10 +36,10 @@ let pp_all ?filter ~proc_name ~attr_kind ~source_file ~proc_attributes fmt () =
       |> SqliteUtils.check_sqlite_error db ~log:"procedures filter pname bind" ;
       Sqlite3.bind stmt 2 (* :source_file_like *) source_file_like
       |> SqliteUtils.check_sqlite_error db ~log:"procedures filter source file bind" ;
-      let pp_if ?(newline= false) condition deserialize pp fmt column =
+      let pp_if ?(new_line= false) condition title deserialize pp fmt column =
         if condition then (
-          if newline then F.fprintf fmt "@\n  " ;
-          F.fprintf fmt "%a@ " pp (Sqlite3.column stmt column |> deserialize) )
+          if new_line then F.fprintf fmt "@[<v2>" else F.fprintf fmt "@[<h>" ;
+          F.fprintf fmt "%s:@ %a@]@;" title pp (Sqlite3.column stmt column |> deserialize) )
       in
       let rec aux () =
         match Sqlite3.step stmt with
@@ -47,14 +47,15 @@ let pp_all ?filter ~proc_name ~attr_kind ~source_file ~proc_attributes fmt () =
             let proc_name_hum =
               match[@warning "-8"] Sqlite3.column stmt 1 with Sqlite3.Data.TEXT s -> s
             in
-            Format.fprintf fmt "@[<h2>%s:@ %a%a%a%a@]@\n" proc_name_hum
-              (pp_if source_file SourceFile.SQLite.deserialize SourceFile.pp)
+            Format.fprintf fmt "@[<v2>%s@,%a%a%a%a@]@\n" proc_name_hum
+              (pp_if source_file "source_file" SourceFile.SQLite.deserialize SourceFile.pp)
               3
-              (pp_if proc_name Typ.Procname.SQLite.deserialize Typ.Procname.pp)
+              (pp_if proc_name "proc_name" Typ.Procname.SQLite.deserialize Typ.Procname.pp)
               0
-              (pp_if attr_kind Attributes.deserialize_attributes_kind Attributes.pp_attributes_kind)
+              (pp_if attr_kind "attribute_kind" Attributes.deserialize_attributes_kind
+                 Attributes.pp_attributes_kind)
               2
-              (pp_if ~newline:true proc_attributes ProcAttributes.SQLite.deserialize
+              (pp_if ~new_line:true proc_attributes "attributes" ProcAttributes.SQLite.deserialize
                  ProcAttributes.pp)
               4 ;
             aux ()

infer/src/istd/Pp.ml

@@ -58,6 +58,8 @@ let text =
   ; obj_sub= None }
 
 
+let text_break = {text with break_lines= true}
+
 (** Default html print environment *)
 let html color =
   { text with
@@ -128,9 +130,9 @@ let elapsed_time fmt () = Mtime.Span.pp fmt (Mtime_clock.elapsed ())
 
 let option pp fmt = function
   | None ->
-      F.pp_print_string fmt "None"
+      F.pp_print_string fmt "<None>"
   | Some x ->
-      F.fprintf fmt "Some %a" pp x
+      F.fprintf fmt "<Some %a>" pp x
 
 
 let to_string ~f fmt x = F.pp_print_string fmt (f x)
@@ -138,7 +140,7 @@ let to_string ~f fmt x = F.pp_print_string fmt (f x)
 let cli_args fmt args =
   let pp_args fmt args =
     F.fprintf fmt "@[<hov2>  " ;
-    seq ~sep:"" ~print_env:{text with break_lines= true} F.pp_print_string fmt args ;
+    seq ~sep:"" ~print_env:text_break F.pp_print_string fmt args ;
     F.fprintf fmt "@]@\n"
   in
   let rec pp_argfile_args in_argfiles fmt args =

infer/src/istd/Pp.mli

@@ -56,6 +56,9 @@ val extend_colormap : env -> Obj.t -> color -> env
 val text : env
 (** Default text print environment *)
 
+val text_break : env
+(** text print environment that allows line breaks *)
+
 val html : color -> env
 (** Default html print environment *)