diff --git a/infer/src/IR/AnalysisGlobalState.ml b/infer/src/IR/AnalysisGlobalState.ml index cb4beabef9..b6a395bd48 100644 --- a/infer/src/IR/AnalysisGlobalState.ml +++ b/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 diff --git a/infer/src/IR/AnalysisGlobalState.mli b/infer/src/IR/AnalysisGlobalState.mli index 4432b4f9dd..b5e986ad55 100644 --- a/infer/src/IR/AnalysisGlobalState.mli +++ b/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 diff --git a/infer/src/IR/Dependencies.ml b/infer/src/IR/Dependencies.ml index 378da0faa9..4ceab718de 100644 --- a/infer/src/IR/Dependencies.ml +++ b/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 diff --git a/infer/src/IR/Dependencies.mli b/infer/src/IR/Dependencies.mli index ce2aca230b..2aac25b0d3 100644 --- a/infer/src/IR/Dependencies.mli +++ b/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 diff --git a/infer/src/absint/AbstractInterpreter.ml b/infer/src/absint/AbstractInterpreter.ml index 82e89f2879..98d18b7c8e 100644 --- a/infer/src/absint/AbstractInterpreter.ml +++ b/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 diff --git a/infer/src/absint/AnalysisState.ml b/infer/src/absint/AnalysisState.ml index b787969667..5347301a39 100644 --- a/infer/src/absint/AnalysisState.ml +++ b/infer/src/absint/AnalysisState.ml @@ -20,30 +20,30 @@ 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 -> @@ -51,14 +51,14 @@ let get_loc_exn () = 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 diff --git a/infer/src/backend/AnalysisDependencyGraph.ml b/infer/src/backend/AnalysisDependencyGraph.ml index c0592964d7..f3c4166bd7 100644 --- a/infer/src/backend/AnalysisDependencyGraph.ml +++ b/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 diff --git a/infer/src/backend/InferAnalyze.ml b/infer/src/backend/InferAnalyze.ml index 64adf2c339..03489d930d 100644 --- a/infer/src/backend/InferAnalyze.ml +++ b/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 ; diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index 543301b8d1..6a889c3484 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -45,25 +45,25 @@ end = struct module AnalysisTargets = Hash_queue.Make (SpecializedProcname) - let currently_analyzed = Domain.DLS.new_key (fun () -> AnalysisTargets.create ()) + let currently_analyzed = DLS.new_key (fun () -> AnalysisTargets.create ()) let pp_actives fmt = - Domain.DLS.get currently_analyzed + DLS.get currently_analyzed |> AnalysisTargets.iteri ~f:(fun ~key:target ~data:_ -> F.fprintf fmt "%a,@," SpecializedProcname.pp target ) - let mem analysis_target = AnalysisTargets.mem (Domain.DLS.get currently_analyzed) analysis_target + let mem analysis_target = AnalysisTargets.mem (DLS.get currently_analyzed) analysis_target let add analysis_target = if Config.trace_ondemand then L.progress "add %a@." SpecializedProcname.pp analysis_target ; - AnalysisTargets.enqueue_back_exn (Domain.DLS.get currently_analyzed) analysis_target () + AnalysisTargets.enqueue_back_exn (DLS.get currently_analyzed) analysis_target () let remove analysis_target = if Config.trace_ondemand then L.progress "remove %a@." SpecializedProcname.pp analysis_target ; let popped_target, () = - AnalysisTargets.dequeue_back_with_key_exn (Domain.DLS.get currently_analyzed) + AnalysisTargets.dequeue_back_with_key_exn (DLS.get currently_analyzed) in if not (SpecializedProcname.equal popped_target analysis_target) then L.die InternalError @@ -72,7 +72,7 @@ end = struct SpecializedProcname.pp analysis_target SpecializedProcname.pp popped_target pp_actives - let get_all () = AnalysisTargets.keys @@ Domain.DLS.get currently_analyzed + let get_all () = AnalysisTargets.keys @@ DLS.get currently_analyzed let get_cycle_start recursive = let all = get_all () in @@ -92,12 +92,12 @@ end the previous analysis scheduling are recorded in this variable TODO: [edges_to_ignore] should take specialization into account, like [is_active] *) -let edges_to_ignore = Domain.DLS.new_key (fun () -> None) +let edges_to_ignore = DLS.new_key (fun () -> None) (** use either [is_active] or [edges_to_ignore] to determine if we should return an empty summary to avoid mutual recursion cycles *) let detect_mutual_recursion_cycle ~caller_summary ~callee specialization = - match (Domain.DLS.get edges_to_ignore, caller_summary) with + match (DLS.get edges_to_ignore, caller_summary) with | Some edges_to_ignore, Some {Summary.proc_name} -> let is_replay_recursive_callee = Procname.Map.find_opt proc_name edges_to_ignore @@ -116,26 +116,24 @@ let procedure_is_defined proc_name = (* Remember what the last status sent was so that we can update the status correctly when entering and exiting nested ondemand analyses. In particular we need to remember the original time.*) -let current_taskbar_status : (Mtime.t * string) option Domain.DLS.key = - Domain.DLS.new_key (fun () -> None) - +let current_taskbar_status : (Mtime.t * string) option DLS.key = DLS.new_key (fun () -> None) let () = let open IOption.Let_syntax in AnalysisGlobalState.register ~save:(fun () -> - let+ t0, status = Domain.DLS.get current_taskbar_status in + let+ t0, status = DLS.get current_taskbar_status in (* the time elapsed doing [status] so far *) (Mtime.span t0 (Mtime_clock.now ()), status) ) ~restore:(fun proc_analysis_time -> - Domain.DLS.set current_taskbar_status + DLS.set current_taskbar_status (let+ suspended_span, status = proc_analysis_time in (* forget about the time spent doing a nested analysis and resend the status of the outer analysis with the updated "original" start time *) let new_t0 = Mtime.sub_span (Mtime_clock.now ()) suspended_span |> Option.value_exn in !ProcessPoolState.update_status (Some new_t0) status ; (new_t0, status) ) ) - ~init:(fun _ -> Domain.DLS.set current_taskbar_status None) + ~init:(fun _ -> DLS.set current_taskbar_status None) let () = @@ -152,7 +150,7 @@ let () = (** reference to log errors only at the innermost recursive call *) -let logged_error = Domain.DLS.new_key (fun () -> false) +let logged_error = DLS.new_key (fun () -> false) let update_taskbar proc_name_opt source_file_opt = let t0 = Mtime_clock.now () in @@ -171,7 +169,7 @@ let update_taskbar proc_name_opt source_file_opt = | None, None -> "Unspecified task" in - Domain.DLS.set current_taskbar_status (Some (t0, status)) ; + DLS.set current_taskbar_status (Some (t0, status)) ; !ProcessPoolState.update_status (Some t0) status @@ -232,7 +230,7 @@ let run_proc_analysis exe_env tenv analysis_req specialization_context ?caller_p decr nesting ; (* copy the previous recursion edges over to the new summary if doing a replay analysis so that subsequent replay analyses can pick them up too *) - Domain.DLS.get edges_to_ignore + DLS.get edges_to_ignore |> Option.iter ~f:(fun edges_to_ignore -> Procname.Map.find_opt callee_pname edges_to_ignore |> Option.iter ~f:(fun recursive_callees -> @@ -274,7 +272,7 @@ let run_proc_analysis exe_env tenv analysis_req specialization_context ?caller_p in let final_callee_summary = postprocess callee_summary in (* don't forget to reset this so we output messages for future errors too *) - Domain.DLS.set logged_error false ; + DLS.set logged_error false ; final_callee_summary with exn -> ( let backtrace = Printexc.get_backtrace () in @@ -287,13 +285,13 @@ let run_proc_analysis exe_env tenv analysis_req specialization_context ?caller_p ActiveProcedures.remove {proc_name= callee_pname; specialization} ; true | exn -> - if not (Domain.DLS.get logged_error) then ( + if not (DLS.get logged_error) then ( let source_file = callee_attributes.ProcAttributes.translation_unit in let location = callee_attributes.ProcAttributes.loc in L.internal_error "While analysing function %a:%a at %a, raised %s@\n" SourceFile.pp source_file Procname.pp callee_pname Location.pp_file_pos location (Exn.to_string exn) ; - Domain.DLS.set logged_error true ) ; + DLS.set logged_error true ) ; not Config.keep_going ) ; L.internal_error "@\nERROR RUNNING BACKEND: %a %s@\n@\nBACK TRACE@\n%s@?" Procname.pp callee_pname (Exn.to_string exn) backtrace ; @@ -433,7 +431,7 @@ let analysis_result_of_option opt = Result.of_option opt ~error:AnalysisResult.A (** track how many times we restarted the analysis of the current dependency chain to make the analysis of mutual recursion cycles deterministic *) -let number_of_recursion_restarts = Domain.DLS.new_key (fun () -> 0) +let number_of_recursion_restarts = DLS.new_key (fun () -> 0) let rec analyze_callee_can_raise_recursion exe_env ~lazy_payloads (analysis_req : AnalysisRequest.t) ~specialization ?caller_summary ?(from_file_analysis = false) callee_pname : _ AnalysisResult.t @@ -443,14 +441,14 @@ let rec analyze_callee_can_raise_recursion exe_env ~lazy_payloads (analysis_req let target = {SpecializedProcname.proc_name= callee_pname; specialization} in let cycle_start, cycle_length, first_active = ActiveProcedures.get_cycle_start target in if - Domain.DLS.get number_of_recursion_restarts >= Config.ondemand_recursion_restart_limit + DLS.get number_of_recursion_restarts >= Config.ondemand_recursion_restart_limit || SpecializedProcname.equal cycle_start target then ( register_callee ~cycle_detected:true ?caller_summary callee_pname ; if Config.trace_ondemand then L.progress "Closed the cycle finishing in recursive call to %a@." Procname.pp callee_pname ; if - Domain.DLS.get number_of_recursion_restarts >= Config.ondemand_recursion_restart_limit + DLS.get number_of_recursion_restarts >= Config.ondemand_recursion_restart_limit && not (SpecializedProcname.equal cycle_start target) then Stats.incr_ondemand_recursion_cycle_restart_limit_hit () ; Error MutualRecursionCycle ) @@ -560,7 +558,7 @@ let analyze_callee exe_env ~lazy_payloads analysis_req ~specialization ?caller_s (* If [caller_summary] is set then we are analyzing a dependency of another procedure, so we should keep counting restarts within that dependency chain (or cycle). If it's not set then this is a "toplevel" analysis of [callee_pname] so we start fresh. *) - if Option.is_none caller_summary then Domain.DLS.set number_of_recursion_restarts 0 ; + if Option.is_none caller_summary then DLS.set number_of_recursion_restarts 0 ; analyze_callee exe_env ~lazy_payloads analysis_req ~specialization ?caller_summary ?from_file_analysis callee_pname diff --git a/infer/src/backend/ondemand.mli b/infer/src/backend/ondemand.mli index 8bfa6ec237..b38403e9b4 100644 --- a/infer/src/backend/ondemand.mli +++ b/infer/src/backend/ondemand.mli @@ -33,5 +33,5 @@ val analyze_proc_name_toplevel : Exe_env.t -> AnalysisRequest.t -> specialization:Specialization.t option -> Procname.t -> unit (** Invoke all the callbacks registered in {!Callbacks} on the given procedure. *) -val edges_to_ignore : Procname.Set.t Procname.Map.t option Domain.DLS.key +val edges_to_ignore : Procname.Set.t Procname.Map.t option DLS.key (** used by the replay analysis to cut mutual recursion cycles in the same places again *) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 1c7672d3f1..099acfc845 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -320,18 +320,18 @@ module Liveness = struct let last_instr_in_node = let cache_node = - Stdlib.Domain.DLS.new_key (fun () -> Procdesc.Node.dummy (Procname.from_string_c_fun "")) + DLS.new_key (fun () -> Procdesc.Node.dummy (Procname.from_string_c_fun "")) in - let cache_instr = Stdlib.Domain.DLS.new_key (fun () -> Sil.skip_instr) in + let cache_instr = DLS.new_key (fun () -> Sil.skip_instr) in fun node -> let get_last_instr () = CFG.instrs node |> Instrs.last |> Option.value ~default:Sil.skip_instr in - if phys_equal node (Stdlib.Domain.DLS.get cache_node) then Stdlib.Domain.DLS.get cache_instr + if phys_equal node (DLS.get cache_node) then DLS.get cache_instr else let last_instr = get_last_instr () in - Stdlib.Domain.DLS.set cache_node node ; - Stdlib.Domain.DLS.set cache_instr last_instr ; + DLS.set cache_node node ; + DLS.set cache_instr last_instr ; last_instr diff --git a/infer/src/base/Database.ml b/infer/src/base/Database.ml index 0c076fdd75..1d848fc09c 100644 --- a/infer/src/base/Database.ml +++ b/infer/src/base/Database.ml @@ -180,10 +180,10 @@ let create_db location id = let make_callback_get_and_set () = - let make_key () = Domain.DLS.new_key ~split_from_parent:Fn.id (fun () -> []) in + let make_key () = DLS.new_key ~split_from_parent:Fn.id (fun () -> []) in let db_keys = [(AnalysisDatabase, make_key ()); (CaptureDatabase, make_key ())] in - let get_db_callbacks id = Stdlib.List.assoc id db_keys |> Domain.DLS.get in - let set_db_callbacks id callbacks = Domain.DLS.set (Stdlib.List.assoc id db_keys) callbacks in + let get_db_callbacks id = Stdlib.List.assoc id db_keys |> DLS.get in + let set_db_callbacks id callbacks = DLS.set (Stdlib.List.assoc id db_keys) callbacks in (get_db_callbacks, set_db_callbacks) @@ -205,7 +205,7 @@ type registered_stmt = unit -> Sqlite3.stmt * Sqlite3.db let register_statement id = let k stmt0 = - let stmt_key = Domain.DLS.new_key (fun () -> None) in + let stmt_key = DLS.new_key (fun () -> None) in let new_statement db = let stmt = try Sqlite3.prepare db stmt0 @@ -214,11 +214,11 @@ let register_statement id = error in on_close_database id ~f:(fun _ -> SqliteUtils.finalize db ~log:"db close callback" stmt) ; - Domain.DLS.set stmt_key (Some (stmt, db)) + DLS.set stmt_key (Some (stmt, db)) in on_new_database_connection id ~f:new_statement ; fun () -> - match Domain.DLS.get stmt_key with + match DLS.get stmt_key with | None -> L.(die InternalError) "database not initialized" | Some (stmt, db) -> @@ -251,9 +251,9 @@ module UnsafeDatabaseRef : sig end = struct let make_db_descr () = (* we implicitly throw away the descr of the parent domain here to avoid conflict *) - let key = Domain.DLS.new_key (fun () -> None) in - let get () = Domain.DLS.get key in - let set descr = Domain.DLS.set key descr in + let key = DLS.new_key (fun () -> None) in + let get () = DLS.get key in + let set descr = DLS.set key descr in (get, set) diff --git a/infer/src/base/Language.ml b/infer/src/base/Language.ml index 9cf4932e71..7d9665df1b 100644 --- a/infer/src/base/Language.ml +++ b/infer/src/base/Language.ml @@ -19,10 +19,10 @@ let language_to_string = let to_string lang = List.Assoc.find_exn language_to_string ~equal lang -let curr_language = Domain.DLS.new_key (fun () -> Clang) +let curr_language = DLS.new_key (fun () -> Clang) -let get_language () = Domain.DLS.get curr_language +let get_language () = DLS.get curr_language let curr_language_is lang = equal (get_language ()) lang -let set_language lang = Domain.DLS.set curr_language lang +let set_language lang = DLS.set curr_language lang diff --git a/infer/src/base/PerfEvent.ml b/infer/src/base/PerfEvent.ml index 69c812faa8..b778ef8f34 100644 --- a/infer/src/base/PerfEvent.ml +++ b/infer/src/base/PerfEvent.ml @@ -66,11 +66,11 @@ module JsonFragment = struct (** for some limited (not thread-safe) form of safety, and to know when we need to print separators *) - let pp_state = Domain.DLS.new_key (fun () -> [Outside]) + let pp_state = DLS.new_key (fun () -> [Outside]) - let get_state () = Domain.DLS.get pp_state + let get_state () = DLS.get pp_state - let set_state state = Domain.DLS.set pp_state state + let set_state state = DLS.set pp_state state let pp f json_fragment = match (json_fragment, get_state ()) with diff --git a/infer/src/base/Timer.ml b/infer/src/base/Timer.ml index 55fcdbbf35..9ae6143a44 100644 --- a/infer/src/base/Timer.ml +++ b/infer/src/base/Timer.ml @@ -12,14 +12,14 @@ exception Timeout of float let now () = (Unix.times ()).tms_utime -let timer = Domain.DLS.new_key (fun () -> None) +let timer = DLS.new_key (fun () -> None) -let start () = Domain.DLS.set timer (Some (now ())) +let start () = DLS.set timer (Some (now ())) let time_since start_time = now () -. start_time let get () = - match Domain.DLS.get timer with + match DLS.get timer with | None -> L.die InternalError "trying to get the value of the timer but no timer is active" | Some start_time -> @@ -29,15 +29,15 @@ let get () = type state = float option let suspend () : state = - let current_timer = Domain.DLS.get timer in - Domain.DLS.set timer None ; + let current_timer = DLS.get timer in + DLS.set timer None ; Option.map current_timer ~f:time_since let resume (t : state) = (* forget about the time spent between [suspend ()] and [resume _] by pretending the timer started at [now - previous_time_spent] *) - Option.map t ~f:(fun previous_time_spent -> now () -. previous_time_spent) |> Domain.DLS.set timer + Option.map t ~f:(fun previous_time_spent -> now () -. previous_time_spent) |> DLS.set timer let check_timeout timeout = diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 44627655bd..f35b0d8f55 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -515,4 +515,4 @@ let is_term_dumb () = false -let with_dls key ~f = Domain.DLS.get key |> f |> Domain.DLS.set key +let with_dls key ~f = DLS.get key |> f |> DLS.set key diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index 1bdf39f0ef..c36392e5d1 100644 --- a/infer/src/base/Utils.mli +++ b/infer/src/base/Utils.mli @@ -153,5 +153,5 @@ val is_term_dumb : unit -> bool (** Check if the terminal is "dumb" or otherwise has very limited functionality. For example, Emacs' eshell reports itself as a dumb terminal. *) -val with_dls : 'a Domain.DLS.key -> f:('a -> 'a) -> unit +val with_dls : 'a DLS.key -> f:('a -> 'a) -> unit (** get value in domain local storage, pass to [f] and set to result *) diff --git a/infer/src/checkers/Lineage.ml b/infer/src/checkers/Lineage.ml index df3730fb11..d35b431f43 100644 --- a/infer/src/checkers/Lineage.ml +++ b/infer/src/checkers/Lineage.ml @@ -939,23 +939,23 @@ module Out = struct [@@deriving compare, equal, hash, sexp] end - let channel_key = Domain.DLS.new_key (fun () -> None) + let channel_key = DLS.new_key (fun () -> None) let get_pid_channel () = (* We keep the old simple-lineage output dir for historical reasons and should change it to lineage once no external infra code depends on it anymore *) let output_dir = Filename.concat Config.results_dir "simple-lineage" in Unix.mkdir_p output_dir ; - match Domain.DLS.get channel_key with + match DLS.get channel_key with | None -> let filename = Format.asprintf "lineage-%a.json" Pid.pp (Unix.getpid ()) in let channel = Filename.concat output_dir filename |> Out_channel.create in let close_channel () = - Domain.DLS.get channel_key |> Option.iter ~f:Out_channel.close_no_err ; - Domain.DLS.set channel_key None + DLS.get channel_key |> Option.iter ~f:Out_channel.close_no_err ; + DLS.set channel_key None in Epilogues.register ~f:close_channel ~description:"close output channel for lineage" ; - Domain.DLS.set channel_key (Some channel) ; + DLS.set channel_key (Some channel) ; channel | Some channel -> channel diff --git a/infer/src/checkers/SilValidation.ml b/infer/src/checkers/SilValidation.ml index b711c46fa8..f2470d1e7d 100644 --- a/infer/src/checkers/SilValidation.ml +++ b/infer/src/checkers/SilValidation.ml @@ -300,7 +300,7 @@ end = struct let callbacks = {instr_conforms; call_exp_conforms; arg_exp_conforms= is_pure} end -let error_counter = Domain.DLS.new_key (fun () -> 0) +let error_counter = DLS.new_key (fun () -> 0) let error_limit = 10000 @@ -332,7 +332,7 @@ let checker (language : Language.t) ({proc_desc; err_log} : IntraproceduralAnaly (* Clang is the most general, i.e., least restrictive validator. *) Clang.callbacks in - if Domain.DLS.get error_counter < error_limit then + if DLS.get error_counter < error_limit then Procdesc.iter_instrs (fun _ instr -> if not (instr_conforms instr) then ( diff --git a/infer/src/istd/IStd.ml b/infer/src/istd/IStd.ml index 4dfdbcab8b..019304069d 100644 --- a/infer/src/istd/IStd.ml +++ b/infer/src/istd/IStd.ml @@ -24,6 +24,9 @@ module Sys = struct include Sys_unix end +(* easy access to sub-module *) +module DLS = Domain.DLS + (* Compare police: generic compare mostly disabled. *) let compare = No_polymorphic_compare.compare diff --git a/infer/src/pulse/Pulse.ml b/infer/src/pulse/Pulse.ml index d45b427072..bdc1c9a9db 100644 --- a/infer/src/pulse/Pulse.ml +++ b/infer/src/pulse/Pulse.ml @@ -192,12 +192,12 @@ let report_unnecessary_parameter_copies ({InterproceduralAnalysis.proc_desc; ten let heap_size () = (Gc.quick_stat ()).heap_words (* for printing the session name only, promise! *) -let current_specialization = Domain.DLS.new_key (fun () -> None) +let current_specialization = DLS.new_key (fun () -> None) let () = AnalysisGlobalState.register_dls ~init:(fun () -> None) current_specialization let pp_space_specialization fmt = - Domain.DLS.get current_specialization + DLS.get current_specialization |> Option.iter ~f:(function _, Specialization.Pulse specialization -> F.fprintf fmt " (specialized: %a)" Specialization.Pulse.pp specialization ) @@ -1857,7 +1857,7 @@ let analyze specialization ({InterproceduralAnalysis.tenv; proc_desc; exe_env} a let checker ?specialization ({InterproceduralAnalysis.proc_desc} as analysis_data) = let open IOption.Let_syntax in if should_analyze proc_desc then ( - Domain.DLS.set current_specialization specialization ; + DLS.set current_specialization specialization ; try match specialization with | None -> diff --git a/infer/src/pulse/PulseAbstractValue.ml b/infer/src/pulse/PulseAbstractValue.ml index 78c7bb7f7f..6884ff4aac 100644 --- a/infer/src/pulse/PulseAbstractValue.ml +++ b/infer/src/pulse/PulseAbstractValue.ml @@ -11,21 +11,21 @@ type t = int [@@deriving compare, equal, hash] let initial_next_fresh = 1 -let next_fresh = Domain.DLS.new_key (fun () -> initial_next_fresh) +let next_fresh = DLS.new_key (fun () -> initial_next_fresh) let mk_fresh () = - let l = Domain.DLS.get next_fresh in - Domain.DLS.set next_fresh (l + 1) ; + let l = DLS.get next_fresh in + DLS.set next_fresh (l + 1) ; l let initial_next_fresh_restricted = -1 -let next_fresh_restricted = Domain.DLS.new_key (fun () -> initial_next_fresh_restricted) +let next_fresh_restricted = DLS.new_key (fun () -> initial_next_fresh_restricted) let mk_fresh_restricted () = - let v = Domain.DLS.get next_fresh_restricted in - Domain.DLS.set next_fresh_restricted (v - 1) ; + let v = DLS.get next_fresh_restricted in + DLS.set next_fresh_restricted (v - 1) ; v diff --git a/infer/src/pulse/PulseCallOperations.ml b/infer/src/pulse/PulseCallOperations.ml index e639038798..fcb411f7db 100644 --- a/infer/src/pulse/PulseCallOperations.ml +++ b/infer/src/pulse/PulseCallOperations.ml @@ -65,7 +65,7 @@ module GlobalForStats = struct let empty = {node_is_not_stuck= false; one_call_is_stuck= false} - let global = Domain.DLS.new_key (fun () -> empty) + let global = DLS.new_key (fun () -> empty) let () = AnalysisGlobalState.register_dls ~init:(fun () -> empty) global @@ -73,13 +73,13 @@ module GlobalForStats = struct Utils.with_dls global ~f:(fun global -> {global with node_is_not_stuck= false}) - let is_node_not_stuck () = (Domain.DLS.get global).node_is_not_stuck + let is_node_not_stuck () = (DLS.get global).node_is_not_stuck let node_is_not_stuck () = Utils.with_dls global ~f:(fun global -> {global with node_is_not_stuck= true}) - let is_one_call_stuck () = (Domain.DLS.get global).one_call_is_stuck + let is_one_call_stuck () = (DLS.get global).one_call_is_stuck let one_call_is_stuck () = Utils.with_dls global ~f:(fun global -> {global with one_call_is_stuck= true}) diff --git a/infer/src/pulse/PulseContext.ml b/infer/src/pulse/PulseContext.ml index 8529f97bbb..a73cb977bb 100644 --- a/infer/src/pulse/PulseContext.ml +++ b/infer/src/pulse/PulseContext.ml @@ -7,9 +7,9 @@ open! IStd -let proc_desc_key = Domain.DLS.new_key (fun () -> None) +let proc_desc_key = DLS.new_key (fun () -> None) -let tenv_key = Domain.DLS.new_key (fun () : Tenv.t Option.t -> None) +let tenv_key = DLS.new_key (fun () : Tenv.t Option.t -> None) let () = AnalysisGlobalState.register_dls_with_proc_desc_and_tenv proc_desc_key @@ -21,9 +21,9 @@ let () = Some tenv ) -let proc_desc () = Domain.DLS.get proc_desc_key +let proc_desc () = DLS.get proc_desc_key -let tenv () = Domain.DLS.get tenv_key +let tenv () = DLS.get tenv_key let tenv_exn () = match tenv () with @@ -33,4 +33,4 @@ let tenv_exn () = tenv -let set_tenv_global_for_testing tenv = Domain.DLS.set tenv_key (Some tenv) +let set_tenv_global_for_testing tenv = DLS.set tenv_key (Some tenv) diff --git a/infer/src/pulse/PulseTopl.ml b/infer/src/pulse/PulseTopl.ml index e51ce6c206..f3a4e14cb3 100644 --- a/infer/src/pulse/PulseTopl.ml +++ b/infer/src/pulse/PulseTopl.ml @@ -716,7 +716,7 @@ let static_match_call tenv return arguments procname label : tcontext option = module Debug = struct - let dropped_disjuncts_count = Domain.DLS.new_key (fun () -> 0) + let dropped_disjuncts_count = DLS.new_key (fun () -> 0) let rec matched_transitions = lazy @@ -745,9 +745,9 @@ module Debug = struct let () = AnalysisGlobalState.register_dls dropped_disjuncts_count ~init:(fun () -> 0) - let get_dropped_disjuncts_count () = Domain.DLS.get dropped_disjuncts_count + let get_dropped_disjuncts_count () = DLS.get dropped_disjuncts_count - let set_dropped_disjuncts_count count = Domain.DLS.set dropped_disjuncts_count count + let set_dropped_disjuncts_count count = DLS.set dropped_disjuncts_count count end (** Returns a list of transitions whose pattern matches (e.g., event type matches). Each match diff --git a/infer/src/pulse/PulseValueHistory.ml b/infer/src/pulse/PulseValueHistory.ml index edcf3aba41..baf7367295 100644 --- a/infer/src/pulse/PulseValueHistory.ml +++ b/infer/src/pulse/PulseValueHistory.ml @@ -17,13 +17,13 @@ module CellId = struct let pp = Int.pp - let next_id = Domain.DLS.new_key (fun () -> 0) + let next_id = DLS.new_key (fun () -> 0) let () = AnalysisGlobalState.register_dls ~init:(fun () -> 0) next_id let next () = - let id = Domain.DLS.get next_id in - Domain.DLS.set next_id (id + 1) ; + let id = DLS.get next_id in + DLS.set next_id (id + 1) ; id