Experimental portable lockdirs

bin/describe/describe_depexts.ml

@@ -22,13 +22,22 @@ 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.choose_for_platform pkg.depexts ~platform:solver_env
+        with
+        | Some depexts -> depexts
+        | None -> []))
   in
   Console.print [ Pp.concat_map ~sep:Pp.newline ~f:Pp.verbatim depexts ]
 ;;

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"

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 =

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 *)

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

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)
 

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

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 ]
+;;

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