Skip to content

Commit

Permalink
Simplify types in 0install one bit further
Browse files Browse the repository at this point in the history
Signed-off-by: Ambre Austen Suhamy <ambre@tarides.com>
  • Loading branch information
ElectreAAS committed Oct 16, 2024
1 parent a6663e6 commit a2efa37
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 36 deletions.
38 changes: 19 additions & 19 deletions vendor/0install-solver/src/solver/diagnostics.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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 <- [];
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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).
Expand Down Expand Up @@ -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 <replaced-by> elements *)
let () =
Expand All @@ -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 ->
Expand Down
6 changes: 1 addition & 5 deletions vendor/0install-solver/src/solver/s.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down
13 changes: 4 additions & 9 deletions vendor/0install-solver/src/solver/solver_core.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
}

Expand Down Expand Up @@ -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.
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion vendor/0install-solver/src/solver/zeroinstall_solver.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)
Expand Down
4 changes: 2 additions & 2 deletions vendor/opam-0install/lib/solver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -18,15 +18,15 @@ 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)
module Diagnostics = Zeroinstall_solver.Diagnostics (Monad) (Solver.Output)

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
Expand Down

0 comments on commit a2efa37

Please sign in to comment.