diff --git a/vendor/0install-solver/src/solver/diagnostics.ml b/vendor/0install-solver/src/solver/diagnostics.ml index 88d14debb00..de317572dcd 100644 --- a/vendor/0install-solver/src/solver/diagnostics.ml +++ b/vendor/0install-solver/src/solver/diagnostics.ml @@ -68,20 +68,20 @@ struct ; replacement : Model.Role.t option ; diagnostics : string Lazy.t ; selected_impl : Model.impl option - ; (* orig_good is all the implementations passed to the SAT solver (these are the - ones with a compatible OS, CPU, etc). They are sorted most desirable first. *) - orig_good : Model.impl list + ; orig_good : Model.impl list + (** orig_good is all the implementations passed to the SAT solver (these are the + ones with a compatible OS, CPU, etc). They are sorted most desirable first. *) ; orig_bad : (Model.impl * Model.rejection) list ; mutable good : Model.impl list ; mutable bad : (Model.impl * rejection_reason) list ; mutable notes : Note.t list } - (* Initialise a new component. - @param candidates is the result from the impl_provider. - @param selected_impl - is the selected implementation, or [None] if we chose [dummy_impl]. - @param diagnostics can be used to produce diagnostics as a last resort. *) + (** Initialise a new component. + @param candidates is the result from the impl_provider. + @param selected_impl + is the selected implementation, or [None] if we chose [dummy_impl]. + @param diagnostics can be used to produce diagnostics as a last resort. *) let create ~role (candidates, orig_bad, feed_problems) @@ -113,8 +113,8 @@ struct | _ -> true ;; - (* Call [get_problem impl] on each good impl. If a problem is returned, move [impl] to [bad_impls]. - If anything changes and [!note] is not None, report it and clear the pending note. *) + (** Call [get_problem impl] on each good impl. If a problem is returned, move [impl] to [bad_impls]. + If anything changes and [!note] is not None, report it and clear the pending note. *) let filter_impls_ref ~note:n t get_problem = let old_good = List.rev t.good in t.good <- []; @@ -137,8 +137,8 @@ struct filter_impls_ref ~note t get_problem ;; - (* Remove from [good_impls] anything that fails to meet these restrictions. - Add removed items to [bad_impls], along with the cause. *) + (** Remove from [good_impls] anything that fails to meet these restrictions. + Add removed items to [bad_impls], along with the cause. *) let apply_restrictions ~note t restrictions = let note = ref (Some note) in restrictions @@ -170,9 +170,9 @@ struct let replacement t = t.replacement let selected_impl t = t.selected_impl - (* When something conflicts with itself then our usual trick of selecting - the main implementation and failing the dependency doesn't work, so - special-case that here. *) + (** When something conflicts with itself then our usual trick of selecting + the main implementation and failing the dependency doesn't work, so + special-case that here. *) let reject_self_conflicts t = filter_impls t (fun impl -> let deps = Model.requires t.role impl in @@ -261,7 +261,7 @@ struct | None -> Format.pp_print_string f "(problem)" ;; - (* Format a textual description of this component's report. *) + (** Format a textual description of this component's report. *) let pp ~verbose f t = pf f @@ -285,7 +285,7 @@ struct | None -> failwith (Format.asprintf "Can't find component %a!" format_role role) ;; - (* Did any dependency of [impl] prevent it being selected? + (** Did any dependency of [impl] prevent it being selected? This can only happen if a component conflicts with something more important than itself (otherwise, we'd select something in [impl]'s interface and complain about the dependency instead). @@ -330,7 +330,7 @@ struct ~note:(Restricts (requiring_role, requiring_impl, dep_restrictions)) ;; - (* Find all restrictions that are in play and affect this interface *) + (** Find all restrictions that are in play and affect this interface *) let examine_selection report role component = (* Note any conflicts caused by elements *) let () = @@ -356,7 +356,7 @@ struct Component.filter_impls component (get_dependency_problem role report) ;; - (* Check for user-supplied restrictions *) + (** Check for user-supplied restrictions *) let examine_extra_restrictions report = report |> RoleMap.iter (fun role component -> diff --git a/vendor/0install-solver/src/solver/s.ml b/vendor/0install-solver/src/solver/s.ml index 3340676c584..f6ed44e3264 100644 --- a/vendor/0install-solver/src/solver/s.ml +++ b/vendor/0install-solver/src/solver/s.ml @@ -58,9 +58,6 @@ module type CORE_MODEL = sig dep_importance : [ `Essential | `Recommended | `Restricts ] } - (* The top-level requirements from the user. *) - type requirements = { role : Role.t } - (** Get an implementation's dependencies. The dependencies should be ordered with the most important first. @@ -147,7 +144,7 @@ module type SELECTIONS = sig val to_map : t -> impl RoleMap.t val get_selected : Role.t -> t -> impl option - val requirements : t -> requirements + val requirements : t -> Role.t end module type SOLVER_RESULT = sig @@ -162,7 +159,6 @@ module type SOLVER_RESULT = sig with module Role = Input.Role and type dependency = Input.dependency and type dep_info = Input.dep_info - and type requirements = Input.requirements val unwrap : impl -> Input.impl diff --git a/vendor/0install-solver/src/solver/solver_core.ml b/vendor/0install-solver/src/solver/solver_core.ml index d58e13c644f..0e69384c820 100644 --- a/vendor/0install-solver/src/solver/solver_core.ml +++ b/vendor/0install-solver/src/solver/solver_core.ml @@ -345,8 +345,7 @@ struct in let+ () = (* This recursively builds the whole problem up. *) - (let { Model.role } = root_req in - let+ impl = lookup_impl role in + (let+ impl = lookup_impl root_req in impl#get_vars) >>| S.at_least_one sat ~reason:"need root" (* Must get what we came for! *) in @@ -370,13 +369,11 @@ struct ; dep_importance : [ `Essential | `Recommended | `Restricts ] } - type requirements = Model.requirements = { role : Role.t } - let dep_info = Model.dep_info let requires role impl = Model.requires role impl.impl type t = - { root_req : requirements + { root_req : Role.t ; selections : selection RoleMap.t } @@ -414,9 +411,7 @@ 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 = function - | { Model.role } -> (ImplCache.get_exn role impl_clauses :> candidates) - in + let lookup role = (ImplCache.get_exn role impl_clauses :> candidates) in (* Run the solve *) let decider () = (* Walk the current solution, depth-first, looking for the first undecided interface. @@ -442,7 +437,7 @@ struct we'll handle it when we get to them. If noone wants it, it will be set to unselected at the end. *) None - else find_undecided { Model.role = dep_role } + else find_undecided dep_role in List.find_map check_dep deps) in diff --git a/vendor/0install-solver/src/solver/zeroinstall_solver.mli b/vendor/0install-solver/src/solver/zeroinstall_solver.mli index 34bfb7c73b7..5d266e60d1f 100644 --- a/vendor/0install-solver/src/solver/zeroinstall_solver.mli +++ b/vendor/0install-solver/src/solver/zeroinstall_solver.mli @@ -19,7 +19,7 @@ module Make You should ensure that [Input.get_command] always returns a dummy command for dummy_impl too. 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.requirements -> Output.t option Monad.t + val do_solve : closest_match:bool -> Input.Role.t -> Output.t option Monad.t end (** Explaining why a solve failed or gave an unexpected answer. *) diff --git a/vendor/opam-0install/lib/solver.ml b/vendor/opam-0install/lib/solver.ml index 3a4a3639878..4aaf76d4856 100644 --- a/vendor/opam-0install/lib/solver.ml +++ b/vendor/opam-0install/lib/solver.ml @@ -18,7 +18,7 @@ struct let impl = Input.virtual_impl ~context ~depends:pkgs () in Input.virtual_role [ impl ] in - { Input.role } + role ;; module Solver = Zeroinstall_solver.Make (Monad) (Input) @@ -26,7 +26,7 @@ struct type t = Context.t type selections = Solver.Output.t - type diagnostics = Input.requirements (* So we can run another solve *) + type diagnostics = Input.Role.t (* So we can run another solve *) let solve context pkgs = let req = requirements ~context pkgs in