refactor: add a bunch of memo stacktraces (#11023)

To improve error message for cycles

Signed-off-by: Rudi Grinberg <[email protected]>

src/dune_rules/context.ml

@@ -400,10 +400,15 @@ let create (builder : Builder.t) ~(kind : Kind.t) =
     | Default | Opam _ -> builder
     | Lock _ ->
       let env =
-        Memo.lazy_ (fun () ->
-          let+ current_env = builder.env
-          and+ pkg_env = Pkg_rules.exported_env builder.name in
-          Env_path.extend_env_concat_path current_env pkg_env)
+        Memo.lazy_
+          ~human_readable_description:(fun () ->
+            Pp.textf
+              "base environment for context %S"
+              (Context_name.to_string builder.name))
+          (fun () ->
+            let+ current_env = builder.env
+            and+ pkg_env = Pkg_rules.exported_env builder.name in
+            Env_path.extend_env_concat_path current_env pkg_env)
         |> Memo.Lazy.force
       in
       { builder with env }
@@ -414,54 +419,73 @@ let create (builder : Builder.t) ~(kind : Kind.t) =
     | Lock _ ->
       let which = Staged.unstage @@ Pkg_rules.which builder.name in
       fun prog ->
-        which prog
-        >>= (function
-         | Some p -> Memo.return (Some p)
-         | None -> Which.which ~path:builder.path prog)
+        Memo.push_stack_frame
+          ~human_readable_description:(fun () ->
+            Pp.textf
+              "looking up binary %S in context %S"
+              prog
+              (Context_name.to_string builder.name))
+          (fun () ->
+            which prog
+            >>= function
+            | Some p -> Memo.return (Some p)
+            | None -> Which.which ~path:builder.path prog)
   in
   let ocamlpath =
-    Memo.lazy_ (fun () ->
-      match kind with
-      | Lock _ -> Pkg_rules.ocamlpath builder.name
-      | Default | Opam _ ->
-        let+ ocamlpath = builder.env >>| Findlib_config.ocamlpath_of_env in
-        Kind.ocamlpath kind ~ocamlpath ~findlib_toolchain:builder.findlib_toolchain)
+    Memo.lazy_
+      ~human_readable_description:(fun () ->
+        Pp.textf "loading OCAMLPATH for context %S" (Context_name.to_string builder.name))
+      (fun () ->
+        match kind with
+        | Lock _ -> Pkg_rules.ocamlpath builder.name
+        | Default | Opam _ ->
+          let+ ocamlpath = builder.env >>| Findlib_config.ocamlpath_of_env in
+          Kind.ocamlpath kind ~ocamlpath ~findlib_toolchain:builder.findlib_toolchain)
   in
   let findlib =
-    Memo.lazy_ (fun () ->
-      let ocamlpath = Memo.Lazy.force ocamlpath in
-      let* env = builder.env in
-      let findlib_toolchain =
-        Option.map builder.findlib_toolchain ~f:Context_name.to_string
-      in
-      Findlib_config.discover_from_env ~env ~which ~ocamlpath ~findlib_toolchain)
+    Memo.lazy_
+      ~human_readable_description:(fun () ->
+        Pp.textf "loading findlib for context %S" (Context_name.to_string builder.name))
+      (fun () ->
+        let ocamlpath = Memo.Lazy.force ocamlpath in
+        let* env = builder.env in
+        let findlib_toolchain =
+          Option.map builder.findlib_toolchain ~f:Context_name.to_string
+        in
+        Findlib_config.discover_from_env ~env ~which ~ocamlpath ~findlib_toolchain)
   in
   let ocaml_and_build_env_kind =
-    Memo.Lazy.create ~name:"ocaml_and_build_env_kind" (fun () ->
-      let+ ocaml, env =
-        let* findlib = Memo.Lazy.force findlib
-        and* env = builder.env in
-        let toolchain kind =
-          let+ toolchain =
-            Ocaml_toolchain.of_env_with_findlib builder.name env findlib ~which
+    Memo.Lazy.create
+      ~name:"ocaml_and_build_env_kind"
+      ~human_readable_description:(fun () ->
+        Pp.textf
+          "loading the OCaml compiler for context %S"
+          (Context_name.to_string builder.name))
+      (fun () ->
+        let+ ocaml, env =
+          let* findlib = Memo.Lazy.force findlib
+          and* env = builder.env in
+          let toolchain kind =
+            let+ toolchain =
+              Ocaml_toolchain.of_env_with_findlib builder.name env findlib ~which
+            in
+            toolchain, kind
           in
-          toolchain, kind
+          match kind with
+          | Default -> toolchain `Default
+          | Opam _ -> toolchain `Opam
+          | Lock _ ->
+            Pkg_rules.ocaml_toolchain builder.name
+            >>= (function
+             | None -> toolchain `Lock
+             | Some toolchain ->
+               let+ toolchain, _ = Action_builder.evaluate_and_collect_facts toolchain in
+               toolchain, `Default)
         in
-        match kind with
-        | Default -> toolchain `Default
-        | Opam _ -> toolchain `Opam
-        | Lock _ ->
-          Pkg_rules.ocaml_toolchain builder.name
-          >>= (function
-           | None -> toolchain `Lock
-           | Some toolchain ->
-             let+ toolchain, _ = Action_builder.evaluate_and_collect_facts toolchain in
-             toolchain, `Default)
-      in
-      Ocaml_toolchain.register_response_file_support ocaml;
-      if Option.is_some builder.fdo_target_exe
-      then Ocaml_toolchain.check_fdo_support ocaml builder.name;
-      ocaml, env)
+        Ocaml_toolchain.register_response_file_support ocaml;
+        if Option.is_some builder.fdo_target_exe
+        then Ocaml_toolchain.check_fdo_support ocaml builder.name;
+        ocaml, env)
   in
   let default_ocamlpath =
     Memo.Lazy.create ~name:"default_ocamlpath" ~cutoff:(List.equal Path.equal) (fun () ->
@@ -481,10 +505,15 @@ let create (builder : Builder.t) ~(kind : Kind.t) =
   in
   let builder =
     let installed_env =
-      Memo.lazy_ (fun () ->
-        let* findlib = Memo.Lazy.force findlib in
-        let+ env = builder.env in
-        make_installed_env env builder.name findlib builder.env_nodes builder.profile)
+      Memo.lazy_
+        ~human_readable_description:(fun () ->
+          Pp.textf
+            "creating installed environment for %S"
+            (Context_name.to_string builder.name))
+        (fun () ->
+          let* findlib = Memo.Lazy.force findlib in
+          let+ env = builder.env in
+          make_installed_env env builder.name findlib builder.env_nodes builder.profile)
     in
     { builder with env = Memo.Lazy.force installed_env }
   in

src/dune_rules/pkg_rules.ml

@@ -1143,7 +1143,12 @@ module Action_expander = struct
 
   let expander context (pkg : Pkg.t) =
     let+ { Artifacts_and_deps.binaries; dep_info } =
-      Pkg.deps_closure pkg |> Artifacts_and_deps.of_closure
+      Memo.push_stack_frame
+        ~human_readable_description:(fun () ->
+          Pp.textf
+            "Computing closure for package %S"
+            (Package.Name.to_string pkg.info.name))
+        (fun () -> Pkg.deps_closure pkg |> Artifacts_and_deps.of_closure)
     in
     let env = Pkg.exported_value_env pkg in
     let depends =
@@ -2011,6 +2016,11 @@ let resolve_pkg_project context pkg =
 ;;
 
 let ocaml_toolchain context =
+  Memo.push_stack_frame ~human_readable_description:(fun () ->
+    Pp.textf
+      "Loading OCaml toolchain from Lock directory for context %S"
+      (Context_name.to_string context))
+  @@ fun () ->
   (let* lock_dir = Lock_dir.get_exn context in
    match lock_dir.ocaml with
    | None -> Memo.return `System_provided
@@ -2048,11 +2058,16 @@ let all_packages context =
 
 let which context =
   let artifacts_and_deps =
-    Memo.lazy_ (fun () ->
-      let+ { binaries; dep_info = _ } =
-        all_packages context >>= Action_expander.Artifacts_and_deps.of_closure
-      in
-      binaries)
+    Memo.lazy_
+      ~human_readable_description:(fun () ->
+        Pp.textf
+          "Loading all binaries in the lock directory for %S"
+          (Context_name.to_string context))
+      (fun () ->
+        let+ { binaries; dep_info = _ } =
+          all_packages context >>= Action_expander.Artifacts_and_deps.of_closure
+        in
+        binaries)
   in
   Staged.stage (fun program ->
     let+ artifacts = Memo.Lazy.force artifacts_and_deps in
@@ -2073,6 +2088,9 @@ let lock_dir_active = Lock_dir.lock_dir_active
 let lock_dir_path = Lock_dir.get_path
 
 let exported_env context =
+  Memo.push_stack_frame ~human_readable_description:(fun () ->
+    Pp.textf "lock directory environment for context %S" (Context_name.to_string context))
+  @@ fun () ->
   let+ all_packages = all_packages context in
   let env = Pkg.build_env_of_deps all_packages in
   let vars = Env.Map.map env ~f:Value_list_env.string_of_env_values in

test/blackbox-tests/test-cases/pkg/ocaml-syntax-gh10839.t

@@ -34,6 +34,11 @@ Dune file in OCaml syntax and a files directory should work
   Error: Dependency cycle between:
      - evaluating dune file "dune" in OCaml syntax
   -> _build/_private/default/.pkg/ocamlfind/target/cookie
+  -> Computing closure for package "base-bytes"
   -> - package base-bytes
+  -> lock directory environment for context "default"
+  -> base environment for context "default"
+  -> loading findlib for context "default"
+  -> loading the OCaml compiler for context "default"
   -> - evaluating dune file "dune" in OCaml syntax
   [1]

test/blackbox-tests/test-cases/pkg/toolchain-installation.t

@@ -83,6 +83,7 @@ but the fake compiler will end up installed as a toolchain package.
   '$TESTCASE_ROOT/fake-cache/dune/toolchains/ocaml-base-compiler.1-HASH/target/bin/ocamlc
   -config':
   Unrecognized line: "Hello from fake ocamlc!"
+  -> required by loading the OCaml compiler for context "default"
 
 Enumerate the contents of the fake toolchains directory:
   $ find fake-cache/dune/toolchains | sort | remove_hash