From 507e3f0143f075343450a826fd196f726eed0a39 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 17 Jan 2025 21:42:45 +0000 Subject: [PATCH] refactor(pkg): get rid of the [ImplCache] (#11315) It doesn't offer much over just having a map Signed-off-by: Rudi Grinberg --- src/0install-solver/cache.ml | 38 ------------------------------ src/0install-solver/cache.mli | 36 ---------------------------- src/0install-solver/solver_core.ml | 24 +++++++++++-------- 3 files changed, 14 insertions(+), 84 deletions(-) delete mode 100644 src/0install-solver/cache.ml delete mode 100644 src/0install-solver/cache.mli diff --git a/src/0install-solver/cache.ml b/src/0install-solver/cache.ml deleted file mode 100644 index 3e9031e3549..00000000000 --- a/src/0install-solver/cache.ml +++ /dev/null @@ -1,38 +0,0 @@ -open Stdune -open Fiber.O - -module Make (CacheEntry : sig - type t - - val to_dyn : t -> Dyn.t - val compare : t -> t -> Ordering.t - end) = -struct - module M = Map.Make (CacheEntry) - - type 'a snapshot = 'a M.t - type 'a t = 'a snapshot ref - - let create () = ref M.empty - - let lookup table make key = - match M.find !table key with - | Some x -> Fiber.return x - | None -> - let* value, process = make key in - table := M.set !table key value; - let+ () = process () in - value - ;; - - let snapshot table = !table - let get = M.find - let get_exn = M.find_exn - - let filter_map f m = - M.merge m M.empty ~f:(fun key ao _bo -> - match ao with - | Some x -> f key x - | None -> assert false) - ;; -end diff --git a/src/0install-solver/cache.mli b/src/0install-solver/cache.mli deleted file mode 100644 index 6f1397b6cc4..00000000000 --- a/src/0install-solver/cache.mli +++ /dev/null @@ -1,36 +0,0 @@ -open Stdune - -module Make (CacheEntry : sig - type t - - val to_dyn : t -> Dyn.t - val compare : t -> t -> Ordering.t - end) : sig - (** The cache is used in [build_problem], while the clauses are still being added. *) - type 'a t - - module M : Map.S with type key = CacheEntry.t - - (** Once the problem is built, an immutable snapshot is taken. *) - type 'a snapshot = 'a M.t - - val create : unit -> 'a t - - (** [lookup cache make key] will look up [key] in [cache]. - * If not found, create it with [value, process = make key], add [value] to the cache, - * and then call [process ()] on it. - * [make] must not be recursive (since the key hasn't been added yet), - * but [process] can be. In other words, [make] does whatever setup *must* - * be done before anyone can use this cache entry, while [process] does - * setup that can be done afterwards. *) - val lookup - : 'a t - -> (CacheEntry.t -> ('a * (unit -> unit Fiber.t)) Fiber.t) - -> CacheEntry.t - -> 'a Fiber.t - - val snapshot : 'a t -> 'a snapshot - val get : 'a snapshot -> CacheEntry.t -> 'a option - val get_exn : 'a snapshot -> CacheEntry.t -> 'a - val filter_map : (CacheEntry.t -> 'a -> 'b option) -> 'a M.t -> 'b M.t -end diff --git a/src/0install-solver/solver_core.ml b/src/0install-solver/solver_core.ml index 1d526437257..d90f5afbf2c 100644 --- a/src/0install-solver/solver_core.ml +++ b/src/0install-solver/solver_core.ml @@ -82,14 +82,12 @@ module Make (Model : S.SOLVER_INPUT) = struct ;; end - module ImplCache = Cache.Make (struct + module RoleMap = Map.Make (struct include Model.Role let to_dyn = Dyn.opaque end) - module RoleMap = ImplCache.M - type diagnostics = S.lit let explain = S.explain_reason @@ -143,7 +141,8 @@ module Make (Model : S.SOLVER_INPUT) = struct ;; end - (* Add the implementations of an interface to the ImplCache (called the first time we visit it). *) + (* Add the implementations of an interface to the implementation cache + (called the first time we visit it). *) let make_impl_clause sat ~dummy_impl role = let+ { impls } = Model.implementations role in (* Insert dummy_impl (last) if we're trying to diagnose a problem. *) @@ -170,7 +169,7 @@ module Make (Model : S.SOLVER_INPUT) = struct might need, adding all of them to [sat_problem]. *) let build_problem root_req sat ~dummy_impl = (* For each (iface, source) we have a list of implementations. *) - let impl_cache = ImplCache.create () in + let impl_cache = ref RoleMap.empty in let conflict_classes = Conflict_classes.create sat in let+ () = let rec lookup_impl = @@ -196,7 +195,13 @@ module Make (Model : S.SOLVER_INPUT) = struct Fiber.return ())) ) in fun expand_deps key -> - ImplCache.lookup impl_cache (add_impls_to_cache expand_deps) key + match RoleMap.find !impl_cache key with + | Some s -> Fiber.return s + | None -> + let* value, process = add_impls_to_cache expand_deps key in + impl_cache := RoleMap.set !impl_cache key value; + let+ () = process () in + value and process_dep expand_deps user_var dep : unit Fiber.t = (* Process a dependency of [user_var]: - find the candidate implementations to satisfy it @@ -248,7 +253,7 @@ module Make (Model : S.SOLVER_INPUT) = struct process_dep `No_expand impl_var dep) (* All impl_candidates have now been added, so snapshot the cache. *) in - let impl_clauses = ImplCache.snapshot impl_cache in + let impl_clauses = !impl_cache in Conflict_classes.seal conflict_classes; impl_clauses ;; @@ -308,7 +313,7 @@ module Make (Model : S.SOLVER_INPUT) = struct let sat = S.create () in let dummy_impl = if closest_match then Some Model.dummy_impl else None in let+ impl_clauses = build_problem root_req sat ~dummy_impl in - let lookup role = ImplCache.get_exn impl_clauses role in + let lookup role = RoleMap.find_exn impl_clauses role in (* Run the solve *) let decider () = (* Walk the current solution, depth-first, looking for the first undecided interface. @@ -355,8 +360,7 @@ module Make (Model : S.SOLVER_INPUT) = struct | Some _solution -> (* Build the results object *) let selections = - impl_clauses - |> ImplCache.filter_map (fun _role candidates -> + RoleMap.filter_mapi impl_clauses ~f:(fun _role candidates -> Candidates.selected candidates |> Option.map ~f:(fun (lit, impl) -> { impl; diagnostics = lit })) in