diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index ac266599483..35aa81089f4 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -444,32 +444,6 @@ module Solver = struct Virtual (Virtual_id.gen (), impls) ;; - (* Turn an opam dependency formula into a 0install list of dependencies. *) - let list_deps ~context ~importance ~rank deps = - let rec aux (formula : _ OpamTypes.generic_formula) = - match formula with - | Empty -> [] - | Atom (name, restrictions) -> - let drole = Real { context; name } in - [ { drole; restrictions; importance } ] - | Block x -> aux x - | And (x, y) -> aux x @ aux y - | Or _ as o -> - let impls = group_ors o in - let drole = virtual_role impls in - (* Essential because we must apply a restriction, even if its - components are only restrictions. *) - [ { drole; restrictions = []; importance = Ensure } ] - and group_ors = function - | Or (x, y) -> group_ors x @ group_ors y - | expr -> - let i = !rank in - rank := i + 1; - [ VirtualImpl (i, aux expr) ] - in - aux deps - ;; - module Conflict_class = struct type t = OpamPackage.Name.t @@ -507,6 +481,32 @@ module Solver = struct OpamFormula.Atom (name, rlist)) ;; + (* Turn an opam dependency formula into a 0install list of dependencies. *) + let list_deps ~context ~importance ~rank deps = + let rec aux (formula : _ OpamTypes.generic_formula) = + match formula with + | Empty -> [] + | Atom (name, restrictions) -> + let drole = Real { context; name } in + [ { drole; restrictions; importance } ] + | Block x -> aux x + | And (x, y) -> aux x @ aux y + | Or _ as o -> + let impls = group_ors o in + let drole = virtual_role impls in + (* Essential because we must apply a restriction, even if its + components are only restrictions. *) + [ { drole; restrictions = []; importance = Ensure } ] + and group_ors = function + | Or (x, y) -> group_ors x @ group_ors y + | expr -> + let i = !rank in + rank := i + 1; + [ VirtualImpl (i, aux expr) ] + in + aux deps + ;; + (* Get all the candidates for a role. *) let implementations = function | Virtual (_, impls) -> Fiber.return impls @@ -617,13 +617,6 @@ module Solver = struct | Some lit -> Undecided lit | None -> Unselected (* No remaining candidates, and none was chosen. *))) ;; - - (* Apply [test impl] to each implementation, partitioning the vars into two - lists. Only defined for [impl_candidates]. *) - let partition t ~f:test = - List.partition_map t.vars ~f:(fun (var, impl) -> - if test impl then Either.Left var else Right var) - ;; end type selection = @@ -738,8 +731,9 @@ module Solver = struct let meets_restrictions (* Restrictions on the candidates *) impl = List.for_all ~f:(Input.meets_restriction impl) dep.restrictions in - lookup_impl expand_deps dep.drole - >>| Candidates.partition ~f:meets_restrictions + let+ candidates = lookup_impl expand_deps dep.drole in + List.partition_map candidates.vars ~f:(fun (var, impl) -> + if meets_restrictions impl then Left var else Right var) in match dep.importance with | Ensure ->