[pulse] define PulseSummary.yojson_of_t

Summary:
Emit the crucial parts of Pulse summaries as json to enable
post-processing by external tools. Stop somewhat arbitrarily at some
datatypes that are just emitted as "opaque" values.

For example:
```
$ infer debug --procedures --procedures-summary-json --select 0
[[["pulse",[["ContinueProgram",{"post":{"heap":[["v3",[[["Dereference"],["v4","_"]]]],["v7",[[["Dereference"],["v3","_"]]]]],"stack":[[["ProgramVar",{"plain":"return","mangled":null}],["v7","_"]]],"attrs":"_"},"pre":{"heap":[],"stack":[],"attrs":"_"},"skipped_calls":"_","path_condition":"_"}],["ContinueProgram",{"post":{"heap":[["v3",[[["Dereference"],["v4","_"]]]],["v8",[[["Dereference"],["v3","_"]]]]],"stack":[[["ProgramVar",{"plain":"return","mangled":null}],["v8","_"]]],"attrs":"_"},"pre":{"heap":[],"stack":[],"attrs":"_"},"skipped_calls":"_","path_condition":"_"}]]]]]
```

Reviewed By: ezgicicek

Differential Revision: D24503387

fbshipit-source-id: 9bd08e93b

infer/src/IR/Fieldname.ml

@@ -8,7 +8,7 @@
 open! IStd
 module F = Format
 
-type t = {class_name: Typ.Name.t; field_name: string} [@@deriving compare, equal]
+type t = {class_name: Typ.Name.t; field_name: string} [@@deriving compare, equal, yojson_of]
 
 let make class_name field_name = {class_name; field_name}
 

infer/src/IR/Fieldname.mli

@@ -9,7 +9,7 @@ open! IStd
 module F = Format
 
 (** Names for fields of class/struct/union *)
-type t [@@deriving compare, equal]
+type t [@@deriving compare, equal, yojson_of]
 
 val make : Typ.Name.t -> string -> t
 (** create a field of the given class and fieldname *)

infer/src/IR/Ident.ml

@@ -13,7 +13,8 @@ module Hashtbl = Caml.Hashtbl
 module F = Format
 
 module Name = struct
-  type t = Primed | Normal | Footprint | Spec | FromString of string [@@deriving compare]
+  type t = Primed | Normal | Footprint | Spec | FromString of string
+  [@@deriving compare, yojson_of]
 
   let primed = "t"
 
@@ -52,7 +53,7 @@ type kind =
   | KFootprint
   | KNormal
   | KPrimed
-[@@deriving compare]
+[@@deriving compare, yojson_of]
 
 let kfootprint = KFootprint
 
@@ -65,7 +66,7 @@ let equal_kind = [%compare.equal: kind]
 (* timestamp for a path identifier *)
 let path_ident_stamp = -3
 
-type t = {kind: kind; name: Name.t; stamp: int} [@@deriving compare]
+type t = {kind: kind; name: Name.t; stamp: int} [@@deriving compare, yojson_of]
 
 (* most unlikely first *)
 let equal i1 i2 =

infer/src/IR/Ident.mli

@@ -11,7 +11,7 @@
 open! IStd
 
 (** Program and logical variables. *)
-type t [@@deriving compare]
+type t [@@deriving compare, yojson_of]
 
 val equal : t -> t -> bool
 (** Equality for identifiers. *)

infer/src/IR/Mangled.ml

@@ -11,7 +11,7 @@
 open! IStd
 module F = Format
 
-type t = {plain: string; mangled: string option} [@@deriving compare]
+type t = {plain: string; mangled: string option} [@@deriving compare, yojson_of]
 
 let equal = [%compare.equal: t]
 

infer/src/IR/Mangled.mli

@@ -11,7 +11,7 @@ open! IStd
 (** Module for Mangled Names *)
 
 (** Type of mangled names *)
-type t [@@deriving compare]
+type t [@@deriving compare, yojson_of]
 
 val equal : t -> t -> bool
 (** Equality for mangled names *)

infer/src/IR/Pvar.ml

@@ -35,6 +35,8 @@ type pvar_kind =
 (** Names for program variables. *)
 type t = {pv_hash: int; pv_name: Mangled.t; pv_kind: pvar_kind} [@@deriving compare]
 
+let yojson_of_t {pv_name} = [%yojson_of: Mangled.t] pv_name
+
 let build_formal_from_pvar var =
   match var.pv_kind with
   | Local_var pname ->

infer/src/IR/Pvar.mli

@@ -19,7 +19,7 @@ type translation_unit = SourceFile.t option [@@deriving compare]
     + callee program variables, used to handle recursion ([x | callee] is distinguished from [x])
     + global variables
     + seed variables, used to store the initial value of formal parameters *)
-type t [@@deriving compare]
+type t [@@deriving compare, yojson_of]
 
 val compare_modulo_this : t -> t -> int
 (** Comparison considering all pvars named 'this'/'self' to be equal *)

infer/src/IR/Typ.ml

@@ -202,6 +202,8 @@ module T = struct
     | Template of {mangled: string option; args: template_arg list}
   [@@deriving compare]
 
+  let yojson_of_name = [%yojson_of: _]
+
   let equal_desc = [%compare.equal: desc]
 
   let equal_name = [%compare.equal: name]
@@ -372,7 +374,7 @@ let to_string typ =
 
 
 module Name = struct
-  type t = name [@@deriving compare, equal]
+  type t = name [@@deriving compare, equal, yojson_of]
 
   let equal = [%compare.equal: t]
 

infer/src/IR/Typ.mli

@@ -185,7 +185,7 @@ val is_strong_pointer : t -> bool
 
 module Name : sig
   (** Named types. *)
-  type t = name [@@deriving compare]
+  type t = name [@@deriving compare, yojson_of]
 
   val equal : t -> t -> bool
   (** Equality for typenames *)

infer/src/IR/Var.ml

@@ -10,7 +10,7 @@ module F = Format
 
 (** Single abstraction for all the kinds of variables in SIL *)
 
-type t = LogicalVar of Ident.t | ProgramVar of Pvar.t [@@deriving compare]
+type t = LogicalVar of Ident.t | ProgramVar of Pvar.t [@@deriving compare, yojson_of]
 
 let equal = [%compare.equal: t]
 

infer/src/IR/Var.mli

@@ -9,7 +9,7 @@ open! IStd
 
 (** Single abstraction for all the kinds of variables in SIL *)
 
-type t = private LogicalVar of Ident.t | ProgramVar of Pvar.t [@@deriving compare]
+type t = private LogicalVar of Ident.t | ProgramVar of Pvar.t [@@deriving compare, yojson_of]
 
 val equal : t -> t -> bool
 

infer/src/IR/dune

@@ -11,7 +11,7 @@
     IBase))
  (libraries core zarith IStdlib ATDGenerated IBase)
  (preprocess
-  (pps ppx_compare)))
+  (pps ppx_compare ppx_yojson_conv)))
 
 (documentation
  (package infer)

infer/src/absint/HilExp.ml

@@ -11,6 +11,8 @@ module L = Logging
 
 type typ_ = Typ.t
 
+let yojson_of_typ_ = [%yojson_of: _]
+
 let compare_typ_ _ _ = 0
 
 module Access = struct
@@ -19,7 +21,7 @@ module Access = struct
     | ArrayAccess of typ_ * 'array_index
     | TakeAddress
     | Dereference
-  [@@deriving compare]
+  [@@deriving compare, yojson_of]
 
   let pp pp_array_index fmt = function
     | FieldAccess field_name ->

infer/src/absint/HilExp.mli

@@ -14,7 +14,7 @@ module Access : sig
     | ArrayAccess of Typ.t * 'array_index
     | TakeAddress
     | Dereference
-  [@@deriving compare]
+  [@@deriving compare, yojson_of]
 
   val pp : (Format.formatter -> 'array_index -> unit) -> Format.formatter -> 'array_index t -> unit
 

infer/src/absint/dune

@@ -11,7 +11,7 @@
     -open IBase))
  (libraries core IStdlib ATDGenerated IBase IR)
  (preprocess
-  (pps ppx_compare)))
+  (pps ppx_compare ppx_yojson_conv)))
 
 (documentation
  (package infer)

infer/src/backend/Payloads.ml

@@ -27,7 +27,9 @@ type t =
   ; uninit: UninitDomain.Summary.t option }
 [@@deriving fields]
 
-let yojson_of_t = [%yojson_of: _]
+let yojson_of_t {pulse} =
+  [%yojson_of: (string * PulseSummary.t option) list] [(Checker.get_id Pulse, pulse)]
+
 
 type 'a pp = Pp.env -> F.formatter -> 'a -> unit
 

infer/src/pulse/PulseAbductiveDomain.ml

@@ -19,7 +19,7 @@ module BaseAddressAttributes = PulseBaseAddressAttributes
 module type BaseDomainSig = sig
   (* private because the lattice is not the same for preconditions and postconditions so we don't
      want to confuse them *)
-  type t = private BaseDomain.t
+  type t = private BaseDomain.t [@@deriving yojson_of]
 
   val empty : t
 
@@ -83,6 +83,7 @@ type t =
   ; pre: PreDomain.t  (** inferred pre at the current program point *)
   ; skipped_calls: SkippedCalls.t  (** set of skipped calls *)
   ; path_condition: PathCondition.t }
+[@@deriving yojson_of]
 
 let pp f {post; pre; path_condition; skipped_calls} =
   F.fprintf f "@[<v>%a@;%a@;PRE=[%a]@;skipped_calls=%a@]" PathCondition.pp path_condition
@@ -428,7 +429,7 @@ let invalidate_locals pdesc astate : t =
   else {astate with post= PostDomain.update astate.post ~attrs:attrs'}
 
 
-type summary = t
+type summary = t [@@deriving yojson_of]
 
 let summary_of_post pdesc astate =
   let astate = filter_for_summary astate in

infer/src/pulse/PulseAbductiveDomain.mli

@@ -23,7 +23,9 @@ module BaseStack = PulseBaseStack
 module type BaseDomainSig = sig
   (* private because the lattice is not the same for preconditions and postconditions so we don't
      want to confuse them *)
-  type t = private BaseDomain.t
+  type t = private BaseDomain.t [@@deriving yojson_of]
+
+  val yojson_of_t : t -> Yojson.Safe.t
 
   val empty : t
 
@@ -159,7 +161,7 @@ val add_skipped_calls : SkippedCalls.t -> t -> t
 val set_path_condition : PathCondition.t -> t -> t
 
 (** private type to make sure {!summary_of_post} is always called when creating summaries *)
-type summary = private t
+type summary = private t [@@deriving yojson_of]
 
 val summary_of_post : Procdesc.t -> t -> summary
 (** trim the state down to just the procedure's interface (formals and globals), and simplify and

infer/src/pulse/PulseAbstractValue.ml

@@ -23,6 +23,8 @@ let mk_fresh () =
 
 let pp f l = F.fprintf f "v%d" l
 
+let yojson_of_t l = `String (F.asprintf "%a" pp l)
+
 let of_id v = v
 
 module PPKey = struct

infer/src/pulse/PulseAbstractValue.mli

@@ -8,7 +8,7 @@ open! IStd
 module F = Format
 
 (** An abstract value, eg an address in memory. *)
-type t = private int [@@deriving compare]
+type t = private int [@@deriving compare, yojson_of]
 
 val equal : t -> t -> bool
 

infer/src/pulse/PulseBaseAddressAttributes.ml

@@ -19,6 +19,8 @@ module Graph = PrettyPrintable.MakePPMonoMap (AbstractValue) (AttributesNoRank)
 
 type t = Graph.t
 
+let yojson_of_t = [%yojson_of: _]
+
 let add_one addr attribute attrs =
   match Graph.find_opt addr attrs with
   | None ->

infer/src/pulse/PulseBaseAddressAttributes.mli

@@ -8,7 +8,7 @@ open! IStd
 module F = Format
 open PulseBasicInterface
 
-type t
+type t [@@deriving yojson_of]
 
 val empty : t
 

infer/src/pulse/PulseBaseDomain.ml

@@ -14,7 +14,7 @@ module AddressAttributes = PulseBaseAddressAttributes
 
 (* {2 Abstract domain description } *)
 
-type t = {heap: Memory.t; stack: Stack.t; attrs: AddressAttributes.t}
+type t = {heap: Memory.t; stack: Stack.t; attrs: AddressAttributes.t} [@@deriving yojson_of]
 
 let empty =
   { heap=

infer/src/pulse/PulseBaseDomain.mli

@@ -10,6 +10,7 @@ open PulseBasicInterface
 module F = Format
 
 type t = {heap: PulseBaseMemory.t; stack: PulseBaseStack.t; attrs: PulseBaseAddressAttributes.t}
+[@@deriving yojson_of]
 
 type cell = PulseBaseMemory.Edges.t * Attributes.t
 

infer/src/pulse/PulseBaseMemory.ml

@@ -11,7 +11,7 @@ open PulseBasicInterface
 (* {3 Heap domain } *)
 
 module Access = struct
-  type t = AbstractValue.t HilExp.Access.t [@@deriving compare]
+  type t = AbstractValue.t HilExp.Access.t [@@deriving compare, yojson_of]
 
   let equal = [%compare.equal: t]
 
@@ -19,7 +19,7 @@ module Access = struct
 end
 
 module AddrTrace = struct
-  type t = AbstractValue.t * ValueHistory.t [@@deriving compare]
+  type t = AbstractValue.t * ValueHistory.t [@@deriving compare, yojson_of]
 
   let pp fmt addr_trace =
     if Config.debug_level_analysis >= 3 then
@@ -27,11 +27,14 @@ module AddrTrace = struct
     else AbstractValue.pp fmt (fst addr_trace)
 end
 
-module Edges =
-  RecencyMap.Make (Access) (AddrTrace)
-    (struct
-      let limit = Config.pulse_recency_limit
-    end)
+module Edges = struct
+  include RecencyMap.Make (Access) (AddrTrace)
+            (struct
+              let limit = Config.pulse_recency_limit
+            end)
+
+  let yojson_of_t edges = [%yojson_of: (Access.t * AddrTrace.t) list] (bindings edges)
+end
 
 module Graph = PrettyPrintable.MakePPMonoMap (AbstractValue) (Edges)
 
@@ -50,4 +53,6 @@ let find_edge_opt addr access memory =
   Graph.find_opt addr memory >>= Edges.find_opt access
 
 
+let yojson_of_t g = [%yojson_of: (AbstractValue.t * Edges.t) list] (Graph.bindings g)
+
 include Graph

infer/src/pulse/PulseBaseMemory.mli

@@ -27,3 +27,5 @@ val register_address : AbstractValue.t -> t -> t
 val add_edge : AbstractValue.t -> Access.t -> AddrTrace.t -> t -> t
 
 val find_edge_opt : AbstractValue.t -> Access.t -> t -> AddrTrace.t option
+
+val yojson_of_t : t -> Yojson.Safe.t

infer/src/pulse/PulseBaseStack.ml

@@ -19,7 +19,7 @@ module VarAddress = struct
 end
 
 module AddrHistPair = struct
-  type t = AbstractValue.t * ValueHistory.t [@@deriving compare]
+  type t = AbstractValue.t * ValueHistory.t [@@deriving compare, yojson_of]
 
   let pp f addr_trace =
     if Config.debug_level_analysis >= 3 then
@@ -37,3 +37,5 @@ let pp fmt m =
 
 
 let compare = compare AddrHistPair.compare
+
+let yojson_of_t m = [%yojson_of: (VarAddress.t * AddrHistPair.t) list] (bindings m)

infer/src/pulse/PulseBaseStack.mli

@@ -16,3 +16,5 @@ include
 val compare : t -> t -> int [@@warning "-32"]
 
 val pp : F.formatter -> t -> unit
+
+val yojson_of_t : t -> Yojson.Safe.t

infer/src/pulse/PulseDiagnostic.ml

@@ -19,6 +19,8 @@ type access_to_invalid_address =
   ; access_trace: Trace.t }
 [@@deriving equal]
 
+let yojson_of_access_to_invalid_address = [%yojson_of: _]
+
 type t =
   | AccessToInvalidAddress of access_to_invalid_address
   | MemoryLeak of {procname: Procname.t; allocation_trace: Trace.t; location: Location.t}

infer/src/pulse/PulseDiagnostic.mli

@@ -22,7 +22,7 @@ type access_to_invalid_address =
   ; access_trace: Trace.t
         (** assuming we are in the calling context, the trace leads to an access to the value
             invalidated in [invalidation_trace] without further assumptions *) }
-[@@deriving equal]
+[@@deriving equal, yojson_of]
 
 (** an error to report to the user *)
 type t =

infer/src/pulse/PulseExecutionDomain.ml

@@ -21,6 +21,7 @@ type 'abductive_domain_t base_t =
   | ExitProgram of 'abductive_domain_t
   | AbortProgram of AbductiveDomain.summary
   | LatentAbortProgram of {astate: AbductiveDomain.summary; latent_issue: LatentIssue.t}
+[@@deriving yojson_of]
 
 type t = AbductiveDomain.t base_t
 
@@ -70,7 +71,7 @@ let map ~f exec_state =
       LatentAbortProgram {astate; latent_issue}
 
 
-type summary = AbductiveDomain.summary base_t
+type summary = AbductiveDomain.summary base_t [@@deriving yojson_of]
 
 let summary_of_posts pdesc posts =
   List.filter_mapi posts ~f:(fun i exec_state ->

infer/src/pulse/PulseExecutionDomain.mli

@@ -25,6 +25,6 @@ val continue : AbductiveDomain.t -> t
 
 val mk_initial : Procdesc.t -> t
 
-type summary = AbductiveDomain.summary base_t
+type summary = AbductiveDomain.summary base_t [@@deriving yojson_of]
 
 val summary_of_posts : Procdesc.t -> t list -> summary list

infer/src/pulse/PulseLatentIssue.ml

@@ -10,7 +10,8 @@ open PulseBasicInterface
 module AbductiveDomain = PulseAbductiveDomain
 module Arithmetic = PulseArithmetic
 
-type t = AccessToInvalidAddress of Diagnostic.access_to_invalid_address [@@deriving equal]
+type t = AccessToInvalidAddress of Diagnostic.access_to_invalid_address
+[@@deriving equal, yojson_of]
 
 let to_diagnostic = function
   | AccessToInvalidAddress access_to_invalid_address ->

infer/src/pulse/PulseLatentIssue.mli

@@ -13,7 +13,8 @@ module AbductiveDomain = PulseAbductiveDomain
     but we want to delay reporting until we see the conditions for the bug manifest themselves in
     some calling context. *)
 
-type t = AccessToInvalidAddress of Diagnostic.access_to_invalid_address [@@deriving equal]
+type t = AccessToInvalidAddress of Diagnostic.access_to_invalid_address
+[@@deriving equal, yojson_of]
 
 val to_diagnostic : t -> Diagnostic.t
 

infer/src/pulse/PulsePathCondition.ml

@@ -34,6 +34,8 @@ type t =
   ; citvs: CItvs.t
   ; formula: Formula.t }
 
+let yojson_of_t = [%yojson_of: _]
+
 let pp fmt {is_unsat; bo_itvs; citvs; formula} =
   F.fprintf fmt "@[<hv>unsat:%b,@;bo: @[%a@],@;citv: @[%a@],@;formula: @[%a@]@]" is_unsat BoItvs.pp
     bo_itvs CItvs.pp citvs Formula.pp formula

infer/src/pulse/PulsePathCondition.mli

@@ -10,7 +10,7 @@ module F = Format
 module AbstractValue = PulseAbstractValue
 module ValueHistory = PulseValueHistory
 
-type t
+type t [@@deriving yojson_of]
 
 val true_ : t
 

infer/src/pulse/PulseSkippedCalls.ml

@@ -24,3 +24,5 @@ module SkippedTrace = struct
 end
 
 include AbstractDomain.Map (Procname) (SkippedTrace)
+
+let yojson_of_t = [%yojson_of: _]

infer/src/pulse/PulseSkippedCalls.mli

@@ -8,3 +8,5 @@
 open! IStd
 
 include AbstractDomain.MapS with type key = Procname.t and type value = PulseTrace.t
+
+val yojson_of_t : t -> Yojson.Safe.t

infer/src/pulse/PulseSummary.ml

@@ -9,7 +9,7 @@ open! IStd
 module F = Format
 open PulseDomainInterface
 
-type t = ExecutionDomain.summary list
+type t = ExecutionDomain.summary list [@@deriving yojson_of]
 
 let pp fmt summary =
   F.open_vbox 0 ;

infer/src/pulse/PulseSummary.mli

@@ -8,7 +8,7 @@
 open! IStd
 open PulseDomainInterface
 
-type t = ExecutionDomain.summary list
+type t = ExecutionDomain.summary list [@@deriving yojson_of]
 
 val of_posts : Procdesc.t -> ExecutionDomain.t list -> t
 

infer/src/pulse/PulseValueHistory.ml

@@ -21,6 +21,10 @@ type event =
 
 and t = event list [@@deriving compare, equal]
 
+let yojson_of_event = [%yojson_of: _]
+
+let yojson_of_t = [%yojson_of: _]
+
 let pp_event_no_location fmt event =
   let pp_pvar fmt pvar =
     if Pvar.is_global pvar then F.fprintf fmt "global variable `%a`" Pvar.pp_value_non_verbose pvar

infer/src/pulse/PulseValueHistory.mli

@@ -19,7 +19,7 @@ type event =
   | VariableAccessed of Pvar.t * Location.t
   | VariableDeclared of Pvar.t * Location.t
 
-and t = event list [@@deriving compare, equal]
+and t = event list [@@deriving compare, equal, yojson_of]
 
 val pp : F.formatter -> t -> unit
 

infer/src/pulse/dune

@@ -11,4 +11,4 @@
     -open IBase -open Absint -open BO))
  (libraries core IStdlib ATDGenerated IBase IR Absint BO)
  (preprocess
-  (pps ppx_compare ppx_variants_conv)))
+  (pps ppx_yojson_conv ppx_compare ppx_variants_conv)))