Simplify Payloads.pp

Summary: Using `Fields.to_list` also makes sure we don't forget fields.

Reviewed By: ezgicicek

Differential Revision: D15062353

fbshipit-source-id: aaac9be99

infer/src/backend/Payloads.ml

@@ -27,56 +27,36 @@ type t =
   ; uninit: UninitDomain.Summary.t option }
 [@@deriving fields]
 
-let pp pe fmt
+type 'a pp = Pp.env -> F.formatter -> 'a -> unit
-    { annot_map
+
-    ; biabduction
+type field = F : {field: (t, 'a option) Field.t; name: string; pp: 'a pp} -> field
-    ; buffer_overrun_analysis
+
-    ; buffer_overrun_checker
+let fields =
-    ; class_loads
+  let mk field name pp = F {field; name; pp= (fun _ -> pp)} in
-    ; cost
+  let mk_pe field name pp = F {field; name; pp} in
-    ; lab_resource_leaks
+  Fields.to_list
-    ; litho
+    ~annot_map:(fun f -> mk f "AnnotationReachability" AnnotReachabilityDomain.pp)
-    ; pulse
+    ~biabduction:(fun f -> mk_pe f "Biabduction" BiabductionSummary.pp)
-    ; purity
+    ~buffer_overrun_analysis:(fun f -> mk f "BufferOverrunAnalysis" BufferOverrunAnalysisSummary.pp)
-    ; quandary
+    ~buffer_overrun_checker:(fun f -> mk f "BufferOverrunChecker" BufferOverrunCheckerSummary.pp)
-    ; racerd
+    ~class_loads:(fun f -> mk f "ClassLoads" ClassLoadsDomain.pp_summary)
-    ; siof
+    ~cost:(fun f -> mk f "Cost" CostDomain.pp_summary)
-    ; starvation
+    ~litho:(fun f -> mk f "Litho" LithoDomain.pp)
-    ; typestate
+    ~pulse:(fun f -> mk f "Pulse" PulseSummary.pp)
-    ; uninit } =
+    ~purity:(fun f -> mk f "Purity" PurityDomain.pp_summary)
-  let pp_opt prefix pp fmt = function
+    ~quandary:(fun f -> mk f "Quandary" QuandarySummary.pp)
-    | Some x ->
+    ~racerd:(fun f -> mk f "RacerD" RacerDDomain.pp_summary)
-        F.fprintf fmt "%s: %a@\n" prefix pp x
+    ~lab_resource_leaks:(fun f -> mk f "Resource Leaks Lab" ResourceLeakDomain.pp)
-    | None ->
+    ~siof:(fun f -> mk f "Siof" SiofDomain.Summary.pp)
-        ()
+    ~starvation:(fun f -> mk f "Starvation" StarvationDomain.pp_summary)
-  in
+    ~typestate:(fun f -> mk f "TypeState" TypeState.pp)
-  F.fprintf fmt "%a%a%a%a%a%a%a%a%a%a%a%a%a%a%a%a@\n"
+    ~uninit:(fun f -> mk f "Uninitialised" UninitDomain.Summary.pp)
-    (pp_opt "AnnotationReachability" AnnotReachabilityDomain.pp)
+
-    annot_map
+
-    (pp_opt "Biabduction" (BiabductionSummary.pp pe))
+let pp pe f payloads =
-    biabduction
+  List.iter fields ~f:(fun (F {field; name; pp}) ->
-    (pp_opt "BufferOverrunAnalysis" BufferOverrunAnalysisSummary.pp)
+      Field.get field payloads |> Option.iter ~f:(fun x -> F.fprintf f "%s: %a@\n" name (pp pe) x)
-    buffer_overrun_analysis
+  )
-    (pp_opt "BufferOverrunChecker" BufferOverrunCheckerSummary.pp)
-    buffer_overrun_checker
-    (pp_opt "ClassLoads" ClassLoadsDomain.pp_summary)
-    class_loads
-    (pp_opt "Cost" CostDomain.pp_summary)
-    cost (pp_opt "Litho" LithoDomain.pp) litho (pp_opt "Pulse" PulseSummary.pp) pulse
-    (pp_opt "Purity" PurityDomain.pp_summary)
-    purity
-    (pp_opt "Quandary" QuandarySummary.pp)
-    quandary
-    (pp_opt "RacerD" RacerDDomain.pp_summary)
-    racerd
-    (pp_opt "Resource Leaks Lab" ResourceLeakDomain.pp)
-    lab_resource_leaks
-    (pp_opt "Siof" SiofDomain.Summary.pp)
-    siof
-    (pp_opt "Starvation" StarvationDomain.pp_summary)
-    starvation (pp_opt "TypeState" TypeState.pp) typestate
-    (pp_opt "Uninitialised" UninitDomain.Summary.pp)
-    uninit
 
 
 let empty =