Rewire interprocedural to be one-Analysis [2] simplify accumulations

Summary:
In the previous diff, to keep the review easy I made minimal changes to
functions' top-level signatures, but preserved the inner logic which left
a bunch of functions folding over just one abstract kind.

In this diff I clean that up - the resulting functions are identical but
shorter and easier to read.

I'm not yet changing `model_t` and `result_t` to contain just a single
analysis because that will be a big change, and I'd prefer to have things
as clean as possible beforehand to minimize confusion. I'll stack that change
on top which will further simplify the code.

Reviewed By: dkgi

Differential Revision: D28886237

fbshipit-source-id: 722833a8d7d0e7f8e1384dcc41eb873a0d764930

Author: stroxler

source/interprocedural/interproceduralAnalysis.ml

@@ -24,36 +24,21 @@ type initialize_result = {
 }
 
 let initialize_models kind ~scheduler ~static_analysis_configuration ~environment ~functions ~stubs =
-  let initialize_each
-      { initial_models = models; skip_overrides }
-      (Result.Analysis { kind; analysis })
-    =
-    let module Analysis = (val analysis) in
-    let { Result.initial_models = new_models; skip_overrides = new_skip_overrides } =
-      Analysis.initialize_models
-        ~static_analysis_configuration
-        ~scheduler
-        ~environment
-        ~functions
-        ~stubs
-    in
-    let add_analysis_model existing model =
-      let open Result in
-      let package = Pkg { kind = ModelPart kind; value = model } in
-      { existing with models = Kind.Map.add (Kind.abstract kind) package existing.models }
-    in
-    let merge ~key:_ = function
-      | `Both (existing, new_model) -> Some (add_analysis_model existing new_model)
-      | `Left existing -> Some existing
-      | `Right new_model -> Some (add_analysis_model Result.empty_model new_model)
-    in
-    {
-      initial_models = Callable.Map.merge models new_models ~f:merge;
-      skip_overrides = Reference.Set.union skip_overrides new_skip_overrides;
-    }
+  let (Result.Analysis { analysis; kind = storable_kind }) = Result.get_abstract_analysis kind in
+  let module Analysis = (val analysis) in
+  let { Result.initial_models = analysis_initial_models; skip_overrides } =
+    Analysis.initialize_models
+      ~static_analysis_configuration
+      ~scheduler
+      ~environment
+      ~functions
+      ~stubs
   in
-  let accumulate model kind = initialize_each model (Result.get_abstract_analysis kind) in
-  accumulate { initial_models = Callable.Map.empty; skip_overrides = Reference.Set.empty } kind
+  let to_model_t model =
+    let pkg = Result.Pkg { kind = ModelPart storable_kind; value = model } in
+    { Result.models = Kind.Map.add kind pkg Kind.Map.empty; is_obscure = false }
+  in
+  { initial_models = analysis_initial_models |> Callable.Map.map ~f:to_model_t; skip_overrides }
 
 
 let record_initial_models ~functions ~stubs models =
@@ -96,17 +81,16 @@ let get_empty_model (type a) (kind : < model : a ; .. > Result.storable_kind) :
   Analysis.empty_model
 
 
-let get_obscure_models analysis =
-  let get_analysis_specific_obscure_model map abstract_analysis =
+let get_obscure_models abstract_analysis =
+  let models =
     let (Result.Analysis { kind; analysis }) = abstract_analysis in
     let module Analysis = (val analysis) in
     let obscure_model = Analysis.obscure_model in
     Kind.Map.add
       (Kind.abstract kind)
       (Result.Pkg { kind = ModelPart kind; value = obscure_model })
-      map
+      Kind.Map.empty
   in
-  let models = get_analysis_specific_obscure_model Kind.Map.empty analysis in
   Result.{ models; is_obscure = true }
 
 
@@ -200,9 +184,9 @@ let explain_non_fixpoint ~iteration ~previous ~next =
 let show_models models =
   let open Result in
   (* list them to make the type system do its work *)
-  let to_string (akind, Pkg { kind = ModelPart kind; value = model }) =
+  let to_string (abstract_kind, Pkg { kind = ModelPart kind; value = model }) =
     let module Analysis = (val get_analysis kind) in
-    Format.sprintf "%s: %s" (Kind.show akind) (Analysis.show_call_model model)
+    Format.sprintf "%s: %s" (Kind.show abstract_kind) (Analysis.show_call_model model)
   in
   Kind.Map.bindings models |> List.map ~f:to_string |> String.concat ~sep:"\n"
 
@@ -282,7 +266,7 @@ let widen_if_necessary step callable ~old_model ~new_model result =
 
 let analyze_define
     step
-    analysis
+    abstract_analysis
     callable
     environment
     qualifier
@@ -305,24 +289,17 @@ let analyze_define
     | None ->
         Format.asprintf "No initial model found for %a" Callable.pretty_print callable |> failwith
   in
-  let new_model, results =
-    let analyze (Result.Analysis { Result.kind; analysis }) =
+  let models, results =
+    try
+      let (Result.Analysis { Result.kind; analysis }) = abstract_analysis in
       let open Result in
-      let akind = Kind.abstract kind in
+      let abstract_kind = Kind.abstract kind in
       let module Analysis = (val analysis) in
       let existing = Result.get (ModelPart kind) old_model.models in
-      let method_result, method_model =
-        Analysis.analyze ~callable ~environment ~qualifier ~define ~existing
-      in
-      ( akind,
-        Pkg { kind = ModelPart kind; value = method_model },
-        Pkg { kind = ResultPart kind; value = method_result } )
-    in
-    let accumulate (models, results) analysis =
-      let akind, model, result = analyze analysis in
-      Result.Kind.Map.add akind model models, Result.Kind.Map.add akind result results
-    in
-    try accumulate Result.Kind.Map.(empty, empty) analysis with
+      let result, model = Analysis.analyze ~callable ~environment ~qualifier ~define ~existing in
+      ( Kind.Map.add abstract_kind (Pkg { kind = ModelPart kind; value = model }) Kind.Map.empty,
+        Kind.Map.add abstract_kind (Pkg { kind = ResultPart kind; value = result }) Kind.Map.empty )
+    with
     | Analysis.ClassHierarchy.Untracked annotation ->
         Log.log
           ~section:`Info
@@ -334,17 +311,17 @@ let analyze_define
     | Sys.Break as exn -> analysis_failed step ~exn ~message:"Hit Ctrl+C" callable
     | _ as exn -> analysis_failed step ~exn ~message:"Analysis failed" callable
   in
-  let new_model = { Result.models = new_model; is_obscure = false } in
+  let new_model = { Result.models; is_obscure = false } in
   widen_if_necessary step callable ~old_model ~new_model results
 
 
 let strip_for_callsite model =
   let open Result in
   (* list them to make the type system do its work *)
-  let strip akind (Pkg { kind = ModelPart kind; value = model }) models =
+  let strip abstract_kind (Pkg { kind = ModelPart kind; value = model }) models =
     let module Analysis = (val get_analysis kind) in
     let model = Analysis.strip_for_callsite model in
-    Kind.Map.add akind (Pkg { kind = ModelPart kind; value = model }) models
+    Kind.Map.add abstract_kind (Pkg { kind = ModelPart kind; value = model }) models
   in
   let models = Kind.Map.fold strip model.InterproceduralResult.models Kind.Map.empty in
   { model with models }