From fa1fb25502d994160031e37d6363ecce22a4b033 Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Tue, 11 Feb 2025 15:41:38 +1100 Subject: [PATCH 1/2] Experimental portable lockdirs Adds a feature flag for enabling portable lockdirs. This is a proof of concept implementation of portable lockdirs where the entire solver runs for each of a set of platforms (combinations of architecture, OS, and in some cases the OS distribution) which most people are expected to use. This can easily be extended in the future to add more platforms or to allow projects to specify more platforms. To make lockdirs portable, the build/install commands and dependencies of each package are transformed into match statements, where the appropriate value for each platform is enumerated. At solve-time, the solver runs once for each platform, populating these fields. At build-time, the command/dependencies appropriate for the current platform are used. When the feature flag is not enabled dune's behaviour is unchanged. Signed-off-by: Stephen Sherratt --- bin/describe/describe_depexts.ml | 11 +- bin/lock_dev_tool.ml | 1 + bin/pkg/lock.ml | 99 ++++- bin/pkg/lock.mli | 1 + boot/configure.ml | 5 + src/dune_lang/package_variable_name.ml | 4 + src/dune_lang/package_variable_name.mli | 4 + src/dune_pkg/file_entry.ml | 21 + src/dune_pkg/file_entry.mli | 3 + src/dune_pkg/lock_dir.ml | 382 +++++++++++++++--- src/dune_pkg/lock_dir.mli | 42 +- src/dune_pkg/opam_solver.ml | 75 +++- src/dune_pkg/opam_solver.mli | 2 + src/dune_pkg/package_universe.ml | 5 +- src/dune_pkg/solver_env.ml | 56 ++- src/dune_pkg/solver_env.mli | 15 + src/dune_pkg/variable_value.ml | 1 + src/dune_pkg/variable_value.mli | 1 + src/dune_rules/compile_time.ml | 4 + src/dune_rules/compile_time.mli | 1 + src/dune_rules/lock_dir.ml | 21 + src/dune_rules/lock_dir.mli | 1 + src/dune_rules/pkg_rules.ml | 34 +- src/dune_rules/setup.defaults.ml | 1 + src/dune_rules/setup.mli | 1 + .../test-cases/pkg/portable-lockdirs.t | 163 ++++++++ .../dune_pkg/dune_pkg_unit_tests.ml | 99 +++-- 27 files changed, 933 insertions(+), 120 deletions(-) create mode 100644 test/blackbox-tests/test-cases/pkg/portable-lockdirs.t diff --git a/bin/describe/describe_depexts.ml b/bin/describe/describe_depexts.ml index 31cec883c8a..878f6b455f9 100644 --- a/bin/describe/describe_depexts.ml +++ b/bin/describe/describe_depexts.ml @@ -22,13 +22,20 @@ let enumerate_lock_dirs_by_path workspace ~lock_dirs = let print_depexts ~lock_dirs_arg = let open Fiber.O in let open Lock_dir in - let+ workspace = Memo.run (Workspace.workspace ()) in + let+ workspace = Memo.run (Workspace.workspace ()) + and+ solver_env = + Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) + |> Dune_pkg.Sys_poll.solver_env_from_current_system + in let depexts = enumerate_lock_dirs_by_path workspace ~lock_dirs:lock_dirs_arg |> List.concat_map ~f:(fun lock_dir -> lock_dir.packages |> Package_name.Map.values - |> List.concat_map ~f:(fun (pkg : Lock_dir.Pkg.t) -> pkg.depexts)) + |> List.concat_map ~f:(fun (pkg : Lock_dir.Pkg.t) -> + match Lock_dir.Conditional_choice.find pkg.depexts solver_env with + | Some depexts -> depexts + | None -> [])) in Console.print [ Pp.concat_map ~sep:Pp.newline ~f:Pp.verbatim depexts ] ;; diff --git a/bin/lock_dev_tool.ml b/bin/lock_dev_tool.ml index 587e2a795ae..a74df3858be 100644 --- a/bin/lock_dev_tool.ml +++ b/bin/lock_dev_tool.ml @@ -89,6 +89,7 @@ let solve ~dev_tool ~local_packages = ~version_preference:None ~lock_dirs:[ lock_dir ] ~print_perf_stats:false + ~portable_lock_dir:false ;; let compiler_package_name = Package_name.of_string "ocaml" diff --git a/bin/pkg/lock.ml b/bin/pkg/lock.ml index a56e12f8370..0a49fe98a32 100644 --- a/bin/pkg/lock.ml +++ b/bin/pkg/lock.ml @@ -1,3 +1,4 @@ +open Dune_config open Import open Pkg_common module Package_version = Dune_pkg.Package_version @@ -66,11 +67,75 @@ let resolve_project_pins project_pins = Pin_stanza.resolve project_pins ~scan_project ;; +let solve_multiple_envs + base_solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + = + 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 + in + let portable_solver_env = + (* TODO: make sure nothing system-specific sneaks into the environment here *) + Dune_pkg.Solver_env.unset_multi + base_solver_env + Dune_lang.Package_variable_name.platform_specific + in + let+ results = + Fiber.parallel_map Dune_pkg.Solver_env.popular_platform_envs ~f:(fun platform_env -> + let solver_env = Dune_pkg.Solver_env.extend portable_solver_env platform_env in + solve_for_env solver_env) + in + let results, errors = + List.partition_map results ~f:(function + | Ok result -> Left result + | Error (`Diagnostic_message message) -> Right message) + in + match results with + | [] -> Error errors + | x :: xs -> + Ok (List.fold_left xs ~init:x ~f:Dune_pkg.Opam_solver.Solver_result.merge, errors) +;; + +let solve_single_env + solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + = + let open Fiber.O in + let+ result = + Dune_pkg.Opam_solver.solve_lock_dir + solver_env + version_preference + repos + ~pins + ~local_packages + ~constraints + in + match result with + | Ok result -> Ok (result, []) + | Error (`Diagnostic_message message) -> Error [ message ] +;; + let solve_lock_dir workspace ~local_packages ~project_pins ~print_perf_stats + ~portable_lock_dir version_preference solver_env_from_current_system lock_dir_path @@ -109,7 +174,8 @@ let solve_lock_dir let* pins = resolve_project_pins project_pins in let time_solve_start = Unix.gettimeofday () in progress_state := Some Progress_indicator.Per_lockdir.State.Solving; - Dune_pkg.Opam_solver.solve_lock_dir + let solve = if portable_lock_dir then solve_multiple_envs else solve_single_env in + solve solver_env (Pkg_common.Version_preference.choose ~from_arg:version_preference @@ -121,8 +187,11 @@ 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) >>= function - | Error (`Diagnostic_message message) -> Fiber.return (Error (lock_dir_path, message)) - | Ok { lock_dir; files; pinned_packages; num_expanded_packages } -> + | Error messages -> Fiber.return (Error (lock_dir_path, messages)) + | Ok ({ lock_dir; files; pinned_packages; num_expanded_packages }, _errors) -> + (* TODO: Users might want to know if no solution was found on certain + platforms. Give the option to print the solver errors, even if a + solution was found on some platforms. *) let time_end = Unix.gettimeofday () in let maybe_perf_stats = if print_perf_stats @@ -149,7 +218,13 @@ let solve_lock_dir in progress_state := None; let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in - Ok (Lock_dir.Write_disk.prepare ~lock_dir_path ~files lock_dir, summary_message) + Ok + ( Lock_dir.Write_disk.prepare + ~portable:portable_lock_dir + ~lock_dir_path + ~files + lock_dir + , summary_message ) ;; let solve @@ -160,6 +235,7 @@ let solve ~version_preference ~lock_dirs ~print_perf_stats + ~portable_lock_dir = let open Fiber.O in (* a list of thunks that will perform all the file IO side @@ -182,6 +258,7 @@ let solve ~local_packages ~project_pins ~print_perf_stats + ~portable_lock_dir version_preference solver_env_from_current_system lockdir_path @@ -196,9 +273,9 @@ let solve | Error errors -> User_error.raise ([ Pp.text "Unable to solve dependencies for the following lock directories:" ] - @ List.concat_map errors ~f:(fun (path, message) -> + @ List.concat_map errors ~f:(fun (path, messages) -> [ Pp.textf "Lock directory %s:" (Path.Source.to_string_maybe_quoted path) - ; Pp.hovbox message + ; Pp.hovbox (Pp.concat ~sep:Pp.newline messages) ])) | Ok write_disks_with_summaries -> let write_disk_list, summary_messages = List.split write_disks_with_summaries in @@ -214,7 +291,7 @@ let project_pins = Pin_stanza.DB.combine_exn acc (Dune_project.pins project)) ;; -let lock ~version_preference ~lock_dirs_arg ~print_perf_stats = +let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir = let open Fiber.O in let* solver_env_from_current_system = Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial) @@ -240,6 +317,7 @@ let lock ~version_preference ~lock_dirs_arg ~print_perf_stats = ~version_preference ~lock_dirs ~print_perf_stats + ~portable_lock_dir ;; let term = @@ -250,7 +328,12 @@ let term = let builder = Common.Builder.forbid_builds builder in let common, config = Common.init builder in Scheduler.go ~common ~config (fun () -> - lock ~version_preference ~lock_dirs_arg ~print_perf_stats) + let portable_lock_dir = + match Config.get Dune_rules.Compile_time.portable_lock_dir with + | `Enabled -> true + | `Disabled -> false + in + lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir) ;; let info = diff --git a/bin/pkg/lock.mli b/bin/pkg/lock.mli index d9f99d43dc2..e6b307791a0 100644 --- a/bin/pkg/lock.mli +++ b/bin/pkg/lock.mli @@ -8,6 +8,7 @@ val solve -> version_preference:Dune_pkg.Version_preference.t option -> lock_dirs:Path.Source.t list -> print_perf_stats:bool + -> portable_lock_dir:bool -> unit Fiber.t (** Command to create lock directory *) diff --git a/boot/configure.ml b/boot/configure.ml index 61e6afb7e9f..9c714c14371 100644 --- a/boot/configure.ml +++ b/boot/configure.ml @@ -22,6 +22,7 @@ let default_toggles : (string * [ `Disabled | `Enabled ]) list = ; "pkg_build_progress", `Disabled ; "lock_dev_tool", `Disabled ; "bin_dev_tools", `Disabled + ; "portable_lock_dir", `Disabled ] ;; @@ -110,6 +111,10 @@ let () = , " Enable obtaining dev-tools binarys from the binary package opam repository. \ Allows fast installation of dev-tools. \n\ \ This flag is experimental and shouldn't be relied on by packagers." ) + ; ( "--portable-lock-dir" + , toggle "portable_lock_dir" + , "Generate portable lock dirs. If this feature is disabled then lock dirs will be \ + specialized to the machine where they are generated." ) ] in let anon s = bad "Don't know what to do with %s" s in diff --git a/src/dune_lang/package_variable_name.ml b/src/dune_lang/package_variable_name.ml index 9c3e06d4953..bc1570e93f6 100644 --- a/src/dune_lang/package_variable_name.ml +++ b/src/dune_lang/package_variable_name.ml @@ -53,6 +53,10 @@ let post = of_string "post" let one_of t xs = List.mem xs ~equal t let dev = of_string "dev" +let platform_specific = + Set.of_list [ arch; os; os_version; os_distribution; os_family; sys_ocaml_version ] +;; + module Project = struct let encode name = Dune_sexp.Encoder.string (":" ^ to_string name) diff --git a/src/dune_lang/package_variable_name.mli b/src/dune_lang/package_variable_name.mli index 02dd9d7e1a7..d0dd1e770a7 100644 --- a/src/dune_lang/package_variable_name.mli +++ b/src/dune_lang/package_variable_name.mli @@ -32,6 +32,10 @@ val build : t val dev : t val one_of : t -> t list -> bool +(** The set of variable names whose values are expected to differ depending on + the current platform. *) +val platform_specific : Set.t + module Project : sig val encode : t Dune_sexp.Encoder.t val decode : t Dune_sexp.Decoder.t diff --git a/src/dune_pkg/file_entry.ml b/src/dune_pkg/file_entry.ml index 857775524d8..77c9ca6b2da 100644 --- a/src/dune_pkg/file_entry.ml +++ b/src/dune_pkg/file_entry.ml @@ -4,7 +4,28 @@ type source = | Path of Path.t | Content of string +let source_equal a b = + match a, b with + | Path a, Path b -> Path.equal a b + | Content a, Content b -> String.equal a b + | Path _, Content _ | Content _, Path _ -> false +;; + +let source_to_dyn = function + | Path path -> Dyn.variant "Path" [ Path.to_dyn path ] + | Content content -> Dyn.variant "Content" [ Dyn.string content ] +;; + type t = { original : source ; local_file : Path.Local.t } + +let equal { original; local_file } t = + source_equal original t.original && Path.Local.equal local_file t.local_file +;; + +let to_dyn { original; local_file } = + Dyn.record + [ "original", source_to_dyn original; "local_file", Path.Local.to_dyn local_file ] +;; diff --git a/src/dune_pkg/file_entry.mli b/src/dune_pkg/file_entry.mli index 857775524d8..d92aa2f817d 100644 --- a/src/dune_pkg/file_entry.mli +++ b/src/dune_pkg/file_entry.mli @@ -8,3 +8,6 @@ type t = { original : source ; local_file : Path.Local.t } + +val equal : t -> t -> bool +val to_dyn : t -> Dyn.t diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index cc5348f5776..b059f4b90c0 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1,5 +1,113 @@ open Import +module Conditional = struct + type 'a t = + { condition : Solver_env.t + ; value : 'a + } + + let make condition value = + let condition = Solver_env.retain condition Package_variable_name.platform_specific in + { condition; value } + ;; + + let equal value_equal { condition; value } t = + Solver_env.equal condition t.condition && value_equal value t.value + ;; + + let to_dyn value_to_dyn { condition; value } = + Dyn.record [ "condition", Solver_env.to_dyn condition; "value", value_to_dyn value ] + ;; + + let decode value_decode = + let open Decoder in + enter + (let+ condition = enter Solver_env.decode + and+ value = value_decode in + { condition; value }) + ;; + + let encode value_encode { condition; value } = + Dune_lang.List [ Solver_env.encode condition; value_encode value ] + ;; + + let map t ~f = { t with value = f t.value } + let condition { condition; _ } = condition + let get { value; _ } = value + + let matches t ~query = + Solver_env.fold t.condition ~init:true ~f:(fun variable stored_value acc -> + acc + && + match Solver_env.get query variable with + | None -> + (* The stored env has a field missing from the query. Don't match in this case. *) + false + | Some query_value -> Variable_value.equal query_value stored_value) + ;; +end + +module Conditional_choice = struct + type 'a t = 'a Conditional.t list + + let empty = [] + let singleton condition value = [ Conditional.make condition value ] + let singleton_all_platforms value = singleton Solver_env.empty value + let equal value_equal = List.equal (Conditional.equal value_equal) + let map ~f = List.map ~f:(Conditional.map ~f) + let to_dyn value_to_dyn = Dyn.list (Conditional.to_dyn value_to_dyn) + + let find t query = + List.find_map t ~f:(fun conditional -> + if Conditional.matches conditional ~query + then Some (Conditional.get conditional) + else None) + ;; + + let condition_exists t query = + List.exists t ~f:(fun conditional -> Conditional.matches conditional ~query) + ;; + + let encode_field field_name value_encode t = + Encoder.field_l field_name (Conditional.encode value_encode) t + ;; + + (* Concatenates a pair of sets of choices, raising a code error if the pair + has a condition in common. *) + let merge a b = + let merged = a @ b in + let () = + List.map merged ~f:(fun { Conditional.condition; _ } -> condition, ()) + |> Solver_env.Map.of_list_fold ~init:0 ~f:(fun count _ -> count + 1) + |> Solver_env.Map.iteri ~f:(fun solver_env count -> + if count > 1 + then + Code_error.raise + "Both sets of conditional choices had a condition in common." + [ "condition", Solver_env.to_dyn solver_env ]) + in + merged + ;; + + (* To support encoding in the non-portable format, this function extracts the + sole value from a conditional choice, raising a code error if there are + multiple choices. *) + let get_value_ensuring_at_most_one_choice t = + if List.length t > 1 + then + Code_error.raise + "Expected at most one conditional choice" + [ "conditions", List.map t ~f:Conditional.condition |> Dyn.list Solver_env.to_dyn + ]; + List.hd_opt t |> Option.map ~f:Conditional.get + ;; + + let decode_backwards_compatible decode_value = + let open Decoder in + decode_value >>| singleton_all_platforms <|> repeat (Conditional.decode decode_value) + ;; +end + module Pkg_info = struct type t = { name : Package_name.t @@ -78,10 +186,11 @@ module Build_command = struct module Fields = struct let dune = "dune" + let action = "action" let build = "build" end - let encode t = + let encode_non_portable t = let open Encoder in match t with | None -> field_o Fields.build Encoder.unit None @@ -89,36 +198,100 @@ module Build_command = struct | Some (Action a) -> field Fields.build Action.encode a ;; - let decode = + let encode_portable t = + let open Encoder in + Dune_lang.List + (record_fields + [ (match t with + | Dune -> field_b Fields.dune true + | Action a -> field Fields.action Action.encode a) + ]) + ;; + + let decode_portable = + let open Decoder in + enter + @@ fields + @@ fields_mutually_exclusive + [ ( Fields.action + , let+ pkg = Action.decode_pkg in + Action pkg ) + ; ( Fields.dune + , let+ () = return () in + Dune ) + ] + ;; + + let decode_fields_backwards_compatible = let open Decoder in + let parse_action = + (let+ action = Action.decode_pkg in + Conditional_choice.singleton_all_platforms (Action action)) + <|> repeat (Conditional.decode decode_portable) + in fields_mutually_exclusive - ~default:None - [ ( Fields.build - , let+ pkg = Action.decode_pkg in - Some (Action pkg) ) + ~default:Conditional_choice.empty + [ Fields.build, parse_action ; ( Fields.dune , let+ () = return () in - Some Dune ) + Conditional_choice.singleton_all_platforms Dune ) ] ;; end +module Depend = struct + type t = + { loc : Loc.t + ; name : Package_name.t + } + + let equal { loc; name } t = Loc.equal loc t.loc && Package_name.equal name t.name + let remove_locs { name; loc = _ } = { name; loc = Loc.none } + + let to_dyn { loc; name } = + Dyn.record [ "loc", Loc.to_dyn_hum loc; "name", Package_name.to_dyn name ] + ;; + + let decode = + let open Decoder in + let+ loc, name = located Package_name.decode in + { loc; name } + ;; + + let encode { name; loc = _ } = Package_name.encode name +end + +module Depends = struct + type t = Depend.t list + + let equal = List.equal Depend.equal + let remove_locs = List.map ~f:Depend.remove_locs + let to_dyn = Dyn.list Depend.to_dyn + + let decode = + let open Decoder in + enter @@ repeat Depend.decode + ;; + + let encode t = Dune_lang.List (List.map t ~f:Depend.encode) +end + module Pkg = struct type t = - { build_command : Build_command.t option - ; install_command : Action.t option - ; depends : (Loc.t * Package_name.t) list - ; depexts : string list + { build_command : Build_command.t Conditional_choice.t + ; install_command : Action.t Conditional_choice.t + ; depends : Depends.t Conditional_choice.t + ; depexts : string list Conditional_choice.t ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list } let equal { build_command; install_command; depends; depexts; info; exported_env } t = - Option.equal Build_command.equal build_command t.build_command + Conditional_choice.equal Build_command.equal build_command t.build_command (* CR-rgrinberg: why do we ignore locations? *) - && Option.equal Action.equal_no_locs install_command t.install_command - && List.equal (Tuple.T2.equal Loc.equal Package_name.equal) depends t.depends - && List.equal String.equal depexts t.depexts + && Conditional_choice.equal Action.equal_no_locs install_command t.install_command + && Conditional_choice.equal Depends.equal depends t.depends + && Conditional_choice.equal (List.equal String.equal) depexts t.depexts && Pkg_info.equal info t.info && List.equal (Action.Env_update.equal String_with_vars.equal) @@ -131,19 +304,19 @@ module Pkg = struct { info = Pkg_info.remove_locs info ; exported_env = List.map exported_env ~f:(Action.Env_update.map ~f:String_with_vars.remove_locs) - ; depends = List.map depends ~f:(fun (_, pkg) -> Loc.none, pkg) + ; depends = Conditional_choice.map depends ~f:Depends.remove_locs ; depexts - ; build_command = Option.map build_command ~f:Build_command.remove_locs - ; install_command = Option.map install_command ~f:Action.remove_locs + ; build_command = Conditional_choice.map build_command ~f:Build_command.remove_locs + ; install_command = Conditional_choice.map install_command ~f:Action.remove_locs } ;; let to_dyn { build_command; install_command; depends; depexts; info; exported_env } = Dyn.record - [ "build_command", Dyn.option Build_command.to_dyn build_command - ; "install_command", Dyn.option Action.to_dyn install_command - ; "depends", Dyn.list (Dyn.pair Loc.to_dyn_hum Package_name.to_dyn) depends - ; "depexts", Dyn.list String.to_dyn depexts + [ "build_command", Conditional_choice.to_dyn Build_command.to_dyn build_command + ; "install_command", Conditional_choice.to_dyn Action.to_dyn install_command + ; "depends", Conditional_choice.to_dyn Depends.to_dyn depends + ; "depexts", Conditional_choice.to_dyn (Dyn.list String.to_dyn) depexts ; "info", Pkg_info.to_dyn info ; ( "exported_env" , Dyn.list (Action.Env_update.to_dyn String_with_vars.to_dyn) exported_env ) @@ -163,6 +336,7 @@ module Pkg = struct module Fields = struct let version = "version" + let build = "build" let install = "install" let depends = "depends" let depexts = "depexts" @@ -175,14 +349,31 @@ module Pkg = struct let decode = let open Decoder in + let parse_install_command_backwards_compatible = + Conditional_choice.decode_backwards_compatible Action.decode_pkg + in + let parse_depends_backwards_compatible = + repeat Depend.decode + >>| Conditional_choice.singleton_all_platforms + <|> repeat (Conditional.decode Depends.decode) + in + let parse_depexts_backwards_compatible = + repeat string + >>| Conditional_choice.singleton_all_platforms + <|> repeat (Conditional.decode (enter @@ repeat string)) + in enter @@ fields @@ let+ version = field Fields.version Package_version.decode - and+ install_command = field_o Fields.install Action.decode_pkg - and+ build_command = Build_command.decode + and+ install_command = + field ~default:[] Fields.install parse_install_command_backwards_compatible + and+ build_command = Build_command.decode_fields_backwards_compatible and+ depends = - field ~default:[] Fields.depends (repeat (located Package_name.decode)) - and+ depexts = field ~default:[] Fields.depexts (repeat string) + field + ~default:(Conditional_choice.singleton_all_platforms []) + Fields.depends + parse_depends_backwards_compatible + and+ depexts = field ~default:[] Fields.depexts parse_depexts_backwards_compatible and+ source = field_o Fields.source Source.decode and+ dev = field_b Fields.dev and+ avoid = field_b Fields.avoid @@ -219,6 +410,7 @@ module Pkg = struct ;; let encode + ~portable { build_command ; install_command ; depends @@ -228,12 +420,41 @@ module Pkg = struct } = let open Encoder in + let install_command, build_command, depends, depexts = + if portable + then + ( Conditional_choice.encode_field Fields.install Action.encode install_command + , Conditional_choice.encode_field + Fields.build + Build_command.encode_portable + build_command + , Conditional_choice.encode_field Fields.depends Depends.encode depends + , Conditional_choice.encode_field Fields.depexts (list string) depexts ) + else + ( field_o + Fields.install + Action.encode + (Conditional_choice.get_value_ensuring_at_most_one_choice install_command) + , Build_command.encode_non_portable + (Conditional_choice.get_value_ensuring_at_most_one_choice build_command) + , field_l + Fields.depends + Package_name.encode + (Conditional_choice.get_value_ensuring_at_most_one_choice depends + |> Option.value ~default:[] + |> List.map ~f:(fun { Depend.name; _ } -> name)) + , field_l + Fields.depexts + string + (Conditional_choice.get_value_ensuring_at_most_one_choice depexts + |> Option.value ~default:[]) ) + in record_fields [ field Fields.version Package_version.encode version - ; field_o Fields.install Action.encode install_command - ; Build_command.encode build_command - ; field_l Fields.depends Package_name.encode (List.map depends ~f:snd) - ; field_l Fields.depexts string depexts + ; install_command + ; build_command + ; depends + ; depexts ; field_o Fields.source Source.encode source ; field_b Fields.dev dev ; field_b Fields.avoid avoid @@ -245,6 +466,27 @@ module Pkg = struct let files_dir package_name ~lock_dir = Path.Source.relative lock_dir (Package_name.to_string package_name ^ ".files") ;; + + (* Combine the platform-specific parts of a pair of [t]s, raising a code + error if the packages differ in any way apart from their platform-specific + fields. *) + let merge_conditionals a b = + let build_command = Conditional_choice.merge a.build_command b.build_command in + let install_command = Conditional_choice.merge a.install_command b.install_command in + let depends = Conditional_choice.merge a.depends b.depends in + let depexts = Conditional_choice.merge a.depexts b.depexts in + let ret = { a with build_command; install_command; depends; depexts } in + if not (equal ret { b with build_command; install_command; depends; depexts }) + then + Code_error.raise + "Packages differ in a non-platform-specific field" + [ "package_1", to_dyn a; "package_2", to_dyn b ]; + ret + ;; + + let is_available_under_condition t condition = + Conditional_choice.condition_exists t.depends condition + ;; end module Repositories = struct @@ -368,14 +610,15 @@ let validate_packages packages = let missing_dependencies = Package_name.Map.values packages |> List.concat_map ~f:(fun (dependant_package : Pkg.t) -> - List.filter_map dependant_package.depends ~f:(fun (loc, dependency) -> - (* CR-someday rgrinberg: do we need the dune check? aren't - we supposed to filter these upfront? *) - if - Package_name.Map.mem packages dependency - || Package_name.equal dependency Dune_dep.name - then None - else Some { dependant_package; dependency; loc })) + List.concat_map dependant_package.depends ~f:(fun conditional_depends -> + List.filter_map conditional_depends.value ~f:(fun depend -> + (* CR-someday rgrinberg: do we need the dune check? aren't + we supposed to filter these upfront? *) + if + Package_name.Map.mem packages depend.name + || Package_name.equal depend.name Dune_dep.name + then None + else Some { dependant_package; dependency = depend.name; loc = depend.loc }))) in if List.is_empty missing_dependencies then Ok () @@ -439,6 +682,7 @@ module Metadata = Dune_sexp.Versioned_file.Make (Unit) let () = Metadata.Lang.register Dune_lang.Pkg.syntax () let encode_metadata + ~portable { version ; dependency_hash ; ocaml @@ -471,7 +715,9 @@ let encode_metadata | Some ocaml -> [ list sexp [ string "ocaml"; Package_name.encode (snd ocaml) ] ]) @ [ list sexp (string "repositories" :: Repositories.encode repos) ] @ - if Solver_stats.Expanded_variable_bindings.is_empty expanded_solver_variable_bindings + if + portable + || Solver_stats.Expanded_variable_bindings.is_empty expanded_solver_variable_bindings then [] else [ list @@ -509,11 +755,11 @@ module Package_filename = struct ;; end -let file_contents_by_path t = - (metadata_filename, encode_metadata t) +let file_contents_by_path ~portable t = + (metadata_filename, encode_metadata ~portable t) :: (Package_name.Map.to_list t.packages |> List.map ~f:(fun (name, pkg) -> - Package_filename.of_package_name name, Pkg.encode pkg)) + Package_filename.of_package_name name, Pkg.encode ~portable pkg)) ;; module Write_disk = struct @@ -604,6 +850,7 @@ module Write_disk = struct type t = unit -> unit let prepare + ~portable ~lock_dir_path:lock_dir_path_src ~(files : File_entry.t Package_name.Map.Multi.t) lock_dir @@ -623,7 +870,7 @@ module Write_disk = struct in let build lock_dir_path = let lock_dir_path = Result.ok_exn lock_dir_path in - file_contents_by_path lock_dir + file_contents_by_path ~portable lock_dir |> List.iter ~f:(fun (path_within_lock_dir, contents) -> let path = Path.relative lock_dir_path path_within_lock_dir in Option.iter (Path.parent path) ~f:Path.mkdir_p; @@ -850,7 +1097,7 @@ module Load_immediate = Make_load (struct let read_disk = Load_immediate.load let read_disk_exn = Load_immediate.load_exn -let transitive_dependency_closure t start = +let transitive_dependency_closure t condition start = let missing_packages = let all_packages_in_lock_dir = Package_name.Set.of_keys t.packages in Package_name.Set.diff start all_packages_in_lock_dir @@ -870,7 +1117,19 @@ let transitive_dependency_closure t start = that its map of dependencies is closed under "depends on". *) Package_name.Set.( diff - (of_list_map (Package_name.Map.find_exn t.packages node).depends ~f:snd) + (of_list_map + (let pkg = Package_name.Map.find_exn t.packages node in + match Conditional_choice.find pkg.depends condition with + | Some depends -> depends + | None -> + User_error.raise + [ Pp.textf + "Lockfile does not contain dependencies for %s under the \ + condition" + (Package_name.to_string pkg.info.name) + ; Solver_env.pp condition + ]) + ~f:(fun depend -> depend.name)) seen) in push_set unseen_deps; @@ -891,3 +1150,36 @@ let compute_missing_checksums t ~pinned_packages = in { t with packages } ;; + +let merge_conditionals a b = + let packages = + Package_name.Map.merge a.packages b.packages ~f:(fun _ a b -> + match a, b with + | Some a, Some b -> + (* The package exists in both lockdirs. *) + Some (Pkg.merge_conditionals a b) + | Some x, None | None, Some x -> + (* The package only exists in one of the lockdirs. *) + Some x + | None, None -> + (* unreachable *) + None) + in + let normalize t = + { t with + packages = Package_name.Map.empty + ; expanded_solver_variable_bindings = Solver_stats.Expanded_variable_bindings.empty + } + 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 } +;; + +let packages_under_condition { packages; _ } condition = + Package_name.Map.filter packages ~f:(fun package -> + Pkg.is_available_under_condition package condition) +;; diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index be4633b6d2a..0e5db67fe3b 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -20,14 +20,38 @@ module Build_command : sig type t = | Action of Action.t | Dune (** pinned dune packages do not need to define a command *) + + val to_dyn : t -> Dyn.t +end + +module Depend : sig + type t = + { loc : Loc.t + ; name : Package_name.t + } + + val to_dyn : t -> Dyn.t +end + +module Conditional_choice : sig + (** A sequence of values, each conditional on an environment. *) + type 'a t + + val empty : 'a t + val singleton : Solver_env.t -> 'a -> 'a t + val singleton_all_platforms : 'a -> 'a t + + (** Returns the first value whose associated environment is a subset of the + specified environment. *) + val find : 'a t -> Solver_env.t -> 'a option end module Pkg : sig type t = - { build_command : Build_command.t option - ; install_command : Action.t option - ; depends : (Loc.t * Package_name.t) list - ; depexts : string list + { build_command : Build_command.t Conditional_choice.t + ; install_command : Action.t Conditional_choice.t + ; depends : Depend.t list Conditional_choice.t + ; depexts : string list Conditional_choice.t ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list } @@ -93,7 +117,8 @@ module Write_disk : sig type t val prepare - : lock_dir_path:Path.Source.t + : portable:bool + -> lock_dir_path:Path.Source.t -> files:File_entry.t Package_name.Map.Multi.t -> lock_dir -> t @@ -123,9 +148,16 @@ end not present in the lockdir. *) val transitive_dependency_closure : t + -> Solver_env.t -> Package_name.Set.t -> (Package_name.Set.t, [ `Missing_packages of Package_name.Set.t ]) result (** Attempt to download and compute checksums for packages that have source 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 + +val packages_under_condition : t -> Solver_env.t -> Pkg.t Package_name.Map.t diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index b4529c30078..83885d8d940 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -1838,7 +1838,8 @@ let opam_package_to_lock_file_pkg |> List.filter ~f:(fun package_name -> not (List.mem depends package_name ~equal:Package_name.equal)) in - depends @ depopts |> List.map ~f:(fun package_name -> Loc.none, package_name) + depends @ depopts + |> List.map ~f:(fun name -> { Lock_dir.Depend.loc = Loc.none; name }) in let build_env action = let env_update = @@ -1891,6 +1892,10 @@ let opam_package_to_lock_file_pkg |> Option.map ~f:build_env |> Option.map ~f:(fun action -> Lock_dir.Build_command.Action action)) in + let build_command = + Option.map build_command ~f:(Lock_dir.Conditional_choice.singleton solver_env) + |> Option.value ~default:Lock_dir.Conditional_choice.empty + in let depexts = OpamFile.OPAM.depexts opam_file |> List.concat_map ~f:(fun (sys_pkgs, filter) -> @@ -1899,16 +1904,24 @@ let opam_package_to_lock_file_pkg then OpamSysPkg.Set.to_list_map OpamSysPkg.to_string sys_pkgs else []) in + let depexts = + if List.is_empty depexts + then Lock_dir.Conditional_choice.empty + else Lock_dir.Conditional_choice.singleton solver_env depexts + in let install_command = OpamFile.OPAM.install opam_file |> opam_commands_to_actions get_solver_var loc opam_package |> make_action - |> Option.map ~f:build_env + |> Option.map ~f:(fun action -> + Lock_dir.Conditional_choice.singleton solver_env (build_env action)) + |> Option.value ~default:Lock_dir.Conditional_choice.empty in let exported_env = OpamFile.OPAM.env opam_file |> List.map ~f:opam_env_update_to_env_update in let kind = if opam_file_is_compiler opam_file then `Compiler else `Non_compiler in + let depends = Lock_dir.Conditional_choice.singleton solver_env depends in ( kind , { Lock_dir.Pkg.build_command; install_command; depends; depexts; info; exported_env } ) @@ -1954,6 +1967,30 @@ module Solver_result = struct ; pinned_packages : Package_name.Set.t ; num_expanded_packages : int } + + let merge a b = + let lock_dir = Lock_dir.merge_conditionals a.lock_dir b.lock_dir in + let files = + Package_name.Map.merge a.files b.files ~f:(fun _ a b -> + match a, b with + | Some a, Some b -> + (* The package is present in both solutions. Make sure its associated + files are the same in both instances. *) + if not (List.equal File_entry.equal a b) + then + Code_error.raise + "Package files differ between merged solver results" + [ "files_1", Dyn.list File_entry.to_dyn a + ; "files_2", Dyn.list File_entry.to_dyn b + ]; + Some a + | Some x, None | None, Some x -> Some x + | None, None -> None) + in + let pinned_packages = Package_name.Set.union a.pinned_packages b.pinned_packages in + let num_expanded_packages = a.num_expanded_packages + b.num_expanded_packages in + { lock_dir; files; pinned_packages; num_expanded_packages } + ;; end let reject_unreachable_packages = @@ -1997,7 +2034,11 @@ let reject_unreachable_packages = Code_error.raise "package is both local and returned by solver" [ "name", Package_name.to_dyn name ] - | Some (pkg : Lock_dir.Pkg.t), None -> Some (List.map pkg.depends ~f:snd) + | Some (pkg : Lock_dir.Pkg.t), None -> + Some + (Lock_dir.Conditional_choice.find pkg.depends solver_env + |> Option.value ~default:[] + |> List.map ~f:(fun (depend : Lock_dir.Depend.t) -> depend.name)) | None, Some (pkg : Local_package.For_solver.t) -> let deps = match @@ -2176,18 +2217,22 @@ let solve_lock_dir Package_name.Map.iter pkgs_by_name ~f:(fun { Lock_dir.Pkg.depends; info = { name; _ }; _ } -> - List.iter depends ~f:(fun (loc, dep_name) -> - if Package_name.Map.mem local_packages dep_name - then - User_error.raise - ~loc - [ Pp.textf - "Dune does not support packages outside the workspace depending on \ - packages in the workspace. The package %S is not in the workspace \ - but it depends on the package %S which is in the workspace." - (Package_name.to_string name) - (Package_name.to_string dep_name) - ])); + Option.iter + (Lock_dir.Conditional_choice.find depends solver_env) + ~f: + (List.iter ~f:(fun (depend : Lock_dir.Depend.t) -> + if Package_name.Map.mem local_packages depend.name + then + User_error.raise + ~loc:depend.loc + [ Pp.textf + "Dune does not support packages outside the workspace \ + depending on packages in the workspace. The package %S is \ + not in the workspace but it depends on the package %S which \ + is in the workspace." + (Package_name.to_string name) + (Package_name.to_string depend.name) + ]))); let pkgs_by_name = let reachable = reject_unreachable_packages diff --git a/src/dune_pkg/opam_solver.mli b/src/dune_pkg/opam_solver.mli index 21a0ac2954d..2c701d6be0b 100644 --- a/src/dune_pkg/opam_solver.mli +++ b/src/dune_pkg/opam_solver.mli @@ -7,6 +7,8 @@ module Solver_result : sig ; pinned_packages : Package_name.Set.t ; num_expanded_packages : int } + + val merge : t -> t -> t end val solve_lock_dir diff --git a/src/dune_pkg/package_universe.ml b/src/dune_pkg/package_universe.ml index 8de5bc0d22b..7bdfc8d6cb8 100644 --- a/src/dune_pkg/package_universe.ml +++ b/src/dune_pkg/package_universe.ml @@ -86,6 +86,7 @@ let all_non_local_dependencies_of_local_packages t = let check_for_unnecessary_packges_in_lock_dir lock_dir + solver_env all_non_local_dependencies_of_local_packages = let unneeded_packages_in_lock_dir = @@ -93,6 +94,7 @@ let check_for_unnecessary_packges_in_lock_dir match Lock_dir.transitive_dependency_closure lock_dir + solver_env all_non_local_dependencies_of_local_packages with | Ok x -> x @@ -220,7 +222,7 @@ let validate t = t.local_packages ~saved_dependency_hash:t.lock_dir.dependency_hash; all_non_local_dependencies_of_local_packages t - |> check_for_unnecessary_packges_in_lock_dir t.lock_dir + |> check_for_unnecessary_packges_in_lock_dir t.lock_dir t.solver_env ;; let create local_packages lock_dir = @@ -273,6 +275,7 @@ let transitive_dependency_closure_without_test t start = match Lock_dir.transitive_dependency_closure t.lock_dir + t.solver_env Package_name.Set.( union non_local_immediate_dependencies_of_local_transitive_dependency_closure diff --git a/src/dune_pkg/solver_env.ml b/src/dune_pkg/solver_env.ml index ff06e563b3d..9df3f6738d8 100644 --- a/src/dune_pkg/solver_env.ml +++ b/src/dune_pkg/solver_env.ml @@ -1,11 +1,19 @@ open Import -type t = Variable_value.t Package_variable_name.Map.t +module T = struct + type t = Variable_value.t Package_variable_name.Map.t + + let to_dyn = Package_variable_name.Map.to_dyn Variable_value.to_dyn + let equal = Package_variable_name.Map.equal ~equal:Variable_value.equal + let compare = Package_variable_name.Map.compare ~compare:Variable_value.compare +end + +include T +include Comparable.Make (T) let empty = Package_variable_name.Map.empty -let equal = Package_variable_name.Map.equal ~equal:Variable_value.equal -let to_dyn = Package_variable_name.Map.to_dyn Variable_value.to_dyn let is_empty = Package_variable_name.Map.is_empty +let fold = Package_variable_name.Map.foldi let validate t ~loc = if Package_variable_name.Map.mem t Package_variable_name.with_test @@ -20,6 +28,12 @@ let validate t ~loc = ] ;; +let encode t = + let open Encoder in + Package_variable_name.Map.to_list t + |> list (pair Package_variable_name.encode Variable_value.encode) +;; + let decode = let open Decoder in let+ loc, bindings = @@ -77,6 +91,13 @@ let unset_multi t variable_names = unset t variable_name) ;; +let retain t variable_names = + fold t ~init:t ~f:(fun variable_name _value acc -> + if Package_variable_name.Set.mem variable_names variable_name + then acc + else unset acc variable_name) +;; + let to_env t variable = match OpamVariable.Full.scope variable with | Self | Package _ -> None @@ -86,3 +107,32 @@ let to_env t variable = in get t variable_name |> Option.map ~f:Variable_value.to_opam_variable_contents ;; + +let popular_platform_envs = + let make ~os ~arch ~os_distribution = + let env = empty in + let env = set env Package_variable_name.os (Variable_value.string os) in + let env = set env Package_variable_name.arch (Variable_value.string arch) in + let env = + match os_distribution with + | Some os_distribution -> + set + env + Package_variable_name.os_distribution + (Variable_value.string os_distribution) + | None -> env + in + env + in + List.concat_map + (* Include distros with special cases in popular packages (such as the ocaml compiler). *) + [ "linux", [ "alpine" ]; "macos", []; "win32", [ "cygwin" ] ] + ~f:(fun (os, distros) -> + List.concat_map [ "x86_64"; "arm64" ] ~f:(fun arch -> + let distros = + (* Put the [None] case at the end of the list so that cases with + distros are tried first. *) + List.map distros ~f:Option.some @ [ None ] + in + List.map distros ~f:(fun os_distribution -> make ~os ~arch ~os_distribution))) +;; diff --git a/src/dune_pkg/solver_env.mli b/src/dune_pkg/solver_env.mli index d5c7bcc62bb..13443c6e93a 100644 --- a/src/dune_pkg/solver_env.mli +++ b/src/dune_pkg/solver_env.mli @@ -6,6 +6,14 @@ val empty : t val equal : t -> t -> bool val to_dyn : t -> Dyn.t val is_empty : t -> bool + +val fold + : t + -> init:'a + -> f:(Package_variable_name.t -> Variable_value.t -> 'a -> 'a) + -> 'a + +val encode : t Encoder.t val decode : t Decoder.t val set : t -> Package_variable_name.t -> Variable_value.t -> t val get : t -> Package_variable_name.t -> Variable_value.t option @@ -22,4 +30,11 @@ val with_defaults : t val pp : t -> 'a Pp.t val unset_multi : t -> Package_variable_name.Set.t -> t + +(* [retain t vars] removes all variables from [t] except for those in [vars]. *) +val retain : t -> Package_variable_name.Set.t -> t val to_env : t -> OpamFilter.env +val popular_platform_envs : t list + +module Map : Map.S with type key = t +module Set : Set.S with type elt = t and type 'a map = 'a Map.t diff --git a/src/dune_pkg/variable_value.ml b/src/dune_pkg/variable_value.ml index 0f66ae0e310..47f5f7552d2 100644 --- a/src/dune_pkg/variable_value.ml +++ b/src/dune_pkg/variable_value.ml @@ -17,6 +17,7 @@ let true_ = "true" let false_ = "false" let string = Fun.id let equal = String.equal +let compare = String.compare let to_dyn = Dyn.string let to_string = Fun.id let decode = Decoder.string diff --git a/src/dune_pkg/variable_value.mli b/src/dune_pkg/variable_value.mli index 2e6fd3d183c..56246bdce19 100644 --- a/src/dune_pkg/variable_value.mli +++ b/src/dune_pkg/variable_value.mli @@ -9,6 +9,7 @@ val false_ : t val string : string -> t val equal : t -> t -> bool +val compare : t -> t -> ordering val to_dyn : t -> Dyn.t val decode : t Decoder.t val encode : t Encoder.t diff --git a/src/dune_rules/compile_time.ml b/src/dune_rules/compile_time.ml index 7584e28e96b..00e35daa3c5 100644 --- a/src/dune_rules/compile_time.ml +++ b/src/dune_rules/compile_time.ml @@ -8,3 +8,7 @@ let pkg_build_progress = let lock_dev_tools = Config.make_toggle ~name:"lock_dev_tool" ~default:Setup.lock_dev_tool let bin_dev_tools = Config.make_toggle ~name:"bin_dev_tools" ~default:Setup.bin_dev_tools + +let portable_lock_dir = + Config.make_toggle ~name:"portable_lock_dir" ~default:Setup.portable_lock_dir +;; diff --git a/src/dune_rules/compile_time.mli b/src/dune_rules/compile_time.mli index 4c03f54f7ae..cf540b16eb4 100644 --- a/src/dune_rules/compile_time.mli +++ b/src/dune_rules/compile_time.mli @@ -22,3 +22,4 @@ val pkg_build_progress : Config.Toggle.t Config.t val lock_dev_tools : Config.Toggle.t Config.t val bin_dev_tools : Config.Toggle.t Config.t +val portable_lock_dir : Config.Toggle.t Config.t diff --git a/src/dune_rules/lock_dir.ml b/src/dune_rules/lock_dir.ml index 8fbba4bae35..513f07a2242 100644 --- a/src/dune_rules/lock_dir.ml +++ b/src/dune_rules/lock_dir.ml @@ -66,6 +66,27 @@ module Sys_vars = struct (Dune_sexp.Template.Pform.describe source) ]) ;; + + let solver_env () = + let open Memo.O in + let module V = Package_variable_name in + let { os; os_version; os_distribution; os_family; arch; sys_ocaml_version = _ } = + poll + in + let+ var_value_pairs = + [ V.os, os + ; V.os_version, os_version + ; V.os_distribution, os_distribution + ; V.os_family, os_family + ; V.arch, arch + ] + |> Memo.List.filter_map ~f:(fun (var, value) -> + let+ value = Memo.Lazy.force value in + Option.map value ~f:(fun value -> var, Variable_value.string value)) + in + List.fold_left var_value_pairs ~init:Solver_env.empty ~f:(fun acc (var, value) -> + Solver_env.set acc var value) + ;; end module Load = Make_load (struct diff --git a/src/dune_rules/lock_dir.mli b/src/dune_rules/lock_dir.mli index 8d69758f5ae..285dd5d2b44 100644 --- a/src/dune_rules/lock_dir.mli +++ b/src/dune_rules/lock_dir.mli @@ -21,6 +21,7 @@ module Sys_vars : sig } val poll : t + val solver_env : unit -> Dune_pkg.Solver_env.t Memo.t end val source_kind diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 2f5693445cf..5e5f7b5c306 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -1062,8 +1062,12 @@ module DB = struct let get package_universe = let dune = Package.Name.Set.singleton (Package.Name.of_string "dune") in - let+ all = Package_universe.lock_dir package_universe in - { all = all.packages; system_provided = dune } + let+ all = Package_universe.lock_dir package_universe + and+ solver_env = Lock_dir.Sys_vars.solver_env () in + let all_available_packages = + Dune_pkg.Lock_dir.packages_under_condition all solver_env + in + { all = all_available_packages; system_provided = dune } ;; end @@ -1108,9 +1112,21 @@ end = struct ; depexts } as pkg) -> assert (Package.Name.equal name info.name); + let* solver_env = Lock_dir.Sys_vars.solver_env () in + let depends = + match Dune_pkg.Lock_dir.Conditional_choice.find depends solver_env with + | Some depends -> depends + | None -> + User_error.raise + [ Pp.textf + "Lockfile does not contain dependencies for %s under the condition" + (Dune_pkg.Package_name.to_string pkg.info.name) + ; Dune_pkg.Solver_env.pp solver_env + ] + in let* depends = - Memo.parallel_map depends ~f:(fun name -> - resolve db name package_universe + Memo.parallel_map depends ~f:(fun depend -> + resolve db (depend.loc, depend.name) package_universe >>| function | `Inside_lock_dir pkg -> Some pkg | `System_provided -> None) @@ -1125,6 +1141,12 @@ end = struct in let id = Pkg.Id.gen () in let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in + let install_command = + Dune_pkg.Lock_dir.Conditional_choice.find install_command solver_env + in + let build_command = + Dune_pkg.Lock_dir.Conditional_choice.find build_command solver_env + in let* paths, build_command, install_command = let paths = Paths.map_path write_paths ~f:Path.build in match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name with @@ -1169,6 +1191,10 @@ end = struct , build_command , install_command ) in + let depexts = + Dune_pkg.Lock_dir.Conditional_choice.find depexts solver_env + |> Option.value ~default:[] + in let t = { Pkg.id ; build_command diff --git a/src/dune_rules/setup.defaults.ml b/src/dune_rules/setup.defaults.ml index f639fc61a13..a665330122a 100644 --- a/src/dune_rules/setup.defaults.ml +++ b/src/dune_rules/setup.defaults.ml @@ -16,3 +16,4 @@ let toolchains = `Enabled let pkg_build_progress = `Disabled let lock_dev_tool = `Disabled let bin_dev_tools = `Disabled +let portable_lock_dir = `Disabled diff --git a/src/dune_rules/setup.mli b/src/dune_rules/setup.mli index 73d3a330e06..44455e8f2b9 100644 --- a/src/dune_rules/setup.mli +++ b/src/dune_rules/setup.mli @@ -14,4 +14,5 @@ val toolchains : Dune_config.Config.Toggle.t val pkg_build_progress : Dune_config.Config.Toggle.t val lock_dev_tool : Dune_config.Config.Toggle.t val bin_dev_tools : Dune_config.Config.Toggle.t +val portable_lock_dir : Dune_config.Config.Toggle.t val prefix : string option diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t new file mode 100644 index 00000000000..6d7f5a91401 --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t @@ -0,0 +1,163 @@ +Demonstration of portable lockdirs. + + $ . ./helpers.sh + $ mkrepo + $ add_mock_repo_if_needed + +A package that writes some info about machine where it's built to the share directory. + $ mkpkg foo < build: [ + > ["mkdir" "-p" share "%{lib}%/%{name}%"] + > ["touch" "%{lib}%/%{name}%/META"] # needed for dune to recognize this as a library + > ["sh" "-c" "echo Darwin > %{share}%/kernel"] { os = "macos" } + > ["sh" "-c" "echo Linux > %{share}%/kernel"] { os = "linux" } + > ["sh" "-c" "echo x86_64 > %{share}%/machine"] { arch = "x86_64" } + > ["sh" "-c" "echo arm64 > %{share}%/machine"] { arch = "arm64" } + > ] + > EOF + + $ cat > dune-project < (lang dune 3.17) + > (package + > (name x) + > (depends foo)) + > EOF + $ cat > x.ml < let () = print_endline "Hello, World!" + > EOF + $ cat > dune < (executable + > (public_name x) + > (libraries foo)) + > EOF + + $ DUNE_CONFIG__PORTABLE_LOCK_DIR=enabled dune pkg lock + Solution for dune.lock: + - foo.0.0.1 + + $ cat dune.lock/foo.pkg + (version 0.0.1) + + (build + (((arch x86_64) + (os linux) + (os-distribution alpine)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch x86_64) + (os linux)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os linux) + (os-distribution alpine)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch arm64) + (os linux)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch x86_64) + (os macos)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os macos)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch x86_64) + (os win32) + (os-distribution cygwin)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch x86_64) + (os win32)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo x86_64 > %{share}/machine"))))) + (((arch arm64) + (os win32) + (os-distribution cygwin)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo arm64 > %{share}/machine"))))) + (((arch arm64) + (os win32)) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo arm64 > %{share}/machine")))))) + + (depends + (((arch x86_64) + (os linux) + (os-distribution alpine)) + ()) + (((arch x86_64) + (os linux)) + ()) + (((arch arm64) + (os linux) + (os-distribution alpine)) + ()) + (((arch arm64) + (os linux)) + ()) + (((arch x86_64) + (os macos)) + ()) + (((arch arm64) + (os macos)) + ()) + (((arch x86_64) + (os win32) + (os-distribution cygwin)) + ()) + (((arch x86_64) + (os win32)) + ()) + (((arch arm64) + (os win32) + (os-distribution cygwin)) + ()) + (((arch arm64) + (os win32)) + ())) + + $ dune build + + $ [ $(cat _build/_private/default/.pkg/foo/target/share/kernel) = $(uname -s) ] + + $ [ $(cat _build/_private/default/.pkg/foo/target/share/machine) = $(uname -m) ] diff --git a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml index c4375e732ca..52d6bd81e68 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -1,6 +1,7 @@ open Stdune module Checksum = Dune_pkg.Checksum module Lock_dir = Dune_pkg.Lock_dir +module Depend = Dune_pkg.Lock_dir.Depend module Opam_repo = Dune_pkg.Opam_repo module Expanded_variable_bindings = Dune_pkg.Solver_stats.Expanded_variable_bindings module Package_variable_name = Dune_lang.Package_variable_name @@ -66,7 +67,8 @@ end let lock_dir_encode_decode_round_trip_test ?commit ~lock_dir_path ~lock_dir () = let lock_dir_path = Path.Source.of_string lock_dir_path in Lock_dir.Write_disk.( - prepare ~lock_dir_path ~files:Package_name.Map.empty lock_dir |> commit); + prepare ~portable:false ~lock_dir_path ~files:Package_name.Map.empty lock_dir + |> commit); let lock_dir_round_tripped = try Lock_dir.read_disk_exn lock_dir_path with | User_error.E _ as exn -> @@ -123,14 +125,15 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = ; repos = { complete = true; used = None } ; expanded_solver_variable_bindings = { variable_values = []; unset_variables = [] } - } |}] + } + |}] ;; let empty_package name ~version = - { Lock_dir.Pkg.build_command = None - ; install_command = None - ; depends = [] - ; depexts = [] + { Lock_dir.Pkg.build_command = Lock_dir.Conditional_choice.empty + ; install_command = Lock_dir.Conditional_choice.empty + ; depends = Lock_dir.Conditional_choice.singleton_all_platforms [] + ; depexts = Lock_dir.Conditional_choice.empty ; info = { Lock_dir.Pkg_info.name ; version @@ -173,9 +176,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; packages = map { "bar" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "bar" @@ -188,9 +191,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; exported_env = [] } ; "foo" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "foo" @@ -216,6 +219,9 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = let%expect_test "encode/decode round trip test for lockdir with complex deps" = let module Action = Dune_lang.Action in let module String_with_vars = Dune_lang.String_with_vars in + let make_conditional value = + Lock_dir.Conditional_choice.singleton Dune_pkg.Solver_env.empty value + in let lock_dir = let pkg_a = let name = Package_name.of_string "a" in @@ -226,11 +232,11 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = , let pkg = empty_package name ~version:(Package_version.of_string "0.1.0") in { pkg with build_command = - Some - (Action + make_conditional + (Lock_dir.Build_command.Action Action.(Progn [ Echo [ String_with_vars.make_text Loc.none "hello" ] ])) ; install_command = - Some + make_conditional (Action.System (* String_with_vars.t doesn't round trip so we have to set [quoted] if the string would be quoted *) @@ -260,8 +266,8 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ( name , let pkg = empty_package name ~version:(Package_version.of_string "dev") in { pkg with - install_command = None - ; depends = [ Loc.none, fst pkg_a ] + install_command = Lock_dir.Conditional_choice.empty + ; depends = make_conditional [ { Depend.loc = Loc.none; name = fst pkg_a } ] ; info = { pkg.info with dev = true @@ -283,7 +289,11 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ( name , let pkg = empty_package name ~version:(Package_version.of_string "0.2") in { pkg with - depends = [ Loc.none, fst pkg_a; Loc.none, fst pkg_b ] + depends = + make_conditional + [ { Depend.loc = Loc.none; name = fst pkg_a } + ; { Depend.loc = Loc.none; name = fst pkg_b } + ] ; info = { pkg.info with dev = false @@ -315,9 +325,15 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; packages = map { "a" : - { build_command = Some (Action [ "progn"; [ "echo"; "hello" ] ]) - ; install_command = Some [ "system"; "echo 'world'" ] - ; depends = [] + { build_command = + [ { condition = map {} + ; value = Action [ "progn"; [ "echo"; "hello" ] ] + } + ] + ; install_command = + [ { condition = map {}; value = [ "system"; "echo 'world'" ] } + ] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "a" @@ -333,9 +349,14 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ] } ; "b" : - { build_command = None - ; install_command = None - ; depends = [ ("complex_lock_dir/b.pkg:3", "a") ] + { build_command = [] + ; install_command = [] + ; depends = + [ { condition = map {} + ; value = + [ { loc = "complex_lock_dir/b.pkg:3"; name = "a" } ] + } + ] ; depexts = [] ; info = { name = "b" @@ -354,11 +375,15 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; exported_env = [] } ; "c" : - { build_command = None - ; install_command = None + { build_command = [] + ; install_command = [] ; depends = - [ ("complex_lock_dir/c.pkg:3", "a") - ; ("complex_lock_dir/c.pkg:3", "b") + [ { condition = map {} + ; value = + [ { loc = "complex_lock_dir/c.pkg:3"; name = "a" } + ; { loc = "complex_lock_dir/c.pkg:3"; name = "b" } + ] + } ] ; depexts = [] ; info = @@ -429,9 +454,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; packages = map { "a" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "a" @@ -444,9 +469,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; exported_env = [] } ; "b" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "b" @@ -459,9 +484,9 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; exported_env = [] } ; "c" : - { build_command = None - ; install_command = None - ; depends = [] + { build_command = [] + ; install_command = [] + ; depends = [ { condition = map {}; value = [] } ] ; depexts = [] ; info = { name = "c" From f693d00e43deec77e2b5a96a377f4ca5f42c317b Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Fri, 2 May 2025 20:00:01 +1000 Subject: [PATCH 2/2] wip --- bin/describe/describe_depexts.ml | 4 +- src/dune_pkg/lock_dir.ml | 587 +++++++++++++----- src/dune_pkg/lock_dir.mli | 21 +- src/dune_pkg/opam_solver.ml | 42 +- src/dune_pkg/package_universe.ml | 4 +- src/dune_pkg/solver_env.ml | 27 +- src/dune_pkg/solver_env.mli | 2 + src/dune_rules/pkg_rules.ml | 28 +- .../test-cases/pkg/portable-lockdirs.t | 195 +++--- .../dune_pkg/dune_pkg_unit_tests.ml | 47 +- 10 files changed, 654 insertions(+), 303 deletions(-) diff --git a/bin/describe/describe_depexts.ml b/bin/describe/describe_depexts.ml index 878f6b455f9..f35d53746cc 100644 --- a/bin/describe/describe_depexts.ml +++ b/bin/describe/describe_depexts.ml @@ -33,7 +33,9 @@ let print_depexts ~lock_dirs_arg = lock_dir.packages |> Package_name.Map.values |> List.concat_map ~f:(fun (pkg : Lock_dir.Pkg.t) -> - match Lock_dir.Conditional_choice.find pkg.depexts solver_env with + match + Lock_dir.Conditional_choice.choose_for_platform pkg.depexts ~platform:solver_env + with | Some depexts -> depexts | None -> [])) in diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index b059f4b90c0..be9ca4e1a08 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -1,50 +1,87 @@ open Import +module Solver_env_disjunction = struct + (* A disjunction of solver envs consisting of only platform-specific solver variables. *) + type t = Solver_env.t list + + let singleton solver_env : t = + let solver_env_with_only_platform_specific_vars = + Solver_env.retain solver_env Package_variable_name.platform_specific + in + [ solver_env_with_only_platform_specific_vars ] + ;; + + let to_dyn = Dyn.list Solver_env.to_dyn + + let equal a b = + let a = List.sort a ~compare:Solver_env.compare in + let b = List.sort b ~compare:Solver_env.compare in + List.equal Solver_env.equal a b + ;; + + let encode t = + let open Encoder in + list sexp (List.map ~f:Solver_env.encode t) + ;; + + let decode = + let open Decoder in + enter @@ repeat (enter Solver_env.decode) + ;; + + let single_solver_env_matches_platform solver_env ~platform = + Solver_env.fold solver_env ~init:true ~f:(fun variable stored_value acc -> + acc + && + match Solver_env.get platform variable with + | None -> + (* The stored env has a field missing from the query. Don't match in this case. *) + false + | Some query_value -> Variable_value.equal query_value stored_value) + ;; + + let matches_platform t ~platform = + List.exists t ~f:(single_solver_env_matches_platform ~platform) + ;; +end + module Conditional = struct type 'a t = - { condition : Solver_env.t + { condition : Solver_env_disjunction.t ; value : 'a } - let make condition value = - let condition = Solver_env.retain condition Package_variable_name.platform_specific in + let make solver_env value = + let condition = Solver_env_disjunction.singleton solver_env in { condition; value } ;; let equal value_equal { condition; value } t = - Solver_env.equal condition t.condition && value_equal value t.value + Solver_env_disjunction.equal condition t.condition && value_equal value t.value ;; let to_dyn value_to_dyn { condition; value } = - Dyn.record [ "condition", Solver_env.to_dyn condition; "value", value_to_dyn value ] + Dyn.record + [ "condition", Solver_env_disjunction.to_dyn condition + ; "value", value_to_dyn value + ] ;; let decode value_decode = let open Decoder in enter - (let+ condition = enter Solver_env.decode + (let+ condition = Solver_env_disjunction.decode and+ value = value_decode in { condition; value }) ;; - let encode value_encode { condition; value } = - Dune_lang.List [ Solver_env.encode condition; value_encode value ] + let encode encode_value { condition; value } = + Dune_lang.List [ Solver_env_disjunction.encode condition; encode_value value ] ;; let map t ~f = { t with value = f t.value } let condition { condition; _ } = condition let get { value; _ } = value - - let matches t ~query = - Solver_env.fold t.condition ~init:true ~f:(fun variable stored_value acc -> - acc - && - match Solver_env.get query variable with - | None -> - (* The stored env has a field missing from the query. Don't match in this case. *) - false - | Some query_value -> Variable_value.equal query_value stored_value) - ;; end module Conditional_choice = struct @@ -57,36 +94,34 @@ module Conditional_choice = struct let map ~f = List.map ~f:(Conditional.map ~f) let to_dyn value_to_dyn = Dyn.list (Conditional.to_dyn value_to_dyn) - let find t query = - List.find_map t ~f:(fun conditional -> - if Conditional.matches conditional ~query - then Some (Conditional.get conditional) + let choose_for_platform t ~platform = + List.find_map t ~f:(fun { Conditional.condition; value } -> + if Solver_env_disjunction.matches_platform condition ~platform + then Some value else None) ;; - let condition_exists t query = - List.exists t ~f:(fun conditional -> Conditional.matches conditional ~query) - ;; - - let encode_field field_name value_encode t = - Encoder.field_l field_name (Conditional.encode value_encode) t + let append_combining_conditions + ~value_equal + t + ({ Conditional.condition; value } as conditional) + = + let rec loop t = + match t with + | [] -> [ conditional ] + | (x : _ Conditional.t) :: xs -> + if value_equal x.value value + then { Conditional.condition = x.condition @ condition; value } :: xs + else x :: loop xs + in + loop t ;; - (* Concatenates a pair of sets of choices, raising a code error if the pair - has a condition in common. *) - let merge a b = - let merged = a @ b in - let () = - List.map merged ~f:(fun { Conditional.condition; _ } -> condition, ()) - |> Solver_env.Map.of_list_fold ~init:0 ~f:(fun count _ -> count + 1) - |> Solver_env.Map.iteri ~f:(fun solver_env count -> - if count > 1 - then - Code_error.raise - "Both sets of conditional choices had a condition in common." - [ "condition", Solver_env.to_dyn solver_env ]) - in - merged + (* Combines two sets of conditionals. If there are values in common between + the two sets then the conditions corresponding to those values are + combined to avoid duplication. *) + let merge_combining_conditions ~value_equal a b = + List.fold_left b ~init:a ~f:(append_combining_conditions ~value_equal) ;; (* To support encoding in the non-portable format, this function extracts the @@ -97,15 +132,12 @@ module Conditional_choice = struct then Code_error.raise "Expected at most one conditional choice" - [ "conditions", List.map t ~f:Conditional.condition |> Dyn.list Solver_env.to_dyn + [ ( "conditions" + , List.map t ~f:Conditional.condition |> Dyn.list Solver_env_disjunction.to_dyn + ) ]; List.hd_opt t |> Option.map ~f:Conditional.get ;; - - let decode_backwards_compatible decode_value = - let open Decoder in - decode_value >>| singleton_all_platforms <|> repeat (Conditional.decode decode_value) - ;; end module Pkg_info = struct @@ -162,6 +194,98 @@ module Pkg_info = struct ;; end +module Conditional_choice_or_all_platforms = struct + (* Either a choice of value or a single value to use in all cases. The + [All_platforms _] case will be used to reduce the verbosity of lockfiles + where a value is the same for all solver environments under which the + lockdir is valid. This type is a convenience for encoding and decoding + lockfiles but doesn't appear in the representation of a package. *) + type 'a t = + | Choice of 'a Conditional_choice.t + | All_platforms of 'a + + let of_conditional_choice ~solved_for_envs = function + | [] -> None + | [ { Conditional.condition; value } ] as choice -> + if Solver_env_disjunction.equal condition solved_for_envs + then Some (All_platforms value) + else Some (Choice choice) + | choice -> Some (Choice choice) + ;; + + let to_conditional_choice ~solved_for_envs = function + | Choice choice -> choice + | All_platforms value -> [ { Conditional.value; condition = solved_for_envs } ] + ;; + + let decode decode_value = + let open Decoder in + sum + [ ( "choice" + , let+ choice = repeat (Conditional.decode decode_value) in + Choice choice ) + ; ( "all_platforms" + , let+ value = decode_value in + All_platforms value ) + ] + ;; + + let encode encode_value t = + let open Encoder in + match t with + | Choice choice -> + Dune_lang.List + (string "choice" :: List.map ~f:(Conditional.encode encode_value) choice) + | All_platforms value -> Dune_lang.List [ string "all_platforms"; encode_value value ] + ;; + + let encode_field ~solved_for_envs name encode_value conditional_choice = + let open Encoder in + field_o + name + (encode encode_value) + (of_conditional_choice ~solved_for_envs conditional_choice) + ;; +end + +module Enabled_on_platforms = struct + (* A package's availability on various platforms. Either it's available on + all platforms the lockdir wsa solved for or it's only available on a + subset of these platforms. *) + type t = + | All + | Only of Solver_env_disjunction.t + + let of_solver_env_disjunction ~solved_for_envs solver_env_disjunction = + if Solver_env_disjunction.equal solver_env_disjunction solved_for_envs + then All + else Only solver_env_disjunction + ;; + + let to_solver_env_disjunction ~solved_for_envs = function + | All -> solved_for_envs + | Only solver_envs -> solver_envs + ;; + + let encode t = + let open Encoder in + match t with + | All -> string "all" + | Only solver_envs -> + Dune_lang.List (string "only" :: List.map ~f:Solver_env.encode solver_envs) + ;; + + let decode = + let open Decoder in + sum + [ "all", return All + ; ( "only" + , let+ solver_envs = repeat (enter Solver_env.decode) in + Only solver_envs ) + ] + ;; +end + module Build_command = struct type t = | Action of Action.t @@ -226,15 +350,20 @@ module Build_command = struct let open Decoder in let parse_action = (let+ action = Action.decode_pkg in - Conditional_choice.singleton_all_platforms (Action action)) - <|> repeat (Conditional.decode decode_portable) + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms (Action action))) + <|> Conditional_choice_or_all_platforms.decode decode_portable in fields_mutually_exclusive - ~default:Conditional_choice.empty - [ Fields.build, parse_action + ~default:None + [ ( Fields.build + , let+ action = parse_action in + Some action ) ; ( Fields.dune , let+ () = return () in - Conditional_choice.singleton_all_platforms Dune ) + Some + (Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms Dune)) ) ] ;; end @@ -267,12 +396,6 @@ module Depends = struct let equal = List.equal Depend.equal let remove_locs = List.map ~f:Depend.remove_locs let to_dyn = Dyn.list Depend.to_dyn - - let decode = - let open Decoder in - enter @@ repeat Depend.decode - ;; - let encode t = Dune_lang.List (List.map t ~f:Depend.encode) end @@ -284,9 +407,20 @@ module Pkg = struct ; depexts : string list Conditional_choice.t ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list + ; enabled_on_platforms : Solver_env_disjunction.t } - let equal { build_command; install_command; depends; depexts; info; exported_env } t = + let equal + { build_command + ; install_command + ; depends + ; depexts + ; info + ; exported_env + ; enabled_on_platforms + } + t + = Conditional_choice.equal Build_command.equal build_command t.build_command (* CR-rgrinberg: why do we ignore locations? *) && Conditional_choice.equal Action.equal_no_locs install_command t.install_command @@ -297,9 +431,18 @@ module Pkg = struct (Action.Env_update.equal String_with_vars.equal) exported_env t.exported_env + && Solver_env_disjunction.equal enabled_on_platforms t.enabled_on_platforms ;; - let remove_locs { build_command; install_command; depends; depexts; info; exported_env } + let remove_locs + { build_command + ; install_command + ; depends + ; depexts + ; info + ; exported_env + ; enabled_on_platforms + } = { info = Pkg_info.remove_locs info ; exported_env = @@ -308,10 +451,20 @@ module Pkg = struct ; depexts ; build_command = Conditional_choice.map build_command ~f:Build_command.remove_locs ; install_command = Conditional_choice.map install_command ~f:Action.remove_locs + ; enabled_on_platforms } ;; - let to_dyn { build_command; install_command; depends; depexts; info; exported_env } = + let to_dyn + { build_command + ; install_command + ; depends + ; depexts + ; info + ; exported_env + ; enabled_on_platforms + } + = Dyn.record [ "build_command", Conditional_choice.to_dyn Build_command.to_dyn build_command ; "install_command", Conditional_choice.to_dyn Action.to_dyn install_command @@ -320,6 +473,7 @@ module Pkg = struct ; "info", Pkg_info.to_dyn info ; ( "exported_env" , Dyn.list (Action.Env_update.to_dyn String_with_vars.to_dyn) exported_env ) + ; "enabled_on_platforms", Solver_env_disjunction.to_dyn enabled_on_platforms ] ;; @@ -345,35 +499,43 @@ module Pkg = struct let avoid = "avoid" let exported_env = "exported_env" let extra_sources = "extra_sources" + let enabled_on_platforms = "enabled_on_platforms" end let decode = let open Decoder in let parse_install_command_backwards_compatible = - Conditional_choice.decode_backwards_compatible Action.decode_pkg + (let+ action = Action.decode_pkg in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms action)) + <|> Conditional_choice_or_all_platforms.decode Action.decode_pkg in let parse_depends_backwards_compatible = - repeat Depend.decode - >>| Conditional_choice.singleton_all_platforms - <|> repeat (Conditional.decode Depends.decode) + (let+ depends = repeat Depend.decode in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms depends)) + <|> Conditional_choice_or_all_platforms.decode (enter @@ repeat Depend.decode) in let parse_depexts_backwards_compatible = - repeat string - >>| Conditional_choice.singleton_all_platforms - <|> repeat (Conditional.decode (enter @@ repeat string)) + (let+ depexts = repeat string in + Conditional_choice_or_all_platforms.Choice + (Conditional_choice.singleton_all_platforms depexts)) + <|> Conditional_choice_or_all_platforms.decode (enter @@ repeat string) in + let empty_choice = Conditional_choice_or_all_platforms.Choice [] in enter @@ fields @@ let+ version = field Fields.version Package_version.decode and+ install_command = - field ~default:[] Fields.install parse_install_command_backwards_compatible + field + ~default:empty_choice + Fields.install + parse_install_command_backwards_compatible and+ build_command = Build_command.decode_fields_backwards_compatible and+ depends = - field - ~default:(Conditional_choice.singleton_all_platforms []) - Fields.depends - parse_depends_backwards_compatible - and+ depexts = field ~default:[] Fields.depexts parse_depexts_backwards_compatible + field ~default:empty_choice Fields.depends parse_depends_backwards_compatible + and+ depexts = + field ~default:empty_choice Fields.depexts parse_depexts_backwards_compatible and+ source = field_o Fields.source Source.decode and+ dev = field_b Fields.dev and+ avoid = field_b Fields.avoid @@ -384,8 +546,36 @@ module Pkg = struct Fields.extra_sources ~default:[] (repeat (pair (plain_string Path.Local.parse_string_exn) Source.decode)) + and+ enabled_on_platforms = + field + Fields.enabled_on_platforms + ~default:Enabled_on_platforms.All + Enabled_on_platforms.decode in - fun ~lock_dir name -> + fun ~lock_dir ~solved_for_envs name -> + let install_command = + Conditional_choice_or_all_platforms.to_conditional_choice + ~solved_for_envs + install_command + in + let build_command = + match build_command with + | None -> [] + | Some build_command -> + Conditional_choice_or_all_platforms.to_conditional_choice + ~solved_for_envs + build_command + in + let depends = + Conditional_choice_or_all_platforms.to_conditional_choice + ~solved_for_envs + depends + in + let depexts = + Conditional_choice_or_all_platforms.to_conditional_choice + ~solved_for_envs + depexts + in let info = let make_source f = Path.source lock_dir @@ -399,7 +589,19 @@ module Pkg = struct in { Pkg_info.name; version; dev; avoid; source; extra_sources } in - { build_command; depends; depexts; install_command; info; exported_env } + let enabled_on_platforms = + Enabled_on_platforms.to_solver_env_disjunction + ~solved_for_envs + enabled_on_platforms + in + { build_command + ; depends + ; depexts + ; install_command + ; info + ; exported_env + ; enabled_on_platforms + } ;; let encode_extra_source (local, source) : Dune_sexp.t = @@ -411,25 +613,46 @@ module Pkg = struct let encode ~portable + ~solved_for_envs { build_command ; install_command ; depends ; depexts ; info = { Pkg_info.name = _; extra_sources; version; dev; avoid; source } ; exported_env + ; enabled_on_platforms } = let open Encoder in - let install_command, build_command, depends, depexts = + let install_command, build_command, depends, depexts, enabled_on_platforms = if portable - then - ( Conditional_choice.encode_field Fields.install Action.encode install_command - , Conditional_choice.encode_field - Fields.build - Build_command.encode_portable - build_command - , Conditional_choice.encode_field Fields.depends Depends.encode depends - , Conditional_choice.encode_field Fields.depexts (list string) depexts ) + then ( + let encode_field n v c = + Conditional_choice_or_all_platforms.encode_field ~solved_for_envs n v c + in + ( encode_field Fields.install Action.encode install_command + , encode_field Fields.build Build_command.encode_portable build_command + , (let depends = + match depends with + | [ { Conditional.value = []; _ } ] -> + (* Omit the dependencies field to reduce noise in the case + where there is explictly an empty list of dependencies. *) + [] + | other -> other + in + encode_field Fields.depends Depends.encode depends) + , encode_field Fields.depexts (list string) depexts + , match + Enabled_on_platforms.of_solver_env_disjunction + ~solved_for_envs + enabled_on_platforms + with + | All -> + (* Omit the field if it's enabled everywhere to reduce noise. The + parser will assume [All] by default. *) + [] + | other -> + [ field Fields.enabled_on_platforms Enabled_on_platforms.encode other ] )) else ( field_o Fields.install @@ -447,20 +670,22 @@ module Pkg = struct Fields.depexts string (Conditional_choice.get_value_ensuring_at_most_one_choice depexts - |> Option.value ~default:[]) ) + |> Option.value ~default:[]) + , [] ) in record_fields - [ field Fields.version Package_version.encode version - ; install_command - ; build_command - ; depends - ; depexts - ; field_o Fields.source Source.encode source - ; field_b Fields.dev dev - ; field_b Fields.avoid avoid - ; field_l Fields.exported_env Action.Env_update.encode exported_env - ; field_l Fields.extra_sources encode_extra_source extra_sources - ] + ([ field Fields.version Package_version.encode version + ; install_command + ; build_command + ; depends + ; depexts + ; field_o Fields.source Source.encode source + ; field_b Fields.dev dev + ; field_b Fields.avoid avoid + ; field_l Fields.exported_env Action.Env_update.encode exported_env + ; field_l Fields.extra_sources encode_extra_source extra_sources + ] + @ enabled_on_platforms) ;; let files_dir package_name ~lock_dir = @@ -471,12 +696,45 @@ module Pkg = struct error if the packages differ in any way apart from their platform-specific fields. *) let merge_conditionals a b = - let build_command = Conditional_choice.merge a.build_command b.build_command in - let install_command = Conditional_choice.merge a.install_command b.install_command in - let depends = Conditional_choice.merge a.depends b.depends in - let depexts = Conditional_choice.merge a.depexts b.depexts in - let ret = { a with build_command; install_command; depends; depexts } in - if not (equal ret { b with build_command; install_command; depends; depexts }) + let build_command = + Conditional_choice.merge_combining_conditions + ~value_equal:Build_command.equal + a.build_command + b.build_command + in + let install_command = + Conditional_choice.merge_combining_conditions + ~value_equal:Action.equal + a.install_command + b.install_command + in + let depends = + Conditional_choice.merge_combining_conditions + ~value_equal:Depends.equal + a.depends + b.depends + in + let depexts = + Conditional_choice.merge_combining_conditions + ~value_equal:(List.equal String.equal) + a.depexts + b.depexts + in + let enabled_on_platforms = a.enabled_on_platforms @ b.enabled_on_platforms in + let ret = + { a with build_command; install_command; depends; depexts; enabled_on_platforms } + in + if + not + (equal + ret + { b with + build_command + ; install_command + ; depends + ; depexts + ; enabled_on_platforms + }) then Code_error.raise "Packages differ in a non-platform-specific field" @@ -484,8 +742,12 @@ module Pkg = struct ret ;; - let is_available_under_condition t condition = - Conditional_choice.condition_exists t.depends condition + let is_available_on_platform t ~platform = + (* XXX: currently treat empty lists of platforms as if the platform is + enabled on all platforms to simplify supporting both portable and + non-portable lockdirs with the same code. *) + List.is_empty t.enabled_on_platforms + || Solver_env_disjunction.matches_platform t.enabled_on_platforms ~platform ;; end @@ -541,6 +803,7 @@ type t = ; ocaml : (Loc.t * Package_name.t) option ; repos : Repositories.t ; expanded_solver_variable_bindings : Solver_stats.Expanded_variable_bindings.t + ; solved_for_envs : Solver_env.t list } let remove_locs t = @@ -557,6 +820,7 @@ let equal ; ocaml ; repos ; expanded_solver_variable_bindings + ; solved_for_envs } t = @@ -571,6 +835,7 @@ let equal && Solver_stats.Expanded_variable_bindings.equal expanded_solver_variable_bindings t.expanded_solver_variable_bindings + && List.equal Solver_env.equal solved_for_envs t.solved_for_envs ;; let to_dyn @@ -580,6 +845,7 @@ let to_dyn ; ocaml ; repos ; expanded_solver_variable_bindings + ; solved_for_envs } = Dyn.record @@ -593,6 +859,7 @@ let to_dyn ; "repos", Repositories.to_dyn repos ; ( "expanded_solver_variable_bindings" , Solver_stats.Expanded_variable_bindings.to_dyn expanded_solver_variable_bindings ) + ; "solved_for_envs", Dyn.list Solver_env.to_dyn solved_for_envs ] ;; @@ -631,6 +898,7 @@ let create_latest_version ~ocaml ~repos ~expanded_solver_variable_bindings + ~solved_for_env = (match validate_packages packages with | Ok () -> () @@ -657,12 +925,19 @@ let create_latest_version let complete = Int.equal (List.length repos) (List.length used) in complete, Some used in + let solved_for_env_platform_specific_only = + Option.map + ~f:(fun solved_for_env -> + Solver_env.retain solved_for_env Package_variable_name.platform_specific) + solved_for_env + in { version ; dependency_hash ; packages ; ocaml ; repos = { complete; used } ; expanded_solver_variable_bindings + ; solved_for_envs = Option.to_list solved_for_env_platform_specific_only } ;; @@ -689,6 +964,7 @@ let encode_metadata ; repos ; packages = _ ; expanded_solver_variable_bindings + ; solved_for_envs } = let open Encoder in @@ -714,18 +990,24 @@ let encode_metadata | None -> [] | Some ocaml -> [ list sexp [ string "ocaml"; Package_name.encode (snd ocaml) ] ]) @ [ list sexp (string "repositories" :: Repositories.encode repos) ] + @ (if + portable + || Solver_stats.Expanded_variable_bindings.is_empty + expanded_solver_variable_bindings + then [] + else + [ list + sexp + (string "expanded_solver_variable_bindings" + :: Solver_stats.Expanded_variable_bindings.encode + expanded_solver_variable_bindings) + ]) @ - if - portable - || Solver_stats.Expanded_variable_bindings.is_empty expanded_solver_variable_bindings - then [] - else - [ list - sexp - (string "expanded_solver_variable_bindings" - :: Solver_stats.Expanded_variable_bindings.encode - expanded_solver_variable_bindings) + if portable + then + [ list sexp (string "solved_for_envs" :: List.map ~f:Solver_env.encode solved_for_envs) ] + else [] ;; let decode_metadata = @@ -740,8 +1022,10 @@ let decode_metadata = "expanded_solver_variable_bindings" ~default:Solver_stats.Expanded_variable_bindings.empty Solver_stats.Expanded_variable_bindings.decode + and+ solved_for_envs = + field "solved_for_envs" ~default:[] (repeat (enter Solver_env.decode)) in - ocaml, dependency_hash, repos, expanded_solver_variable_bindings) + ocaml, dependency_hash, repos, expanded_solver_variable_bindings, solved_for_envs) ;; module Package_filename = struct @@ -759,7 +1043,8 @@ let file_contents_by_path ~portable t = (metadata_filename, encode_metadata ~portable t) :: (Package_name.Map.to_list t.packages |> List.map ~f:(fun (name, pkg) -> - Package_filename.of_package_name name, Pkg.encode ~portable pkg)) + ( Package_filename.of_package_name name + , Pkg.encode ~portable ~solved_for_envs:t.solved_for_envs pkg ))) ;; module Write_disk = struct @@ -921,14 +1206,25 @@ module Make_load (Io : sig struct let load_metadata metadata_file_path = let open Io.O in - let+ syntax, version, dependency_hash, ocaml, repos, expanded_solver_variable_bindings + let+ ( syntax + , version + , dependency_hash + , ocaml + , repos + , expanded_solver_variable_bindings + , solved_for_envs ) = Io.with_lexbuf_from_file metadata_file_path ~f:(fun lexbuf -> Metadata.parse_contents lexbuf ~f:(fun { Metadata.Lang.Instance.syntax; data = (); version } -> let open Decoder in - let+ ocaml, dependency_hash, repos, expanded_solver_variable_bindings = + let+ ( ocaml + , dependency_hash + , repos + , expanded_solver_variable_bindings + , solved_for_envs ) + = decode_metadata in ( syntax @@ -936,10 +1232,17 @@ struct , dependency_hash , ocaml , repos - , expanded_solver_variable_bindings ))) + , expanded_solver_variable_bindings + , solved_for_envs ))) in if String.equal (Syntax.name syntax) (Syntax.name Dune_lang.Pkg.syntax) - then version, dependency_hash, ocaml, repos, expanded_solver_variable_bindings + then + ( version + , dependency_hash + , ocaml + , repos + , expanded_solver_variable_bindings + , solved_for_envs ) else User_error.raise [ Pp.textf @@ -950,7 +1253,7 @@ struct ] ;; - let load_pkg ~version ~lock_dir_path package_name = + let load_pkg ~version ~lock_dir_path ~solved_for_envs package_name = let open Io.O in let pkg_file_path = Path.Source.relative lock_dir_path (Package_filename.of_package_name package_name) @@ -968,6 +1271,7 @@ struct in (Decoder.parse parser Univ_map.empty (List (Loc.none, sexp))) ~lock_dir:lock_dir_path + ~solved_for_envs package_name ;; @@ -1041,7 +1345,13 @@ struct match result with | Error e -> Io.return (Error e) | Ok () -> - let* version, dependency_hash, ocaml, repos, expanded_solver_variable_bindings = + let* ( version + , dependency_hash + , ocaml + , repos + , expanded_solver_variable_bindings + , solved_for_envs ) + = load_metadata (Path.Source.relative lock_dir_path metadata_filename) in let+ packages = @@ -1053,7 +1363,7 @@ struct (* TODO *) None) >>= Io.parallel_map ~f:(fun package_name -> - let+ pkg = load_pkg ~version ~lock_dir_path package_name in + let+ pkg = load_pkg ~version ~lock_dir_path ~solved_for_envs package_name in package_name, pkg) >>| Package_name.Map.of_list_exn in @@ -1065,6 +1375,7 @@ struct ; ocaml ; repos ; expanded_solver_variable_bindings + ; solved_for_envs }) ;; @@ -1097,7 +1408,7 @@ module Load_immediate = Make_load (struct let read_disk = Load_immediate.load let read_disk_exn = Load_immediate.load_exn -let transitive_dependency_closure t condition start = +let transitive_dependency_closure t ~platform start = let missing_packages = let all_packages_in_lock_dir = Package_name.Set.of_keys t.packages in Package_name.Set.diff start all_packages_in_lock_dir @@ -1119,16 +1430,8 @@ let transitive_dependency_closure t condition start = diff (of_list_map (let pkg = Package_name.Map.find_exn t.packages node in - match Conditional_choice.find pkg.depends condition with - | Some depends -> depends - | None -> - User_error.raise - [ Pp.textf - "Lockfile does not contain dependencies for %s under the \ - condition" - (Package_name.to_string pkg.info.name) - ; Solver_env.pp condition - ]) + Conditional_choice.choose_for_platform pkg.depends ~platform + |> Option.value ~default:[]) ~f:(fun depend -> depend.name)) seen) in @@ -1165,10 +1468,12 @@ let merge_conditionals a b = (* unreachable *) None) in + let solved_for_envs = a.solved_for_envs @ b.solved_for_envs in let normalize t = { t with packages = Package_name.Map.empty ; expanded_solver_variable_bindings = Solver_stats.Expanded_variable_bindings.empty + ; solved_for_envs = [] } in if not (equal (normalize a) (normalize b)) @@ -1176,10 +1481,10 @@ let merge_conditionals a b = 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 } + { a with packages; solved_for_envs } ;; -let packages_under_condition { packages; _ } condition = +let packages_on_platform { packages; _ } ~platform = Package_name.Map.filter packages ~f:(fun package -> - Pkg.is_available_under_condition package condition) + Pkg.is_available_on_platform package ~platform) ;; diff --git a/src/dune_pkg/lock_dir.mli b/src/dune_pkg/lock_dir.mli index 0e5db67fe3b..b88377a260a 100644 --- a/src/dune_pkg/lock_dir.mli +++ b/src/dune_pkg/lock_dir.mli @@ -43,7 +43,7 @@ module Conditional_choice : sig (** Returns the first value whose associated environment is a subset of the specified environment. *) - val find : 'a t -> Solver_env.t -> 'a option + val choose_for_platform : 'a t -> platform:Solver_env.t -> 'a option end module Pkg : sig @@ -54,11 +54,16 @@ module Pkg : sig ; depexts : string list Conditional_choice.t ; info : Pkg_info.t ; exported_env : String_with_vars.t Action.Env_update.t list + ; enabled_on_platforms : Solver_env.t list } val remove_locs : t -> t val equal : t -> t -> bool - val decode : (lock_dir:Path.Source.t -> Package_name.t -> t) Decoder.t + + val decode + : (lock_dir:Path.Source.t -> solved_for_envs:Solver_env.t list -> Package_name.t -> t) + Decoder.t + val files_dir : Package_name.t -> lock_dir:Path.Source.t -> Path.Source.t end @@ -83,6 +88,7 @@ type t = private (** Stores the solver variables that were evaluated while solving dependencies. Can be used to determine if a lockdir is compatible with a particular system. *) + ; solved_for_envs : Solver_env.t list } val remove_locs : t -> t @@ -100,6 +106,8 @@ val create_latest_version -> ocaml:(Loc.t * Package_name.t) option -> repos:Opam_repo.t list option -> expanded_solver_variable_bindings:Solver_stats.Expanded_variable_bindings.t + -> solved_for_env:Solver_env.t option + (* TODO: make this non-optional when portable lockdirs becomes the default *) -> t val default_path : Path.Source.t @@ -141,14 +149,15 @@ module Make_load (Io : sig val load_exn : Path.Source.t -> t Io.t end -(** [transitive_dependency_closure t names] returns the set of package names +(** [transitive_dependency_closure t ~platform names] returns the set of package names making up the transitive closure of dependencies of the set [names], or [Error (`Missing_packages missing_packages)] if if any element of [names] is not found in the lockdir. [missing_packages] is a subset of [names] - not present in the lockdir. *) + not present in the lockdir. As a package's dependencies may vary between + platforms, a description of the current platform must also be provided. *) val transitive_dependency_closure : t - -> Solver_env.t + -> platform:Solver_env.t -> Package_name.Set.t -> (Package_name.Set.t, [ `Missing_packages of Package_name.Set.t ]) result @@ -160,4 +169,4 @@ val compute_missing_checksums : t -> pinned_packages:Package_name.Set.t -> t Fib error if the lockdirs differ in a non-platform-specific way. *) val merge_conditionals : t -> t -> t -val packages_under_condition : t -> Solver_env.t -> Pkg.t Package_name.Map.t +val packages_on_platform : t -> platform:Solver_env.t -> Pkg.t Package_name.Map.t diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index 83885d8d940..77f9d74e383 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -13,6 +13,25 @@ let add_self_to_filter_env package env variable = else env variable ;; +let sentinel_value_of_variable_name variable_name = + Package_variable_name.to_string variable_name + |> String.uppercase + |> String.split_on_char ~sep:'-' + |> String.concat ~sep:"_" + |> String.cat "__" + |> Variable_value.string +;; + +let add_sentinel_values_to_solver_env solver_env = + Package_variable_name.Set.fold + Package_variable_name.platform_specific + ~init:solver_env + ~f:(fun name acc -> + if Solver_env.contains acc name + then acc + else Solver_env.set acc name (sentinel_value_of_variable_name name)) +;; + module Priority = struct (* A priority defines a package's position in the list of candidates fed to the solver. Any change to package selection should be reflected in @@ -144,6 +163,7 @@ module Context = struct packages pkg (Lazy.force pkg.conflicts)); acc) in + let solver_env = add_sentinel_values_to_solver_env solver_env in { repos ; version_preference ; local_packages @@ -1922,9 +1942,18 @@ let opam_package_to_lock_file_pkg in let kind = if opam_file_is_compiler opam_file then `Compiler else `Non_compiler in let depends = Lock_dir.Conditional_choice.singleton solver_env depends in + let enabled_on_platforms = + [ Solver_env.retain solver_env Package_variable_name.platform_specific ] + in ( kind - , { Lock_dir.Pkg.build_command; install_command; depends; depexts; info; exported_env } - ) + , { Lock_dir.Pkg.build_command + ; install_command + ; depends + ; depexts + ; info + ; exported_env + ; enabled_on_platforms + } ) ;; let solve_package_list packages ~context = @@ -2036,7 +2065,9 @@ let reject_unreachable_packages = [ "name", Package_name.to_dyn name ] | Some (pkg : Lock_dir.Pkg.t), None -> Some - (Lock_dir.Conditional_choice.find pkg.depends solver_env + (Lock_dir.Conditional_choice.choose_for_platform + pkg.depends + ~platform:solver_env |> Option.value ~default:[] |> List.map ~f:(fun (depend : Lock_dir.Depend.t) -> depend.name)) | None, Some (pkg : Local_package.For_solver.t) -> @@ -2218,7 +2249,9 @@ let solve_lock_dir pkgs_by_name ~f:(fun { Lock_dir.Pkg.depends; info = { name; _ }; _ } -> Option.iter - (Lock_dir.Conditional_choice.find depends solver_env) + (Lock_dir.Conditional_choice.choose_for_platform + depends + ~platform:solver_env) ~f: (List.iter ~f:(fun (depend : Lock_dir.Depend.t) -> if Package_name.Map.mem local_packages depend.name @@ -2250,6 +2283,7 @@ let solve_lock_dir ~ocaml ~repos:(Some repos) ~expanded_solver_variable_bindings + ~solved_for_env:(Some solver_env) in let+ files = let resolved_packages = diff --git a/src/dune_pkg/package_universe.ml b/src/dune_pkg/package_universe.ml index 7bdfc8d6cb8..9f7d4142587 100644 --- a/src/dune_pkg/package_universe.ml +++ b/src/dune_pkg/package_universe.ml @@ -94,7 +94,7 @@ let check_for_unnecessary_packges_in_lock_dir match Lock_dir.transitive_dependency_closure lock_dir - solver_env + ~platform:solver_env all_non_local_dependencies_of_local_packages with | Ok x -> x @@ -275,7 +275,7 @@ let transitive_dependency_closure_without_test t start = match Lock_dir.transitive_dependency_closure t.lock_dir - t.solver_env + ~platform:t.solver_env Package_name.Set.( union non_local_immediate_dependencies_of_local_transitive_dependency_closure diff --git a/src/dune_pkg/solver_env.ml b/src/dune_pkg/solver_env.ml index 9df3f6738d8..49c5fee01ad 100644 --- a/src/dune_pkg/solver_env.ml +++ b/src/dune_pkg/solver_env.ml @@ -62,6 +62,7 @@ let set t variable_name variable_value = let get = Package_variable_name.Map.find let extend a b = Package_variable_name.Map.superpose b a +let contains = Package_variable_name.Map.mem let with_defaults = [ ( Package_variable_name.opam_version @@ -109,7 +110,7 @@ let to_env t variable = ;; let popular_platform_envs = - let make ~os ~arch ~os_distribution = + let make ~os ~arch ~os_distribution ~os_family = let env = empty in let env = set env Package_variable_name.os (Variable_value.string os) in let env = set env Package_variable_name.arch (Variable_value.string arch) in @@ -122,17 +123,29 @@ let popular_platform_envs = (Variable_value.string os_distribution) | None -> env in + let env = + match os_family with + | Some os_family -> + set env Package_variable_name.os_family (Variable_value.string os_family) + | None -> env + in env in List.concat_map (* Include distros with special cases in popular packages (such as the ocaml compiler). *) - [ "linux", [ "alpine" ]; "macos", []; "win32", [ "cygwin" ] ] - ~f:(fun (os, distros) -> - List.concat_map [ "x86_64"; "arm64" ] ~f:(fun arch -> - let distros = + [ "linux", [ "alpine", "alpine"; "ubuntu", "debian" ] + ; "macos", [ "homebrew", "homebrew" ] + ; "win32", [ "cygwin", "windows" ] + ] + ~f:(fun (os, distros_and_families) -> + List.concat_map [ "arm64"; "x86_64" ] ~f:(fun arch -> + let distros_and_families = (* Put the [None] case at the end of the list so that cases with distros are tried first. *) - List.map distros ~f:Option.some @ [ None ] + List.map distros_and_families ~f:(fun (distro, family) -> + Some distro, Some family) + @ [ None, None ] in - List.map distros ~f:(fun os_distribution -> make ~os ~arch ~os_distribution))) + List.map distros_and_families ~f:(fun (os_distribution, os_family) -> + make ~os ~arch ~os_distribution ~os_family))) ;; diff --git a/src/dune_pkg/solver_env.mli b/src/dune_pkg/solver_env.mli index 13443c6e93a..7d4bb7e6080 100644 --- a/src/dune_pkg/solver_env.mli +++ b/src/dune_pkg/solver_env.mli @@ -4,6 +4,7 @@ type t val empty : t val equal : t -> t -> bool +val compare : t -> t -> ordering val to_dyn : t -> Dyn.t val is_empty : t -> bool @@ -17,6 +18,7 @@ val encode : t Encoder.t val decode : t Decoder.t val set : t -> Package_variable_name.t -> Variable_value.t -> t val get : t -> Package_variable_name.t -> Variable_value.t option +val contains : t -> Package_variable_name.t -> bool (** [extend a b] adds all variables from [b] to [a] overwriting any existing values of those variables in [a]. *) diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index 5e5f7b5c306..3b3b41f2dc4 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -1065,7 +1065,7 @@ module DB = struct let+ all = Package_universe.lock_dir package_universe and+ solver_env = Lock_dir.Sys_vars.solver_env () in let all_available_packages = - Dune_pkg.Lock_dir.packages_under_condition all solver_env + Dune_pkg.Lock_dir.packages_on_platform all ~platform:solver_env in { all = all_available_packages; system_provided = dune } ;; @@ -1110,19 +1110,15 @@ end = struct ; info ; exported_env ; depexts + ; enabled_on_platforms = _ } as pkg) -> assert (Package.Name.equal name info.name); let* solver_env = Lock_dir.Sys_vars.solver_env () in let depends = - match Dune_pkg.Lock_dir.Conditional_choice.find depends solver_env with - | Some depends -> depends - | None -> - User_error.raise - [ Pp.textf - "Lockfile does not contain dependencies for %s under the condition" - (Dune_pkg.Package_name.to_string pkg.info.name) - ; Dune_pkg.Solver_env.pp solver_env - ] + Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform + depends + ~platform:solver_env + |> Option.value ~default:[] in let* depends = Memo.parallel_map depends ~f:(fun depend -> @@ -1142,10 +1138,14 @@ end = struct let id = Pkg.Id.gen () in let write_paths = Paths.make package_universe name ~relative:Path.Build.relative in let install_command = - Dune_pkg.Lock_dir.Conditional_choice.find install_command solver_env + Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform + install_command + ~platform:solver_env in let build_command = - Dune_pkg.Lock_dir.Conditional_choice.find build_command solver_env + Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform + build_command + ~platform:solver_env in let* paths, build_command, install_command = let paths = Paths.map_path write_paths ~f:Path.build in @@ -1192,7 +1192,9 @@ end = struct , install_command ) in let depexts = - Dune_pkg.Lock_dir.Conditional_choice.find depexts solver_env + Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform + depexts + ~platform:solver_env |> Option.value ~default:[] in let t = diff --git a/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t index 6d7f5a91401..2745c0151a9 100644 --- a/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t +++ b/test/blackbox-tests/test-cases/pkg/portable-lockdirs.t @@ -39,122 +39,85 @@ A package that writes some info about machine where it's built to the share dire (version 0.0.1) (build - (((arch x86_64) - (os linux) - (os-distribution alpine)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Linux > %{share}/kernel") - (run sh -c "echo x86_64 > %{share}/machine"))))) - (((arch x86_64) - (os linux)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Linux > %{share}/kernel") - (run sh -c "echo x86_64 > %{share}/machine"))))) - (((arch arm64) - (os linux) - (os-distribution alpine)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Linux > %{share}/kernel") - (run sh -c "echo arm64 > %{share}/machine"))))) - (((arch arm64) - (os linux)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Linux > %{share}/kernel") - (run sh -c "echo arm64 > %{share}/machine"))))) - (((arch x86_64) - (os macos)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Darwin > %{share}/kernel") - (run sh -c "echo x86_64 > %{share}/machine"))))) - (((arch arm64) - (os macos)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo Darwin > %{share}/kernel") - (run sh -c "echo arm64 > %{share}/machine"))))) - (((arch x86_64) - (os win32) - (os-distribution cygwin)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo x86_64 > %{share}/machine"))))) - (((arch x86_64) - (os win32)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo x86_64 > %{share}/machine"))))) - (((arch arm64) - (os win32) - (os-distribution cygwin)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo arm64 > %{share}/machine"))))) - (((arch arm64) - (os win32)) - ((action - (progn - (run mkdir -p %{share} %{lib}/%{pkg-self:name}) - (run touch %{lib}/%{pkg-self:name}/META) - (run sh -c "echo arm64 > %{share}/machine")))))) - - (depends - (((arch x86_64) - (os linux) - (os-distribution alpine)) - ()) - (((arch x86_64) - (os linux)) - ()) - (((arch arm64) - (os linux) - (os-distribution alpine)) - ()) - (((arch arm64) - (os linux)) - ()) - (((arch x86_64) - (os macos)) - ()) - (((arch arm64) - (os macos)) - ()) - (((arch x86_64) - (os win32) - (os-distribution cygwin)) - ()) - (((arch x86_64) - (os win32)) - ()) - (((arch arm64) - (os win32) - (os-distribution cygwin)) - ()) - (((arch arm64) - (os win32)) - ())) + (choice + ((((arch arm64) + (os linux) + (os-distribution alpine) + (os-family alpine)) + ((arch arm64) + (os linux) + (os-distribution ubuntu) + (os-family debian)) + ((arch arm64) + (os linux))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + ((((arch x86_64) + (os linux) + (os-distribution alpine) + (os-family alpine)) + ((arch x86_64) + (os linux) + (os-distribution ubuntu) + (os-family debian)) + ((arch x86_64) + (os linux))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Linux > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + ((((arch arm64) + (os macos) + (os-distribution homebrew) + (os-family homebrew)) + ((arch arm64) + (os macos))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo arm64 > %{share}/machine"))))) + ((((arch x86_64) + (os macos) + (os-distribution homebrew) + (os-family homebrew)) + ((arch x86_64) + (os macos))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo Darwin > %{share}/kernel") + (run sh -c "echo x86_64 > %{share}/machine"))))) + ((((arch arm64) + (os win32) + (os-distribution cygwin) + (os-family windows)) + ((arch arm64) + (os win32))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo arm64 > %{share}/machine"))))) + ((((arch x86_64) + (os win32) + (os-distribution cygwin) + (os-family windows)) + ((arch x86_64) + (os win32))) + ((action + (progn + (run mkdir -p %{share} %{lib}/%{pkg-self:name}) + (run touch %{lib}/%{pkg-self:name}/META) + (run sh -c "echo x86_64 > %{share}/machine"))))))) $ dune build diff --git a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml index 52d6bd81e68..f6dab43104f 100644 --- a/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml +++ b/test/expect-tests/dune_pkg/dune_pkg_unit_tests.ml @@ -86,7 +86,9 @@ let lock_dir_encode_decode_round_trip_test ?commit ~lock_dir_path ~lock_dir () = in if Lock_dir.equal lock_dir_round_tripped' lock_dir' then print_endline "lockdir matches after roundtrip:" - else print_endline "lockdir doesn't match after roundtrip:"; + else ( + print_endline "lockdir doesn't match after roundtrip:"; + print_endline (Lock_dir.to_dyn lock_dir |> Dyn.to_string)); let dyn_lock_dir = Lock_dir.to_dyn lock_dir_round_tripped in let dyn_lock_dir = match commit with @@ -113,7 +115,8 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = ~local_packages:[] ~ocaml:None ~repos:None - ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty) + ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty + ~solved_for_env:None) (); [%expect {| @@ -125,6 +128,7 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = ; repos = { complete = true; used = None } ; expanded_solver_variable_bindings = { variable_values = []; unset_variables = [] } + ; solved_for_envs = [] } |}] ;; @@ -132,7 +136,7 @@ let%expect_test "encode/decode round trip test for lockdir with no deps" = let empty_package name ~version = { Lock_dir.Pkg.build_command = Lock_dir.Conditional_choice.empty ; install_command = Lock_dir.Conditional_choice.empty - ; depends = Lock_dir.Conditional_choice.singleton_all_platforms [] + ; depends = Lock_dir.Conditional_choice.empty ; depexts = Lock_dir.Conditional_choice.empty ; info = { Lock_dir.Pkg_info.name @@ -143,6 +147,7 @@ let empty_package name ~version = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } ;; @@ -163,6 +168,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = [ Package_variable_name.os, Variable_value.string "linux" ] ; unset_variables = [ Package_variable_name.os_family ] } + ~solved_for_env:None (Package_name.Map.of_list_exn [ mk_pkg_basic ~name:"foo" ~version:(Package_version.of_string "0.1.0") ; mk_pkg_basic ~name:"bar" ~version:(Package_version.of_string "0.2.0") @@ -178,7 +184,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = { "bar" : { build_command = [] ; install_command = [] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "bar" @@ -189,11 +195,12 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } ; "foo" : { build_command = [] ; install_command = [] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "foo" @@ -204,6 +211,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } } ; ocaml = Some ("simple_lock_dir/lock.dune:3", "ocaml") @@ -212,6 +220,7 @@ let%expect_test "encode/decode round trip test for lockdir with simple deps" = { variable_values = [ ("os", "linux") ] ; unset_variables = [ "os-family" ] } + ; solved_for_envs = [] } |}] ;; @@ -314,6 +323,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml")) ~repos:(Some [ opam_repo ]) ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty + ~solved_for_env:None (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ]) in lock_dir_encode_decode_round_trip_test ~lock_dir_path:"complex_lock_dir" ~lock_dir (); @@ -326,14 +336,16 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = map { "a" : { build_command = - [ { condition = map {} + [ { condition = [ map {} ] ; value = Action [ "progn"; [ "echo"; "hello" ] ] } ] ; install_command = - [ { condition = map {}; value = [ "system"; "echo 'world'" ] } + [ { condition = [ map {} ] + ; value = [ "system"; "echo 'world'" ] + } ] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "a" @@ -347,12 +359,13 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ] } ; exported_env = [ { op = "="; var = "foo"; value = "bar" } ] + ; enabled_on_platforms = [] } ; "b" : { build_command = [] ; install_command = [] ; depends = - [ { condition = map {} + [ { condition = [ map {} ] ; value = [ { loc = "complex_lock_dir/b.pkg:3"; name = "a" } ] } @@ -373,12 +386,13 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } ; "c" : { build_command = [] ; install_command = [] ; depends = - [ { condition = map {} + [ { condition = [ map {} ] ; value = [ { loc = "complex_lock_dir/c.pkg:3"; name = "a" } ; { loc = "complex_lock_dir/c.pkg:3"; name = "b" } @@ -396,6 +410,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } } ; ocaml = Some ("complex_lock_dir/lock.dune:3", "ocaml") @@ -405,6 +420,7 @@ let%expect_test "encode/decode round trip test for lockdir with complex deps" = } ; expanded_solver_variable_bindings = { variable_values = []; unset_variables = [] } + ; solved_for_envs = [] } |}] ;; @@ -439,6 +455,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ~ocaml:(Some (Loc.none, Package_name.of_string "ocaml")) ~repos:(Some [ opam_repo ]) ~expanded_solver_variable_bindings:Expanded_variable_bindings.empty + ~solved_for_env:None (Package_name.Map.of_list_exn [ pkg_a; pkg_b; pkg_c ]) in lock_dir_encode_decode_round_trip_test @@ -456,7 +473,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = { "a" : { build_command = [] ; install_command = [] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "a" @@ -467,11 +484,12 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } ; "b" : { build_command = [] ; install_command = [] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "b" @@ -482,11 +500,12 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } ; "c" : { build_command = [] ; install_command = [] - ; depends = [ { condition = map {}; value = [] } ] + ; depends = [] ; depexts = [] ; info = { name = "c" @@ -497,6 +516,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = ; extra_sources = [] } ; exported_env = [] + ; enabled_on_platforms = [] } } ; ocaml = Some ("complex_lock_dir/lock.dune:3", "ocaml") @@ -510,6 +530,7 @@ let%expect_test "encode/decode round trip test with locked repo revision" = } ; expanded_solver_variable_bindings = { variable_values = []; unset_variables = [] } + ; solved_for_envs = [] } |}] ;;