[ondemand] remove type environments from cluster callbacks

Summary: There is no need to provide type environments to cluster analysers, since the execution environment can be used to retrieve those on demand.

Reviewed By: jvillard

Differential Revision: D19543561

fbshipit-source-id: f9b064011

infer/src/backend/callbacks.ml

@@ -15,7 +15,7 @@ type proc_callback_args =
 type proc_callback_t = proc_callback_args -> Summary.t
 
 type cluster_callback_args =
-  {procedures: (Tenv.t * Summary.t) list; source_file: SourceFile.t; exe_env: Exe_env.t}
+  {procedures: Summary.t list; source_file: SourceFile.t; exe_env: Exe_env.t}
 
 type cluster_callback_t = cluster_callback_args -> unit
 
@@ -37,12 +37,8 @@ let register_cluster_callback ~name language (callback : cluster_callback_t) =
   cluster_callbacks := {name; language; callback} :: !cluster_callbacks
 
 
-(** Collect what we need to know about a procedure for the analysis. *)
-let get_procedure_definition exe_env proc_name =
-  Procdesc.load proc_name
-  |> Option.map ~f:(fun proc_desc ->
-         let tenv = Exe_env.get_tenv exe_env proc_name in
-         (tenv, Summary.OnDisk.reset proc_desc) )
+let get_procedure_definition proc_name =
+  Procdesc.load proc_name |> Option.map ~f:Summary.OnDisk.reset
 
 
 (** Invoke all registered procedure callbacks on the given procedure. *)
@@ -80,11 +76,11 @@ let iterate_procedure_callbacks exe_env summary =
 (** Invoke all registered cluster callbacks on a cluster of procedures. *)
 let iterate_cluster_callbacks all_procs exe_env source_file =
   if !cluster_callbacks <> [] then
-    let procedures = List.filter_map ~f:(get_procedure_definition exe_env) all_procs in
+    let procedures = List.filter_map ~f:get_procedure_definition all_procs in
     let environment = {procedures; source_file; exe_env} in
     let language_matches language =
       match procedures with
-      | (_, summary) :: _ ->
+      | summary :: _ ->
           Language.equal language (Procname.get_language (Summary.get_proc_name summary))
       | _ ->
           true

infer/src/backend/callbacks.mli

@@ -21,7 +21,7 @@ type proc_callback_args =
 type proc_callback_t = proc_callback_args -> Summary.t
 
 type cluster_callback_args =
-  {procedures: (Tenv.t * Summary.t) list; source_file: SourceFile.t; exe_env: Exe_env.t}
+  {procedures: Summary.t list; source_file: SourceFile.t; exe_env: Exe_env.t}
 
 type cluster_callback_t = cluster_callback_args -> unit
 

infer/src/concurrency/RacerD.ml

@@ -1093,37 +1093,40 @@ let report_unsafe_accesses ~issue_log classname (aggregated_access_map : ReportM
    may touch that memory loc. the abstraction of a location is an access
    path like x.f.g whose concretization is the set of memory cells
    that x.f.g may point to during execution *)
-let make_results_table file_env =
+let make_results_table exe_env summaries =
   let open RacerDDomain in
   let aggregate_post tenv procname acc {threads; accesses} =
     AccessDomain.fold
       (fun snapshot acc -> ReportMap.add {threads; snapshot; tenv; procname} acc)
       accesses acc
   in
-  List.fold file_env ~init:ReportMap.empty ~f:(fun acc (tenv, summary) ->
+  List.fold summaries ~init:ReportMap.empty ~f:(fun acc summary ->
       let procname = Summary.get_proc_name summary in
+      let tenv = Exe_env.get_tenv exe_env procname in
       Payload.read_toplevel_procedure procname
       |> Option.fold ~init:acc ~f:(aggregate_post tenv procname) )
 
 
 (* aggregate all of the procedures in the file env by their declaring
    class. this lets us analyze each class individually *)
-let aggregate_by_class file_env =
-  List.fold file_env ~init:String.Map.empty ~f:(fun acc ((tenv, summary) as proc) ->
+let aggregate_by_class exe_env file_env =
+  List.fold file_env ~init:String.Map.empty ~f:(fun acc summary ->
       let pdesc = Summary.get_proc_desc summary in
+      let procname = Summary.get_proc_name summary in
+      let tenv = Exe_env.get_tenv exe_env procname in
       if should_report_on_proc tenv pdesc then
         Procdesc.get_proc_name pdesc |> Procname.get_class_name
         |> Option.fold ~init:acc ~f:(fun acc classname ->
-               String.Map.add_multi acc ~key:classname ~data:proc )
+               String.Map.add_multi acc ~key:classname ~data:summary )
       else acc )
 
 
 (* Gathers results by analyzing all the methods in a file, then
    post-processes the results to check an (approximation of) thread
    safety *)
-let file_analysis ({procedures; source_file} : Callbacks.cluster_callback_args) =
+let file_analysis ({procedures; source_file; exe_env} : Callbacks.cluster_callback_args) =
   let init = IssueLog.empty in
-  aggregate_by_class procedures
-  |> String.Map.fold ~init ~f:(fun ~key:classname ~data:class_env issue_log ->
-         make_results_table class_env |> report_unsafe_accesses ~issue_log classname )
+  aggregate_by_class exe_env procedures
+  |> String.Map.fold ~init ~f:(fun ~key:classname ~data:summaries issue_log ->
+         make_results_table exe_env summaries |> report_unsafe_accesses ~issue_log classname )
   |> IssueLog.store ~dir:Config.racerd_issues_dir_name ~file:source_file

infer/src/concurrency/starvation.ml

@@ -658,7 +658,7 @@ let report_on_parallel_composition ~should_report_starvation tenv pdesc pair loc
   else report_map
 
 
-let report_on_pair ((tenv, summary) as env) (pair : Domain.CriticalPair.t) report_map =
+let report_on_pair tenv summary (pair : Domain.CriticalPair.t) report_map =
   let open Domain in
   let pdesc = Summary.get_proc_desc summary in
   let pname = Summary.get_proc_name summary in
@@ -716,7 +716,7 @@ let report_on_pair ((tenv, summary) as env) (pair : Domain.CriticalPair.t) repor
                 and retrieve all the summaries of the methods of that class;
                 then, report on the parallel composition of the current pair and any pair in these
                 summaries that can indeed run in parallel *)
-             fold_reportable_summaries env other_class ~init:report_map
+             fold_reportable_summaries (tenv, summary) other_class ~init:report_map
                ~f:(fun acc (other_pname, {critical_pairs}) ->
                  CriticalPairs.fold
                    (report_on_parallel_composition ~should_report_starvation tenv pdesc pair lock
@@ -726,17 +726,19 @@ let report_on_pair ((tenv, summary) as env) (pair : Domain.CriticalPair.t) repor
       report_map
 
 
-let reporting {Callbacks.procedures} =
+let reporting {Callbacks.procedures; exe_env} =
   if Config.starvation_whole_program then ()
   else
-    let report_on_summary env report_map (summary : Domain.summary) =
-      Domain.CriticalPairs.fold (report_on_pair env) summary.critical_pairs report_map
+    let report_on_summary tenv summary report_map (payload : Domain.summary) =
+      Domain.CriticalPairs.fold (report_on_pair tenv summary) payload.critical_pairs report_map
     in
-    let report_procedure report_map ((_, summary) as env) =
+    let report_procedure report_map summary =
       let proc_desc = Summary.get_proc_desc summary in
+      let procname = Summary.get_proc_name summary in
+      let tenv = Exe_env.get_tenv exe_env procname in
       if should_report proc_desc then
-        Payload.read_toplevel_procedure (Procdesc.get_proc_name proc_desc)
-        |> Option.fold ~init:report_map ~f:(report_on_summary env)
+        Payload.read_toplevel_procedure procname
+        |> Option.fold ~init:report_map ~f:(report_on_summary tenv summary)
       else report_map
     in
     List.fold procedures ~init:ReportMap.empty ~f:report_procedure |> ReportMap.store
@@ -793,7 +795,7 @@ let report exe_env work_set =
     |> Option.fold ~init ~f:(fun acc summary ->
            let pdesc = Summary.get_proc_desc summary in
            let tenv = Exe_env.get_tenv exe_env procname in
-           let acc = report_on_pair (tenv, summary) pair acc in
+           let acc = report_on_pair tenv summary pair acc in
            match pair.elem.event with
            | LockAcquire lock ->
                let should_report_starvation =