Skip to content

feat(pkg): solve all requested platforms together #15982

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
Alizter merged 1 commit into from
Aug 26, 2026
Merged

feat(pkg): solve all requested platforms together #15982

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
256 changes: 76 additions & 180 deletions bin/pkg/lock.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,114 +54,6 @@ module Progress_indicator = struct
let add_overlay (t : t) = Console.Status_line.add_overlay (Live (fun () -> pp t))
end

module Platforms_by_message = struct
module Message = struct
type t =
| Solve_error of User_message.Style.t Pp.t
| Manifest_error of User_message.t

let to_dyn = function
| Solve_error message ->
Dyn.variant "Solve_error" [ Pp.to_dyn User_message.Style.to_dyn message ]
| Manifest_error message ->
Dyn.variant "Manifest_error" [ User_message.to_dyn message ]
;;

let compare a b =
match a, b with
| Solve_error a, Solve_error b -> Pp.compare ~compare:User_message.Style.compare a b
| Solve_error _, _ -> Lt
| _, Solve_error _ -> Gt
| Manifest_error a, Manifest_error b -> User_message.compare a b
;;
end

module Message_map = Map.Make (Message)

(* Map messages to the list of platforms for which those messages are
relevant. If a dependency problem has no solution on any platform, it's
likely that the error from the solver will be identical across all
platforms. We don't want to print the same error message once for each
platform, so this type collects messages and the platforms for which they
are relevant, deduplicating common messages. *)
type t = Solver_env.t list Message_map.t

let singleton message platform : t = Message_map.singleton message [ platform ]
let to_list (t : t) : (Message.t * Solver_env.t list) list = Message_map.to_list t
let union_all ts : t = Message_map.union_all ts ~f:(fun _ a b -> Some (a @ b))

let all_solver_errors_raising_if_any_manifest_errors t =
let solver_errors, manifest_errors =
List.partition_map (to_list t) ~f:(fun (message, platforms) ->
match message with
| Solve_error message -> Left (message, platforms)
| Manifest_error message -> Right message)
in
match manifest_errors with
| [] -> solver_errors
| message :: _ -> raise (User_error.E message)
;;
end

let solve_multiple_platforms
base_solver_env
version_preference
repos
~pins
~local_packages
~constraints
~selected_depopts
~solve_for_platforms
~portable_lock_dir
=
let open Fiber.O in
let solve_for_env env =
Dune_pkg.Opam_solver.solve_lock_dir
env
version_preference
repos
~pins
~local_packages
~constraints
~selected_depopts
~portable_lock_dir
in
let portable_solver_env =
Solver_env.unset_multi
base_solver_env
Dune_lang.Package_variable_name.platform_specific
in
let+ results =
Fiber.parallel_map solve_for_platforms ~f:(fun platform_env ->
let solver_env = Solver_env.extend portable_solver_env platform_env in
let+ solver_result = solve_for_env solver_env in
Result.map_error solver_result ~f:(fun message ->
let message : Platforms_by_message.Message.t =
match message with
| `Solve_error m -> Solve_error m
| `Manifest_error m -> Manifest_error m
in
Platforms_by_message.singleton message platform_env))
in
let solver_results, errors =
List.partition_map results ~f:(function
| Ok result -> Left result
| Error e -> Right e)
in
match solver_results, errors with
| [], [] -> Code_error.raise "Solver did not run for any platforms." []
| _, _ :: _ ->
(* Any errors means full failure - no partial solutions *)
`All_error
(Platforms_by_message.union_all errors
|> Platforms_by_message.all_solver_errors_raising_if_any_manifest_errors)
| x :: xs, [] ->
let merged_solver_result =
List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge
in
`All_ok merged_solver_result
;;

let user_lock_dir_path path =
match (path : Path.t) with
| In_source_tree _ -> path
Expand All @@ -174,7 +66,6 @@ let summary_message
~lock_dir_path
~(lock_dir : Lock_dir.t)
~maybe_perf_stats
~maybe_unsolved_platforms_message
=
if portable_lock_dir
then (
Expand Down Expand Up @@ -229,43 +120,42 @@ let summary_message
; pp_package_set packages
]))
in
(Pp.tag
User_message.Style.Success
(Pp.textf
"Solution for %s"
(Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
:: Pp.nop
:: Pp.text "Dependencies common to all supported platforms:"
:: pp_package_set common_packages
:: (maybe_uncommon_packages @ maybe_perf_stats))
@ maybe_unsolved_platforms_message)
Pp.tag
User_message.Style.Success
(Pp.textf
"Solution for %s"
(Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
:: Pp.nop
:: Pp.text "Dependencies common to all supported platforms:"
:: pp_package_set common_packages
:: (maybe_uncommon_packages @ maybe_perf_stats))
else
(Pp.tag
User_message.Style.Success
(Pp.textf
"Solution for %s:"
(Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
:: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
| [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
| packages -> pp_packages packages)
:: maybe_perf_stats)
@ maybe_unsolved_platforms_message
Pp.tag
User_message.Style.Success
(Pp.textf
"Solution for %s:"
(Path.to_string_maybe_quoted (user_lock_dir_path lock_dir_path)))
:: (match Lock_dir.Packages.to_pkg_list lock_dir.packages with
| [] -> Pp.tag User_message.Style.Warning @@ Pp.text "(no dependencies to lock)"
| packages -> pp_packages packages)
:: maybe_perf_stats
;;

let pp_solve_errors_by_platforms platforms_by_message =
List.map platforms_by_message ~f:(fun (message, platforms) ->
Pp.concat
~sep:Pp.cut
[ Pp.nop
; Pp.box
@@ Pp.text
"The dependency solver failed to find a solution for the following \
platforms:"
; Pp.enumerate platforms ~f:Solver_env.pp_oneline
; Pp.box @@ Pp.text "...with this error:"
; message
]
|> Pp.vbox)
(* A failed joint solve does not prove that every requested platform fails on
its own: the solver reports the first conflict it finds for the requested
platform set. *)
let pp_solve_error (message, platforms) =
Pp.concat
~sep:Pp.cut
[ Pp.nop
; Pp.box
@@ Pp.text
"The dependency solver failed to find a solution for the requested platforms:"
; Pp.enumerate platforms ~f:Solver_env.pp_oneline
; Pp.box @@ Pp.text "...with this error:"
; message
]
|> Pp.vbox
;;

let solve_lock_dir
Expand Down Expand Up @@ -309,7 +199,7 @@ let solve_lock_dir
List.map solve_for_platforms ~f:(fun platform_env ->
Solver_env.extend solver_env_from_context platform_env)
| None -> solve_for_platforms)
| false -> [ solver_env ]
| false -> []
in
let time_start = Time.now () in
let* repos =
Expand All @@ -327,9 +217,16 @@ let solve_lock_dir
let* pins = Pin.Project.resolve project_pins in
let time_solve_start = Time.now () in
progress_state := Some Progress_indicator.Per_lockdir.State.Solving;
let solver_env, platform_overlays =
Dune_pkg.Opam_solver.base_solver_env_and_platforms
solver_env
~solve_for_platforms
~portable_lock_dir
in
let* result =
solve_multiple_platforms
Dune_pkg.Opam_solver.solve_lock_dir
solver_env
~platform_overlays
(Pkg_common.Version_preference.choose
~from_arg:version_preference
~from_context:
Expand All @@ -340,17 +237,15 @@ let solve_lock_dir
(Package_name.Map.map local_packages ~f:Dune_pkg.Local_package.for_solver)
~constraints:(constraints_of_workspace workspace ~lock_dir_path)
~selected_depopts:(depopts_of_workspace workspace ~lock_dir_path)
~solve_for_platforms
~portable_lock_dir
in
let solver_result =
match result with
| `All_error messages -> Error messages
| `All_ok solver_result -> Ok (solver_result, [])
in
match solver_result with
| Error messages -> Fiber.return (Error (lock_dir_path, messages))
| Ok (solver_result, maybe_unsolved_platforms_message) ->
match result with
| Error message ->
let platforms =
List.map platform_overlays ~f:Solver_env.remove_all_except_platform_specific
in
Fiber.return (Error (lock_dir_path, (message, platforms)))
| Ok solver_result ->
let { Dune_pkg.Opam_solver.Solver_result.lock_dir
; files
; pinned_packages
Expand All @@ -376,12 +271,7 @@ let solve_lock_dir
in
let summary_message =
User_message.make
(summary_message
~portable_lock_dir
~lock_dir_path
~lock_dir
~maybe_perf_stats
~maybe_unsolved_platforms_message)
(summary_message ~portable_lock_dir ~lock_dir_path ~lock_dir ~maybe_perf_stats)
in
progress_state := None;
let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in
Expand Down Expand Up @@ -434,26 +324,32 @@ let solve
| _ -> Error errors)
>>| function
| Error errors ->
if portable_lock_dir
then
User_error.raise
(List.concat_map errors ~f:(fun (path, errors) ->
[ Pp.box
@@ Pp.textf
"Unable to solve dependencies while generating lock directory: %s"
(Path.to_string_maybe_quoted path)
; Pp.vbox (Pp.concat ~sep:Pp.cut (pp_solve_errors_by_platforms errors))
]))
else
User_error.raise
([ Pp.text "Unable to solve dependencies for the following lock directories:" ]
@ List.concat_map errors ~f:(fun (path, errors) ->
let messages = List.map errors ~f:fst in
[ Pp.textf
"Lock directory %s:"
(Path.to_string_maybe_quoted (user_lock_dir_path path))
; Pp.vbox (Pp.concat ~sep:Pp.cut messages)
]))
let solver_errors =
List.concat_map errors ~f:(fun (path, (error, platforms)) ->
match error with
| `Manifest_error message -> raise (User_error.E message)
| `Solve_error error ->
if portable_lock_dir
then
[ Pp.box
@@ Pp.textf
"Unable to solve dependencies while generating lock directory: %s"
(Path.to_string_maybe_quoted path)
; Pp.vbox (pp_solve_error (error, platforms))
]
else
[ Pp.textf
"Lock directory %s:"
(Path.to_string_maybe_quoted (user_lock_dir_path path))
; Pp.vbox error
])
in
User_error.raise
(if portable_lock_dir
then solver_errors
else
Pp.text "Unable to solve dependencies for the following lock directories:"
:: solver_errors)
| Ok write_disks_with_summaries ->
let write_disk_list, summary_messages = List.split write_disks_with_summaries in
List.iter summary_messages ~f:Console.print_user_message;
Expand Down
3 changes: 3 additions & 0 deletions doc/changes/changed/15982.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
- Portable lock directories now select one package version across all requested
platforms, and fail when no common version exists. (#15982, fixes #13647,
@Alizter)
40 changes: 0 additions & 40 deletions src/dune_pkg/lock_dir.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1053,24 +1053,6 @@ module Packages = struct
List.fold_left pkg.enabled_on_platforms ~init:acc ~f:(fun acc platform ->
Solver_env.Map.add_multi acc platform pkg))
;;

let merge a b =
Package_name.Map.merge a b ~f:(fun _ a b ->
match a, b with
| None, None ->
(* unreachable *)
None
| Some x, None | None, Some x -> Some x
| Some a, Some b ->
Some
(Package_version.Map.merge a b ~f:(fun _ a b ->
match a, b with
| None, None ->
(* unreachable *)
None
| Some x, None | None, Some x -> Some x
| Some a, Some b -> Some (Pkg.merge_conditionals a b))))
;;
end

type t =
Expand Down Expand Up @@ -1823,28 +1805,6 @@ let compute_missing_checksums t ~pinned_packages =
{ t with packages }
;;

let merge_conditionals a b =
let packages = Packages.merge a.packages b.packages in
let solved_for_platforms =
let a_loc, a_solved_for_platforms = a.solved_for_platforms in
let b_loc, b_solved_for_platforms = b.solved_for_platforms in
Loc.span a_loc b_loc, a_solved_for_platforms @ b_solved_for_platforms
in
let normalize t =
{ t with
packages = Package_name.Map.empty
; expanded_solver_variable_bindings = Solver_stats.Expanded_variable_bindings.empty
; solved_for_platforms = Loc.none, []
}
in
if not (equal (normalize a) (normalize b))
then
Code_error.raise
"Platform-specific lockdirs differ in a non-platform-specific way"
[ "lockdir_1", to_dyn a; "lockdir_2", to_dyn b ];
{ a with packages; solved_for_platforms }
;;

let loc_in_source_tree loc =
loc
|> Loc.map_pos ~f:(fun ({ pos_fname; _ } as pos) ->
Expand Down
4 changes: 0 additions & 4 deletions src/dune_pkg/lock_dir.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -193,10 +193,6 @@ val transitive_dependency_closure
archive urls but no checksum. *)
val compute_missing_checksums : t -> pinned_packages:Package_name.Set.t -> t Fiber.t

(** Combine the platform-specific parts of a pair of lockdirs, throwing a code
error if the lockdirs differ in a non-platform-specific way. *)
val merge_conditionals : t -> t -> t

(** Returns the packages contained in the solution on the given platform. If
the lockdir does not contain a solution compatible with the given platform
then a [User_error] is raised. *)
Expand Down
Loading
Loading