From 4b5b26833a1b49c4df6438d21888b0ae3947976d Mon Sep 17 00:00:00 2001
From: Ambre Austen Suhamy <ambre@tarides.com>
Date: Thu, 7 Nov 2024 18:26:11 +0100
Subject: [PATCH 1/3] replace threaded monad by its explicit call to fiber in
 0install

Signed-off-by: Ambre Austen Suhamy <ambre@tarides.com>
---
 src/0install-solver/diagnostics.ml         | 13 ++++------
 src/0install-solver/dune                   |  3 ++-
 src/0install-solver/s.ml                   | 29 ++--------------------
 src/0install-solver/solver_core.ml         | 28 +++++++++------------
 src/0install-solver/zeroinstall_solver.mli | 14 ++++-------
 src/dune_pkg/opam_solver.ml                | 22 +---------------
 src/opam-0install/lib/dune                 |  2 +-
 src/opam-0install/lib/model.ml             | 11 +++-----
 src/opam-0install/lib/model.mli            |  7 ++----
 src/opam-0install/lib/s.ml                 | 10 +++-----
 src/opam-0install/lib/solver.ml            | 14 ++++-------
 src/opam-0install/lib/solver.mli           | 17 ++++---------
 12 files changed, 47 insertions(+), 123 deletions(-)

diff --git a/src/0install-solver/diagnostics.ml b/src/0install-solver/diagnostics.ml
index 7942f26baf8..eb09945f030 100644
--- a/src/0install-solver/diagnostics.ml
+++ b/src/0install-solver/diagnostics.ml
@@ -8,11 +8,8 @@ module List = Solver_core.List
 
 let pf = Format.fprintf
 
-module Make
-    (Monad : S.Monad)
-    (Results : S.SOLVER_RESULT with type 'a Input.monad := 'a Monad.t) =
-struct
-  open Monad.O
+module Make (Results : S.SOLVER_RESULT) = struct
+  open Fiber.O
   module Model = Results.Input
   module RoleMap = Results.RoleMap
 
@@ -411,11 +408,11 @@ struct
         let+ rejects, feed_problems = Model.rejects role in
         Component.create ~role (impl_candidates, rejects, feed_problems) diagnostics impl
       in
-      RoleMap.to_seq impls
-      |> Monad.Seq.parallel_map (fun (k, v) ->
+      RoleMap.to_list impls
+      |> Fiber.parallel_map ~f:(fun (k, v) ->
         let+ v = get_selected k v in
         k, v)
-      >>| RoleMap.of_seq
+      |> Fiber.map ~f:RoleMap.of_list
     in
     examine_extra_restrictions report;
     check_conflict_classes report;
diff --git a/src/0install-solver/dune b/src/0install-solver/dune
index 66a3b028d3b..0c402f471a7 100644
--- a/src/0install-solver/dune
+++ b/src/0install-solver/dune
@@ -1,2 +1,3 @@
 (library
- (name zeroinstall_solver))
+ (name zeroinstall_solver)
+ (libraries fiber))
diff --git a/src/0install-solver/s.ml b/src/0install-solver/s.ml
index 6f6f9ff9a9c..22489847eed 100644
--- a/src/0install-solver/s.ml
+++ b/src/0install-solver/s.ml
@@ -1,30 +1,6 @@
 (* Copyright (C) 2013, Thomas Leonard
    See the README file for details, or visit http://0install.net. *)
 
-(** Some useful abstract module types. *)
-
-module type Monad = sig
-  type 'a t
-
-  val return : 'a -> 'a t
-
-  module List : sig
-    val iter : ('a -> unit t) -> 'a list -> unit t
-    val iter2 : ('a -> 'b -> unit t) -> 'a list -> 'b list -> unit t
-  end
-
-  module Seq : sig
-    val parallel_map : ('a -> 'b t) -> 'a Seq.t -> 'b Seq.t t
-  end
-
-  module O : sig
-    val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
-    val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
-    val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
-    val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
-  end
-end
-
 module type CORE_MODEL = sig
   (** To use the solver with a particular packaging system (e.g. 0install), you need
       to provide an implementation of this module to map your system's concepts on to
@@ -73,7 +49,6 @@ end
 
 module type SOLVER_INPUT = sig
   (** This defines what the solver sees (hiding the raw XML, etc). *)
-  type 'a monad
 
   include CORE_MODEL
 
@@ -89,7 +64,7 @@ module type SOLVER_INPUT = sig
   val pp_impl : Format.formatter -> impl -> unit
 
   (** The list of candidates to fill a role. *)
-  val implementations : Role.t -> role_information monad
+  val implementations : Role.t -> role_information Fiber.t
 
   (** Restrictions on how the role is filled *)
   val restrictions : dependency -> restriction list
@@ -109,7 +84,7 @@ module type SOLVER_INPUT = sig
 
   (** Get the candidates which were rejected for a role (and not passed to the solver),
       as well as any general notes and warnings not tied to a particular impl. *)
-  val rejects : Role.t -> ((impl * rejection) list * string list) monad
+  val rejects : Role.t -> ((impl * rejection) list * string list) Fiber.t
 
   (** Used to sort the results. *)
   val compare_version : impl -> impl -> int
diff --git a/src/0install-solver/solver_core.ml b/src/0install-solver/solver_core.ml
index ebe3bd5b6e6..9ad2d5b3e56 100644
--- a/src/0install-solver/solver_core.ml
+++ b/src/0install-solver/solver_core.ml
@@ -37,7 +37,9 @@ module type CACHE_ENTRY = sig
   val compare : t -> t -> int
 end
 
-module Cache (Monad : S.Monad) (CacheEntry : CACHE_ENTRY) : sig
+open Fiber.O
+
+module Cache (CacheEntry : CACHE_ENTRY) : sig
   (** The cache is used in [build_problem], while the clauses are still being added. *)
   type t
 
@@ -57,9 +59,9 @@ module Cache (Monad : S.Monad) (CacheEntry : CACHE_ENTRY) : sig
       * setup that can be done afterwards. *)
   val lookup
     :  t
-    -> (CacheEntry.t -> (CacheEntry.value * (unit -> unit Monad.t)) Monad.t)
+    -> (CacheEntry.t -> (CacheEntry.value * (unit -> unit Fiber.t)) Fiber.t)
     -> CacheEntry.t
-    -> CacheEntry.value Monad.t
+    -> CacheEntry.value Fiber.t
 
   val snapshot : t -> snapshot
   val get : CacheEntry.t -> snapshot -> CacheEntry.value option
@@ -74,9 +76,8 @@ end = struct
   let create () = ref M.empty
 
   let lookup table make key =
-    let open Monad.O in
     match M.find_opt key !table with
-    | Some x -> Monad.return x
+    | Some x -> Fiber.return x
     | None ->
       let* value, process = make key in
       table := M.add key value !table;
@@ -99,12 +100,7 @@ end = struct
   ;;
 end
 
-module Make (Monad : S.Monad) (Model : S.SOLVER_INPUT with type 'a monad = 'a Monad.t) =
-struct
-  open Monad.O
-
-  type 'a monad = 'a Monad.t
-
+module Make (Model : S.SOLVER_INPUT) = struct
   (** We attach this data to each SAT variable. *)
   module SolverData = struct
     type t =
@@ -194,7 +190,7 @@ struct
     type value = impl_candidates
   end
 
-  module ImplCache = Cache (Monad) (RoleEntry)
+  module ImplCache = Cache (RoleEntry)
   module RoleMap = ImplCache.M
 
   type diagnostics = S.lit
@@ -270,7 +266,7 @@ struct
      - take just those that satisfy any restrictions in the dependency
      - ensure that we don't pick an incompatbile version if we select [user_var]
      - ensure that we do pick a compatible version if we select [user_var] (for "essential" dependencies only) *)
-  let process_dep sat lookup_impl user_var dep : unit Monad.t =
+  let process_dep sat lookup_impl user_var dep : unit Fiber.t =
     let { Model.dep_role; dep_importance } = Model.dep_info dep in
     let dep_restrictions = Model.restrictions dep in
     (* Restrictions on the candidates *)
@@ -335,13 +331,13 @@ struct
       ( clause
       , fun () ->
           impls
-          |> Monad.List.iter (fun (impl_var, impl) ->
+          |> Fiber.sequential_iter ~f:(fun (impl_var, impl) ->
             Conflict_classes.process conflict_classes impl_var impl;
             let deps = Model.requires role impl in
             process_deps impl_var deps) )
     and lookup_impl key = ImplCache.lookup impl_cache add_impls_to_cache key
-    and process_deps user_var : _ -> unit Monad.t =
-      Monad.List.iter (process_dep sat lookup_impl user_var)
+    and process_deps user_var : _ -> unit Fiber.t =
+      Fiber.sequential_iter ~f:(process_dep sat lookup_impl user_var)
     in
     let+ () =
       (* This recursively builds the whole problem up. *)
diff --git a/src/0install-solver/zeroinstall_solver.mli b/src/0install-solver/zeroinstall_solver.mli
index cd4a955dff2..9feb0c6867d 100644
--- a/src/0install-solver/zeroinstall_solver.mli
+++ b/src/0install-solver/zeroinstall_solver.mli
@@ -6,9 +6,7 @@ module S = S
 (** Select a compatible set of components to run a program.
     See [Zeroinstall.Solver] for the instantiation of this functor on the
     actual 0install types. *)
-module Make
-    (Monad : S.Monad)
-    (Input : S.SOLVER_INPUT with type 'a monad = 'a Monad.t) : sig
+module Make (Input : S.SOLVER_INPUT) : sig
   module Output : S.SOLVER_RESULT with module Input = Input
 
   (** [do_solve model req] finds an implementation matching the given requirements, plus any other implementations needed
@@ -18,13 +16,11 @@ module Make
         every interface, so we can always select something. Useful for diagnostics.
         Note: always try without [closest_match] first, or it may miss a valid solution.
       @return None if the solve fails (only happens if [closest_match] is false). *)
-  val do_solve : closest_match:bool -> Input.Role.t -> Output.t option Monad.t
+  val do_solve : closest_match:bool -> Input.Role.t -> Output.t option Fiber.t
 end
 
 (** Explaining why a solve failed or gave an unexpected answer. *)
-module Diagnostics
-    (Monad : S.Monad)
-    (Result : S.SOLVER_RESULT with type 'a Input.monad := 'a Monad.t) : sig
+module Diagnostics (Result : S.SOLVER_RESULT) : sig
   (** An item of information to display for a component. *)
   module Note : sig
     type t =
@@ -92,11 +88,11 @@ module Diagnostics
       We take the partial solution from the solver and discover, for each
       component we couldn't select, which constraints caused the candidates to
       be rejected. *)
-  val of_result : Result.t -> t Monad.t
+  val of_result : Result.t -> t Fiber.t
 
   (** [get_failure_reason r] analyses [r] with [of_result] and formats the
       analysis as a string. *)
-  val get_failure_reason : ?verbose:bool -> Result.t -> string Monad.t
+  val get_failure_reason : ?verbose:bool -> Result.t -> string Fiber.t
 end
 
 (** The low-level SAT solver. *)
diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml
index 2f226870536..b6df6e036ae 100644
--- a/src/dune_pkg/opam_solver.ml
+++ b/src/dune_pkg/opam_solver.ml
@@ -1,25 +1,6 @@
 open Import
 open Fiber.O
 
-module Monad : Opam_0install.S.Monad with type 'a t = 'a Fiber.t = struct
-  type 'a t = 'a Fiber.t
-
-  module O = Fiber.O
-
-  let return a = Fiber.return a
-
-  module Seq = struct
-    let parallel_map f t =
-      Fiber.parallel_map (List.of_seq t) ~f |> Fiber.map ~f:List.to_seq
-    ;;
-  end
-
-  module List = struct
-    let iter f x = Fiber.sequential_iter x ~f
-    let iter2 f x y = Fiber.sequential_iter (List.combine x y) ~f:(fun (x, y) -> f x y)
-  end
-end
-
 let add_self_to_filter_env package env variable =
   match OpamVariable.Full.scope variable with
   | Self | Package _ -> env variable
@@ -68,7 +49,6 @@ module Priority = struct
 end
 
 module Context_for_dune = struct
-  type 'a monad = 'a Monad.t
   type filter = OpamTypes.filter
 
   type rejection =
@@ -277,7 +257,7 @@ module Context_for_dune = struct
   ;;
 end
 
-module Solver = Opam_0install.Solver.Make (Monad) (Context_for_dune)
+module Solver = Opam_0install.Solver.Make (Context_for_dune)
 
 let is_valid_global_variable_name = function
   | "root" -> false
diff --git a/src/opam-0install/lib/dune b/src/opam-0install/lib/dune
index 03d02dbdab4..0043805410c 100644
--- a/src/opam-0install/lib/dune
+++ b/src/opam-0install/lib/dune
@@ -1,3 +1,3 @@
 (library
  (name opam_0install)
- (libraries opam_state opam_format zeroinstall_solver fmt))
+ (libraries opam_state opam_format zeroinstall_solver fmt fiber))
diff --git a/src/opam-0install/lib/model.ml b/src/opam-0install/lib/model.ml
index b3a837844cf..b1fbef886fc 100644
--- a/src/opam-0install/lib/model.ml
+++ b/src/opam-0install/lib/model.ml
@@ -1,7 +1,4 @@
-module Make (Monad : S.Monad) (Context : S.CONTEXT with type 'a monad = 'a Monad.t) =
-struct
-  type 'a monad = 'a Monad.t
-
+module Make (Context : S.CONTEXT) = struct
   (* Note: [OpamFormula.neg] doesn't work in the [Empty] case, so we just
      record whether to negate the result here. *)
   type restriction =
@@ -73,7 +70,7 @@ struct
 
   let role context name = Real { context; name }
 
-  open Monad.O
+  open Fiber.O
 
   let virtual_impl ~context ~depends () =
     let depends =
@@ -182,7 +179,7 @@ struct
 
   (* Get all the candidates for a role. *)
   let implementations = function
-    | Virtual (_, impls) -> Monad.return { impls; replacement = None }
+    | Virtual (_, impls) -> Fiber.return { impls; replacement = None }
     | Real role ->
       let context = role.context in
       let+ impls =
@@ -228,7 +225,7 @@ struct
 
   let rejects role =
     match role with
-    | Virtual _ -> Monad.return ([], [])
+    | Virtual _ -> Fiber.return ([], [])
     | Real role ->
       let context = role.context in
       let+ rejects =
diff --git a/src/opam-0install/lib/model.mli b/src/opam-0install/lib/model.mli
index dc2e9010fa5..686f9f4944a 100644
--- a/src/opam-0install/lib/model.mli
+++ b/src/opam-0install/lib/model.mli
@@ -14,11 +14,8 @@
     become a dependency on a virtual package which has each choice as an
     implementation. *)
 
-module Make (Monad : S.Monad) (Context : S.CONTEXT with type 'a monad = 'a Monad.t) : sig
-  include
-    Zeroinstall_solver.S.SOLVER_INPUT
-    with type rejection = Context.rejection
-     and type 'a monad = 'a Monad.t
+module Make (Context : S.CONTEXT) : sig
+  include Zeroinstall_solver.S.SOLVER_INPUT with type rejection = Context.rejection
 
   val role : Context.t -> OpamPackage.Name.t -> Role.t
 
diff --git a/src/opam-0install/lib/s.ml b/src/opam-0install/lib/s.ml
index 526843c5b2a..4ed6608d64e 100644
--- a/src/opam-0install/lib/s.ml
+++ b/src/opam-0install/lib/s.ml
@@ -1,7 +1,4 @@
-module type Monad = Zeroinstall_solver.S.Monad
-
 module type CONTEXT = sig
-  type 'a monad
   type t
 
   (** A reason why a package can't be used as input to the solver. e.g. it is
@@ -18,7 +15,7 @@ module type CONTEXT = sig
   val candidates
     :  t
     -> OpamPackage.Name.t
-    -> (OpamPackage.Version.t * (OpamFile.OPAM.t, rejection) result) list monad
+    -> (OpamPackage.Version.t * (OpamFile.OPAM.t, rejection) result) list Fiber.t
 
   (** [user_restrictions t pkg] is the user's constraint on [pkg], if any. This is just
       used for diagnostics; you still have to filter them out yourself in [candidates]. *)
@@ -32,18 +29,17 @@ module type CONTEXT = sig
 end
 
 module type SOLVER = sig
-  type 'a monad
   type t
   type selections
   type diagnostics
 
   (** [solve t package_names] finds a compatible set of package versions that
       includes all packages in [package_names] and their required dependencies. *)
-  val solve : t -> OpamPackage.Name.t list -> (selections, diagnostics) result monad
+  val solve : t -> OpamPackage.Name.t list -> (selections, diagnostics) result Fiber.t
 
   val packages_of_result : selections -> OpamPackage.t list
 
   (** [diagnostics d] is a message explaining why [d] failed, generated by
       performing another solve which doesn't abort on failure. *)
-  val diagnostics : ?verbose:bool -> diagnostics -> string monad
+  val diagnostics : ?verbose:bool -> diagnostics -> string Fiber.t
 end
diff --git a/src/opam-0install/lib/solver.ml b/src/opam-0install/lib/solver.ml
index 4aaf76d4856..a6490e019cb 100644
--- a/src/opam-0install/lib/solver.ml
+++ b/src/opam-0install/lib/solver.ml
@@ -1,10 +1,6 @@
-module Make (Monad : S.Monad) (Context : S.CONTEXT with type 'a monad = 'a Monad.t) =
-struct
-  open Monad.O
-
-  type 'a monad = 'a Monad.t
-
-  module Input = Model.Make (Monad) (Context)
+module Make (Context : S.CONTEXT) = struct
+  open Fiber.O
+  module Input = Model.Make (Context)
 
   let version = Input.version
   let package_name = Input.package_name
@@ -21,8 +17,8 @@ struct
     role
   ;;
 
-  module Solver = Zeroinstall_solver.Make (Monad) (Input)
-  module Diagnostics = Zeroinstall_solver.Diagnostics (Monad) (Solver.Output)
+  module Solver = Zeroinstall_solver.Make (Input)
+  module Diagnostics = Zeroinstall_solver.Diagnostics (Solver.Output)
 
   type t = Context.t
   type selections = Solver.Output.t
diff --git a/src/opam-0install/lib/solver.mli b/src/opam-0install/lib/solver.mli
index a17f380979b..37e4be0de2d 100644
--- a/src/opam-0install/lib/solver.mli
+++ b/src/opam-0install/lib/solver.mli
@@ -1,25 +1,18 @@
-module Make (Monad : S.Monad) (C : S.CONTEXT with type 'a monad = 'a Monad.t) : sig
-  module Input :
-    Zeroinstall_solver.S.SOLVER_INPUT
-    with type rejection = C.rejection
-     and type 'a monad = 'a Monad.t
+module Make (C : S.CONTEXT) : sig
+  module Input : Zeroinstall_solver.S.SOLVER_INPUT with type rejection = C.rejection
 
   module Solver : sig
     module Output : Zeroinstall_solver.S.SOLVER_RESULT with module Input = Input
   end
 
-  include
-    S.SOLVER
-    with type t = C.t
-     and type selections = Solver.Output.t
-     and type 'a monad = 'a Monad.t
+  include S.SOLVER with type t = C.t and type selections = Solver.Output.t
 
   module Diagnostics : sig
-    include module type of Zeroinstall_solver.Diagnostics (Monad) (Solver.Output)
+    include module type of Zeroinstall_solver.Diagnostics (Solver.Output)
   end
 
   val version : Input.impl -> OpamPackage.t option
   val package_name : Input.Role.t -> OpamPackage.Name.t option
   val formula : Input.restriction -> [ `Ensure | `Prevent ] * OpamFormula.version_formula
-  val diagnostics_rolemap : diagnostics -> Diagnostics.t Monad.t
+  val diagnostics_rolemap : diagnostics -> Diagnostics.t Fiber.t
 end

From fb3e1a75eaee3ad6774150a055c6340d05641e38 Mon Sep 17 00:00:00 2001
From: Ambre Austen Suhamy <ambre@tarides.com>
Date: Tue, 12 Nov 2024 16:01:37 +0100
Subject: [PATCH 2/3] Replace local stdlib redefinition by stdune's definitions

Signed-off-by: Ambre Austen Suhamy <ambre@tarides.com>
---
 src/0install-solver/diagnostics.ml | 41 ++++++++++++-------------
 src/0install-solver/dune           |  2 +-
 src/0install-solver/solver_core.ml | 48 ++++++++----------------------
 3 files changed, 35 insertions(+), 56 deletions(-)

diff --git a/src/0install-solver/diagnostics.ml b/src/0install-solver/diagnostics.ml
index eb09945f030..1bcc55c2cec 100644
--- a/src/0install-solver/diagnostics.ml
+++ b/src/0install-solver/diagnostics.ml
@@ -4,7 +4,7 @@
 
 (** Explaining why a solve failed or gave an unexpected answer. *)
 
-module List = Solver_core.List
+module List = Stdune.List
 
 let pf = Format.fprintf
 
@@ -14,7 +14,10 @@ module Make (Results : S.SOLVER_RESULT) = struct
   module RoleMap = Results.RoleMap
 
   let format_role = Model.Role.pp
-  let format_restrictions r = String.concat ", " (List.map Model.string_of_restriction r)
+
+  let format_restrictions r =
+    String.concat ", " (List.map ~f:Model.string_of_restriction r)
+  ;;
 
   module Note = struct
     type t =
@@ -86,13 +89,13 @@ module Make (Results : S.SOLVER_RESULT) = struct
       (selected_impl : Model.impl option)
       =
       let { Model.impls; Model.replacement } = candidates in
-      let notes = List.map (fun x -> Note.Feed_problem x) feed_problems in
+      let notes = List.map ~f:(fun x -> Note.Feed_problem x) feed_problems in
       { role
       ; replacement
       ; orig_good = impls
       ; orig_bad
       ; good = impls
-      ; bad = List.map (fun (impl, reason) -> impl, `Model_rejection reason) orig_bad
+      ; bad = List.map ~f:(fun (impl, reason) -> impl, `Model_rejection reason) orig_bad
       ; notes
       ; diagnostics
       ; selected_impl
@@ -115,8 +118,7 @@ module Make (Results : S.SOLVER_RESULT) = struct
     let filter_impls_ref ~note:n t get_problem =
       let old_good = List.rev t.good in
       t.good <- [];
-      old_good
-      |> List.iter (fun impl ->
+      List.iter old_good ~f:(fun impl ->
         match get_problem impl with
         | None -> t.good <- impl :: t.good
         | Some problem ->
@@ -138,8 +140,7 @@ module Make (Results : S.SOLVER_RESULT) = struct
        Add removed items to [bad_impls], along with the cause. *)
     let apply_restrictions ~note t restrictions =
       let note = ref (Some note) in
-      restrictions
-      |> List.iter (fun r ->
+      List.iter restrictions ~f:(fun r ->
         filter_impls_ref ~note t (fun impl ->
           if Model.meets_restriction impl r then None else Some (`FailsRestriction r)))
     ;;
@@ -152,15 +153,14 @@ module Make (Results : S.SOLVER_RESULT) = struct
       (* Completely remove non-matching impls.
          The user will only want to see the version they asked for. *)
       let new_bad =
-        t.bad
-        |> List.filter (fun (impl, _) ->
+        List.filter t.bad ~f:(fun (impl, _) ->
           if Model.meets_restriction impl r then true else false)
       in
       if new_bad <> [] || t.good <> [] then t.bad <- new_bad
     ;;
 
     let reject_all t reason =
-      t.bad <- List.map (fun impl -> impl, reason) t.good @ t.bad;
+      t.bad <- List.map ~f:(fun impl -> impl, reason) t.good @ t.bad;
       t.good <- []
     ;;
 
@@ -173,15 +173,14 @@ module Make (Results : S.SOLVER_RESULT) = struct
     let reject_self_conflicts t =
       filter_impls t (fun impl ->
         let deps = Model.requires t.role impl in
-        deps
-        |> List.find_map (fun dep ->
+        List.find_map deps ~f:(fun dep ->
           let { Model.dep_role; _ } = Model.dep_info dep in
           if Model.Role.compare dep_role t.role <> 0
           then None
           else
             (* It depends on itself. *)
             Model.restrictions dep
-            |> List.find_map (fun r ->
+            |> List.find_map ~f:(fun r ->
               if Model.meets_restriction impl r
               then None
               else Some (`DepFailsRestriction (dep, r)))))
@@ -214,8 +213,10 @@ module Make (Results : S.SOLVER_RESULT) = struct
     ;;
 
     let show_rejections ~verbose f rejected =
-      let by_version (a, _) (b, _) = Model.compare_version b a in
-      let rejected = List.sort by_version rejected in
+      let by_version (a, _) (b, _) =
+        Model.compare_version b a |> Stdune.Ordering.of_int
+      in
+      let rejected = List.sort ~compare:by_version rejected in
       let rec aux i = function
         | [] -> ()
         | _ when i = 5 && not verbose -> pf f "@,..."
@@ -304,10 +305,10 @@ module Make (Results : S.SOLVER_RESULT) = struct
              then None
              else Some (`DepFailsRestriction (dep, r))
            in
-           List.find_map check_restriction (Model.restrictions dep))
+           List.find_map ~f:check_restriction (Model.restrictions dep))
     in
     let deps = Model.requires role impl in
-    List.find_map check_dep deps
+    List.find_map ~f:check_dep deps
   ;;
 
   (** A selected component has [dep] as a dependency. Use this to explain why some implementations
@@ -346,7 +347,7 @@ module Make (Results : S.SOLVER_RESULT) = struct
     | Some our_impl ->
       (* For each dependency of our selected impl, explain why it rejected impls in the dependency's interface. *)
       let deps = Model.requires role our_impl in
-      List.iter (examine_dep role our_impl report) deps
+      List.iter ~f:(examine_dep role our_impl report) deps
     | None ->
       (* For each of our remaining unrejected impls, check whether a dependency prevented its selection. *)
       Component.filter_impls component (get_dependency_problem role report)
@@ -377,7 +378,7 @@ module Make (Results : S.SOLVER_RESULT) = struct
           | None -> acc
           | Some impl ->
             Model.conflict_class impl
-            |> List.fold_left (fun acc x -> Classes.add x role acc) acc)
+            |> List.fold_left ~f:(fun acc x -> Classes.add x role acc) ~init:acc)
         report
         Classes.empty
     in
diff --git a/src/0install-solver/dune b/src/0install-solver/dune
index 0c402f471a7..f9baae6935b 100644
--- a/src/0install-solver/dune
+++ b/src/0install-solver/dune
@@ -1,3 +1,3 @@
 (library
  (name zeroinstall_solver)
- (libraries fiber))
+ (libraries fiber stdune))
diff --git a/src/0install-solver/solver_core.ml b/src/0install-solver/solver_core.ml
index 9ad2d5b3e56..9d5c0124fa3 100644
--- a/src/0install-solver/solver_core.ml
+++ b/src/0install-solver/solver_core.ml
@@ -4,31 +4,7 @@
 
 (** Select a compatible set of components to run a program. *)
 
-module List = struct
-  include List
-
-  let rec find_map f = function
-    | [] -> None
-    | x :: xs ->
-      (match f x with
-       | Some _ as result -> result
-       | None -> find_map f xs)
-  ;;
-end
-
-type ('a, 'b) partition_result =
-  | Left of 'a
-  | Right of 'b
-
-let partition fn lst =
-  let pass = ref [] in
-  let fail = ref [] in
-  ListLabels.iter lst ~f:(fun item ->
-    match fn item with
-    | Left x -> pass := x :: !pass
-    | Right x -> fail := x :: !fail);
-  List.rev !pass, List.rev !fail
-;;
+module List = Stdune.List
 
 module type CACHE_ENTRY = sig
   type t
@@ -145,9 +121,10 @@ module Make (Model : S.SOLVER_INPUT) = struct
       (** Get all variables, except dummy_impl (if present) *)
       method get_real_vars =
         vars
-        |> List.filter_map (fun (var, impl) -> if is_dummy impl then None else Some var)
+        |> List.filter_map ~f:(fun (var, impl) ->
+          if is_dummy impl then None else Some var)
 
-      method get_vars = List.map (fun (var, _impl) -> var) vars
+      method get_vars = List.map ~f:(fun (var, _impl) -> var) vars
 
       method get_selected =
         match clause with
@@ -181,7 +158,9 @@ module Make (Model : S.SOLVER_INPUT) = struct
       (** Apply [test impl] to each implementation, partitioning the vars into two lists.
           Only defined for [impl_candidates]. *)
       method partition test =
-        partition (fun (var, impl) -> if test impl then Left var else Right var) vars
+        List.partition_map
+          ~f:(fun (var, impl) -> if test impl then Stdune.Either.Left var else Right var)
+          vars
     end
 
   module RoleEntry = struct
@@ -206,7 +185,7 @@ module Make (Model : S.SOLVER_INPUT) = struct
    * We do this at the end because if we didn't use the replacement feed, there's no need to conflict
    * (avoids getting it added to feeds_used). *)
   let add_replaced_by_conflicts sat impl_clauses =
-    List.iter (fun (clause, replacement) ->
+    List.iter ~f:(fun (clause, replacement) ->
       ImplCache.get replacement impl_clauses
       |> Option.iter (fun replacement_candidates ->
         (* Our replacement was also added to [sat], so conflict with it. *)
@@ -245,7 +224,7 @@ module Make (Model : S.SOLVER_INPUT) = struct
     (* Add [impl] to its conflict groups, if any. *)
     let process t impl_var impl =
       Model.conflict_class impl
-      |> List.iter (fun name ->
+      |> List.iter ~f:(fun name ->
         let impls = var t name in
         impls := impl_var :: !impls)
     ;;
@@ -271,7 +250,7 @@ module Make (Model : S.SOLVER_INPUT) = struct
     let dep_restrictions = Model.restrictions dep in
     (* Restrictions on the candidates *)
     let meets_restrictions impl =
-      List.for_all (Model.meets_restriction impl) dep_restrictions
+      List.for_all ~f:(Model.meets_restriction impl) dep_restrictions
     in
     let+ candidates = lookup_impl dep_role in
     let pass, fail = candidates#partition meets_restrictions in
@@ -302,13 +281,12 @@ module Make (Model : S.SOLVER_INPUT) = struct
       | Some dummy_impl -> impls @ [ dummy_impl ]
     in
     let impls =
-      impls
-      |> List.map (fun impl ->
+      List.map impls ~f:(fun impl ->
         let var = S.add_variable sat (SolverData.ImplElem impl) in
         var, impl)
     in
     let impl_clause =
-      if impls <> [] then Some (S.at_most_one sat (List.map fst impls)) else None
+      if impls <> [] then Some (S.at_most_one sat (List.map ~f:fst impls)) else None
     in
     let clause = new impl_candidates role impl_clause impls dummy_impl in
     (* If we have a <replaced-by>, remember to add a conflict with our replacement *)
@@ -435,7 +413,7 @@ module Make (Model : S.SOLVER_INPUT) = struct
                 None
               else find_undecided dep_role
             in
-            List.find_map check_dep deps)
+            List.find_map ~f:check_dep deps)
       in
       find_undecided root_req
     in

From c0d37b2e3657f96bff5fc85e083de5738c01efbc Mon Sep 17 00:00:00 2001
From: Ambre Austen Suhamy <ambre@tarides.com>
Date: Fri, 15 Nov 2024 12:20:12 +0100
Subject: [PATCH 3/3] Don't use Map.of_list/to_list, it's too new

Signed-off-by: Ambre Austen Suhamy <ambre@tarides.com>
---
 src/0install-solver/diagnostics.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/0install-solver/diagnostics.ml b/src/0install-solver/diagnostics.ml
index 1bcc55c2cec..01d7f8e24d8 100644
--- a/src/0install-solver/diagnostics.ml
+++ b/src/0install-solver/diagnostics.ml
@@ -409,11 +409,11 @@ module Make (Results : S.SOLVER_RESULT) = struct
         let+ rejects, feed_problems = Model.rejects role in
         Component.create ~role (impl_candidates, rejects, feed_problems) diagnostics impl
       in
-      RoleMap.to_list impls
+      RoleMap.bindings impls
       |> Fiber.parallel_map ~f:(fun (k, v) ->
         let+ v = get_selected k v in
         k, v)
-      |> Fiber.map ~f:RoleMap.of_list
+      |> Fiber.map ~f:(fun s -> RoleMap.of_seq (List.to_seq s))
     in
     examine_extra_restrictions report;
     check_conflict_classes report;