[multicore] easier access to DLS module

Summary: Domain local storage will play a big role in making Infer thread safe, so set `DLS=Domain.DLS` for easier access.

Reviewed By: davidpichardie

Differential Revision:
D67085260

Privacy Context Container: L1208441

fbshipit-source-id: 972ffdcf158d2891cbcfcf98e45b17e2774368db

infer/src/IR/AnalysisGlobalState.ml

@@ -41,9 +41,9 @@ let register_ref ~init ref_ =
 let register_dls_with_proc_desc_and_tenv ~init key =
   stores :=
     StateManager
-      { save= (fun () -> Domain.DLS.get key)
-      ; restore= (fun x -> Domain.DLS.set key x)
-      ; init= (fun proc_desc tenv -> Domain.DLS.set key (init proc_desc tenv)) }
+      { save= (fun () -> DLS.get key)
+      ; restore= (fun x -> DLS.set key x)
+      ; init= (fun proc_desc tenv -> DLS.set key (init proc_desc tenv)) }
     :: !stores
 
 

infer/src/IR/AnalysisGlobalState.mli

@@ -33,12 +33,10 @@ val register : init:(unit -> unit) -> save:(unit -> 'a) -> restore:('a -> unit)
 val register_ref : init:(unit -> 'a) -> 'a ref -> unit
 (** special case of a value stored in a reference; [init] sets the ref to [init ()] *)
 
-val register_dls : init:(unit -> 'a) -> 'a Domain.DLS.key -> unit
+val register_dls : init:(unit -> 'a) -> 'a DLS.key -> unit
 (** special case of a value stored in domain-local storage; [init] sets the ref to [init ()] *)
 
-val register_dls_with_proc_desc_and_tenv :
-  init:(Procdesc.t -> Tenv.t -> 'a) -> 'a Domain.DLS.key -> unit
-[@@warning "-unused-value-declaration"]
+val register_dls_with_proc_desc_and_tenv : init:(Procdesc.t -> Tenv.t -> 'a) -> 'a DLS.key -> unit
 (** special case of a value stored in domain local storage *)
 
 val register_ref_with_proc_desc_and_tenv : init:(Procdesc.t -> Tenv.t -> 'a) -> 'a ref -> unit

infer/src/IR/Dependencies.ml

@@ -9,9 +9,7 @@ open! IStd
 module F = Format
 module L = Logging
 
-let currently_under_analysis : Procname.t option Domain.DLS.key =
-  Domain.DLS.new_key (fun () -> None)
-
+let currently_under_analysis : Procname.t option DLS.key = DLS.new_key (fun () -> None)
 
 type complete =
   { summary_loads: Procname.t list
@@ -27,8 +25,8 @@ type partial =
   ; partial_other_proc_names: Procname.HashSet.t
   ; partial_used_tenv_sources: SourceFile.HashSet.t }
 
-let deps_in_progress : partial Procname.Hash.t Domain.DLS.key =
-  Domain.DLS.new_key (fun () -> Procname.Hash.create 0)
+let deps_in_progress : partial Procname.Hash.t DLS.key =
+  DLS.new_key (fun () -> Procname.Hash.create 0)
 
 
 let reset pname =
@@ -38,7 +36,7 @@ let reset pname =
     ; partial_other_proc_names= Procname.HashSet.create 0
     ; partial_used_tenv_sources= SourceFile.HashSet.create 0 }
   in
-  Procname.Hash.replace (Domain.DLS.get deps_in_progress) pname partial ;
+  Procname.Hash.replace (DLS.get deps_in_progress) pname partial ;
   Partial
 
 
@@ -49,7 +47,7 @@ let freeze pname deps =
           ; partial_recursion_edges
           ; partial_other_proc_names
           ; partial_used_tenv_sources } =
-        Procname.Hash.find (Domain.DLS.get deps_in_progress) pname
+        Procname.Hash.find (DLS.get deps_in_progress) pname
       in
       (* make sets pairwise disjoint to save space in summaries, in case we first added a procedure
          to "other" and *then* to "summary loads", for example *)
@@ -81,12 +79,10 @@ let complete_exn = function
 type kind = SummaryLoad | RecursionEdge | Other
 
 let record_pname_dep ?caller kind callee =
-  let caller =
-    match caller with Some _ -> caller | None -> Domain.DLS.get currently_under_analysis
-  in
+  let caller = match caller with Some _ -> caller | None -> DLS.get currently_under_analysis in
   match caller with
   | Some caller when not (Procname.equal caller callee) ->
-      Procname.Hash.find_opt (Domain.DLS.get deps_in_progress) caller
+      Procname.Hash.find_opt (DLS.get deps_in_progress) caller
       |> Option.iter
            ~f:(fun {partial_summary_loads; partial_recursion_edges; partial_other_proc_names} ->
              match kind with
@@ -109,15 +105,15 @@ let record_pname_dep ?caller kind callee =
 
 
 let record_srcfile_dep src_file =
-  Domain.DLS.get currently_under_analysis
-  |> Option.bind ~f:(Procname.Hash.find_opt (Domain.DLS.get deps_in_progress))
+  DLS.get currently_under_analysis
+  |> Option.bind ~f:(Procname.Hash.find_opt (DLS.get deps_in_progress))
   |> Option.iter ~f:(fun {partial_used_tenv_sources} ->
          SourceFile.HashSet.add src_file partial_used_tenv_sources )
 
 
 let clear () =
-  Procname.Hash.clear (Domain.DLS.get deps_in_progress) ;
-  Domain.DLS.set currently_under_analysis None
+  Procname.Hash.clear (DLS.get deps_in_progress) ;
+  DLS.set currently_under_analysis None
 
 
 let pp fmt = function

infer/src/IR/Dependencies.mli

@@ -31,7 +31,7 @@ val pp : F.formatter -> t -> unit
     in the Backend module to conservatively invalidate procedure summaries that were computed using
     out-of-date type environment information. *)
 
-val currently_under_analysis : Procname.t option Domain.DLS.key
+val currently_under_analysis : Procname.t option DLS.key
 
 val reset : Procname.t -> t
 

infer/src/absint/AbstractInterpreter.ml

@@ -187,7 +187,7 @@ module DisjunctiveMetadata = struct
      of metadata since otherwise we would need to carry the metadata around the analysis while being
      careful to avoid double-counting. With a reference this is simpler to achieve as we can simply
      update it whenever a relevant action is taken (eg dropping a disjunct). *)
-  let proc_metadata = Domain.DLS.new_key (fun () -> empty)
+  let proc_metadata = DLS.new_key (fun () -> empty)
 
   let () = AnalysisGlobalState.register_dls ~init:(fun () -> empty) proc_metadata
 
@@ -568,7 +568,7 @@ module AbstractInterpreterCommon (TransferFunctions : NodeTransferFunctions) = s
 
 
   (** reference to log errors only at the innermost recursive call *)
-  let logged_error = Stdlib.Domain.DLS.new_key (fun () -> false)
+  let logged_error = DLS.new_key (fun () -> false)
 
   let dump_html f pre post_result =
     let pp_post_error f (exn, _, instr) =
@@ -617,7 +617,7 @@ module AbstractInterpreterCommon (TransferFunctions : NodeTransferFunctions) = s
               let post = TransferFunctions.exec_instr pre proc_data node idx instr in
               Timer.check_timeout () ;
               (* don't forget to reset this so we output messages for future errors too *)
-              Stdlib.Domain.DLS.set logged_error false ;
+              DLS.set logged_error false ;
               Ok post
             with exn ->
               (* delay reraising to get a chance to write the debug HTML *)
@@ -636,11 +636,11 @@ module AbstractInterpreterCommon (TransferFunctions : NodeTransferFunctions) = s
               (* this isn't an error; don't log it *)
               ()
           | _ ->
-              if not (Stdlib.Domain.DLS.get logged_error) then (
+              if not (DLS.get logged_error) then (
                 L.internal_error "In instruction %a@\n"
                   (Sil.pp_instr ~print_types:true Pp.text)
                   instr ;
-                Stdlib.Domain.DLS.set logged_error true ) ) ;
+                DLS.set logged_error true ) ) ;
           Stdlib.Printexc.raise_with_backtrace exn backtrace
     in
     (* hack to ensure that we call [exec_instr] on a node even if it has no instructions *)
@@ -937,7 +937,7 @@ struct
   include MakeWTONode (DisjunctiveTransferFunctions)
 
   let get_cfg_metadata () =
-    let metadata = Stdlib.Domain.DLS.get DisjunctiveMetadata.proc_metadata in
+    let metadata = DLS.get DisjunctiveMetadata.proc_metadata in
     DisjunctiveMetadata.record_cfg_stats metadata ;
     metadata
 end

infer/src/absint/AnalysisState.ml

@@ -20,45 +20,45 @@ type t =
 let initial () = {last_instr= None; last_node= None; last_session= 0; remaining_disjuncts= None}
 
 (** Global state *)
-let gs = Domain.DLS.new_key initial
+let gs = DLS.new_key initial
 
 let () = AnalysisGlobalState.register_dls gs ~init:initial
 
-let get_instr () = (Domain.DLS.get gs).last_instr
+let get_instr () = (DLS.get gs).last_instr
 
-let set_instr instr = (Domain.DLS.get gs).last_instr <- Some instr
+let set_instr instr = (DLS.get gs).last_instr <- Some instr
 
-let get_node_exn () = Option.value_exn (Domain.DLS.get gs).last_node
+let get_node_exn () = Option.value_exn (DLS.get gs).last_node
 
-let get_node () = (Domain.DLS.get gs).last_node
+let get_node () = (DLS.get gs).last_node
 
 let set_node (node : Procdesc.Node.t) =
-  let gs = Domain.DLS.get gs in
+  let gs = DLS.get gs in
   gs.last_instr <- None ;
   gs.last_node <- Some node
 
 
-let get_session () = (Domain.DLS.get gs).last_session
+let get_session () = (DLS.get gs).last_session
 
-let set_session (session : int) = (Domain.DLS.get gs).last_session <- session
+let set_session (session : int) = (DLS.get gs).last_session <- session
 
 let get_loc_exn () =
-  match (Domain.DLS.get gs).last_instr with
+  match (DLS.get gs).last_instr with
   | Some instr ->
       Sil.location_of_instr instr
   | None ->
       get_node_exn () |> Procdesc.Node.get_loc
 
 
 let get_loc () =
-  match (Domain.DLS.get gs).last_instr with
+  match (DLS.get gs).last_instr with
   | Some instr ->
       Some (Sil.location_of_instr instr)
   | None ->
       None
 
 
-let get_remaining_disjuncts () = (Domain.DLS.get gs).remaining_disjuncts
+let get_remaining_disjuncts () = (DLS.get gs).remaining_disjuncts
 
 let set_remaining_disjuncts remaining_disjuncts =
-  (Domain.DLS.get gs).remaining_disjuncts <- Some remaining_disjuncts
+  (DLS.get gs).remaining_disjuncts <- Some remaining_disjuncts

infer/src/backend/AnalysisDependencyGraph.ml

@@ -156,7 +156,7 @@ let from_summaries () =
       edges_to_ignore := Procname.Map.add proc_name recursion_edges !edges_to_ignore ;
       CallGraph.create_node graph proc_name summary_loads ) ;
   if Config.debug_level_analysis > 0 then CallGraph.to_dotty graph AnalysisDependencyGraphDot ;
-  Domain.DLS.set Ondemand.edges_to_ignore (Some !edges_to_ignore) ;
+  DLS.set Ondemand.edges_to_ignore (Some !edges_to_ignore) ;
   graph
 
 
@@ -276,7 +276,7 @@ module Serialized = struct
         in
         edges_to_ignore := Procname.Map.add proc_name recursion_edges !edges_to_ignore )
       pre_call_graph ;
-    Domain.DLS.set Ondemand.edges_to_ignore (Some !edges_to_ignore) ;
+    DLS.set Ondemand.edges_to_ignore (Some !edges_to_ignore) ;
     call_graph
 
 

infer/src/backend/InferAnalyze.ml

@@ -37,7 +37,7 @@ let clear_caches () =
   Dependencies.clear ()
 
 
-let useful_time = Domain.DLS.new_key (fun () -> ExecutionDuration.zero)
+let useful_time = DLS.new_key (fun () -> ExecutionDuration.zero)
 
 let analyze_target : (TaskSchedulerTypes.target, TaskSchedulerTypes.analysis_result) Tasks.doer =
   let run_and_interpret_result ~f =
@@ -179,7 +179,7 @@ let analyze replay_call_graph source_files_to_analyze =
     let build_tasks_generator () =
       (* USELESS HACK: this is called only in the orchestrator, which doesn't need to do any
          analysis itself so we can unset this ref to save minute amount of memory *)
-      Domain.DLS.set Ondemand.edges_to_ignore None ;
+      DLS.set Ondemand.edges_to_ignore None ;
       tasks_generator_builder_for replay_call_graph (Lazy.force source_files_to_analyze)
     in
     (* Prepare tasks one file at a time while executing in parallel *)
@@ -223,7 +223,7 @@ let analyze replay_call_graph source_files_to_analyze =
               L.internal_error
                 "Child did not start the process times counter in its prologue, what happened?"
         in
-        Stats.set_useful_times (Domain.DLS.get useful_time) ;
+        Stats.set_useful_times (DLS.get useful_time) ;
         (Stats.get (), gc_stats_in_fork, MissingDependencies.get ())
       in
       StatsLogging.log_count ~label:"num_analysis_workers" ~value:Config.jobs ;