From c88394f107886bee464ba3c7f71f288c240b8a4f Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Fri, 17 Jan 2025 00:20:18 +0000
Subject: [PATCH] refactor(pkg): get rid of the [ImplCache]

It doesn't offer much over just having a map

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: dc20130a-f7d2-4e14-a007-af1787b58ac0 -->

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 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