Memoize solver env

src/dune_rules/lock_dir.ml

@@ -76,24 +76,22 @@ module Sys_vars = struct
            ])
   ;;
 
-  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
-      ; V.sys_ocaml_version, sys_ocaml_version
-      ]
+  let solver_env =
+    Memo.Lazy.create ~name:"solver-env" (fun () ->
+      let open Memo.O in
+      List.combine
+        Package_variable_name.
+          [ os; os_version; os_distribution; os_family; arch; sys_ocaml_version ]
+        (let { os; os_version; os_distribution; os_family; arch; sys_ocaml_version } =
+           poll
+         in
+         [ os; os_version; os_distribution; os_family; arch; sys_ocaml_version ])
       |> 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)
+        Memo.Lazy.force value
+        >>| Option.map ~f:(fun value -> var, Variable_value.string value))
+      >>| List.fold_left ~init:Solver_env.empty ~f:(fun acc (var, value) ->
+        Solver_env.set acc var value))
+    |> Memo.Lazy.force
   ;;
 end
 

src/dune_rules/lock_dir.mli

@@ -44,7 +44,7 @@ module Sys_vars : sig
 
   val os : t -> Dune_lang.Pform.Var.Os.t -> string option Memo.t
   val poll : t
-  val solver_env : unit -> Dune_pkg.Solver_env.t Memo.t
+  val solver_env : Dune_pkg.Solver_env.t Memo.t
 end
 
 val source_kind

src/dune_rules/pkg_rules.ml

@@ -1322,7 +1322,7 @@ module DB = struct
 
     let all_existing_dev_tools =
       Memo.lazy_ (fun () ->
-        let* platform = Lock_dir.Sys_vars.solver_env () in
+        let* platform = Lock_dir.Sys_vars.solver_env in
         let+ xs =
           Memo.List.map
             Pkg_dev_tool.all
@@ -1386,7 +1386,7 @@ module DB = struct
              let system_provided = default_system_provided in
              let+ pkg_digest_table =
                let* lock_dir = Lock_dir.get_exn ctx
-               and* platform = Lock_dir.Sys_vars.solver_env () in
+               and* platform = Lock_dir.Sys_vars.solver_env in
                (if allow_sharing
                 then Memo.Lazy.force Pkg_table.all_existing_dev_tools
                 else Memo.return Pkg_table.empty)
@@ -1402,7 +1402,7 @@ module DB = struct
      within that context. *)
   let of_project_pkg ctx pkg_name =
     let* lock_dir = Lock_dir.get_exn ctx
-    and* platform = Lock_dir.Sys_vars.solver_env () in
+    and* platform = Lock_dir.Sys_vars.solver_env in
     let+ t = of_ctx ctx ~allow_sharing:true in
     t, pkg_digest_of_name lock_dir platform pkg_name ~system_provided:t.system_provided
   ;;
@@ -1412,7 +1412,7 @@ module DB = struct
   let of_dev_tool dev_tool =
     let system_provided = default_system_provided in
     let* lock_dir = Lock_dir.of_dev_tool dev_tool
-    and* platform = Lock_dir.Sys_vars.solver_env ()
+    and* platform = Lock_dir.Sys_vars.solver_env
     and* lock_dir_active_for_default_ctx =
       Lock_dir.lock_dir_active Context_name.default
     in
@@ -1493,7 +1493,7 @@ end = struct
         ; pkg_digest = _
         } ->
       assert (Package.Name.equal pkg_digest.name info.name);
-      let* platform = Lock_dir.Sys_vars.solver_env () in
+      let* platform = Lock_dir.Sys_vars.solver_env in
       let choose_for_current_platform field =
         Dune_pkg.Lock_dir.Conditional_choice.choose_for_platform field ~platform
       in