Add support for eager watch mode for dune exec

[gridbugs]

This is the second attempt at adding this feature. The problem with the first attempt was that replacing the call to Scheduler.go with Scheduler.go_with_rpc_server_and_console_status_reporting caused occasional non-deterministic seg faults on macos. There's some info about the problem on the PR which reverts the previous attempt at adding this feature: #6867. At the time of writing we don't know the cause of this problem.

The difference this time around is that we maintain the call to Scheduler.go when running dune exec not in watch mode, and only invoke Scheduler.go_with_rpc_server_and_console_status_reporting when running in watch mode. There is some additional refactoring done to make this split more ergonomic. We may see seg faults on macos when running exec in watch mode but at least we won't introduce the potential for seg faults into the existing use case of running exec not in watch mode (assuming of course that there is a causal link between go_with_rpc_server_and_console_status_reporting and the seg fault on macos, which is not necessarily the case).

Signed-off-by: Stephen Sherratt stephen@sherra.tt

[gridbugs]

The original version of this change is this PR: #6507, and the PR where it is reverted is:#6867. The only difference between that change and this one is in bin/exec.ml. Here is the diff produced by running git diff gridbugs/exec-watch:bin/exec.ml gridbugs/exec-watch-2:bin/exec.ml:

diff --git a/bin/exec.ml b/bin/exec.ml
index a0b3df2af..4408b9558 100644
--- a/bin/exec.ml
+++ b/bin/exec.ml
@@ -179,6 +179,71 @@ let get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog =
     | Some prog -> Memo.return prog
     | None -> not_found ~dir ~prog)
 
+module Exec_context = struct
+  type t =
+    { common : Common.t
+    ; config : Dune_config.t
+    ; args : string list
+    ; env : Env.t Fiber.t
+    ; get_path_and_build_if_necessary : (unit -> Path.t Memo.t) Fiber.t
+    }
+
+  let init ~common ~context ~no_rebuild ~prog ~args =
+    (* The initialization of some fields is deferred until the fiber scheduler
+       has been started. *)
+    let config = Common.init common in
+    let sctx =
+      let open Fiber.O in
+      let* setup = Import.Main.setup () in
+      let+ setup = Memo.run setup in
+      Import.Main.find_scontext_exn setup ~name:context
+    in
+    let dir =
+      Fiber.map sctx ~f:(fun sctx ->
+          let context = Dune_rules.Super_context.context sctx in
+          Path.Build.relative context.build_dir (Common.prefix_target common ""))
+    in
+    let env = Fiber.map sctx ~f:Super_context.context_env in
+    let get_path_and_build_if_necessary =
+      let open Fiber.O in
+      let* sctx = sctx in
+      let+ dir = dir in
+      fun () -> get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog
+    in
+    { common; config; env; args; get_path_and_build_if_necessary }
+
+  let run_once { common; config; env; args; get_path_and_build_if_necessary; _ }
+      =
+    Scheduler.go ~common ~config @@ fun () ->
+    let open Fiber.O in
+    let* get_path_and_build_if_necessary = get_path_and_build_if_necessary in
+    let* env = env in
+    let+ path = Build_system.run_exn get_path_and_build_if_necessary in
+    let prog = Path.to_string path in
+    let argv = prog :: args in
+    restore_cwd_and_execve common prog argv env
+
+  let run_eager_watch
+      { common; config; env; args; get_path_and_build_if_necessary; _ } =
+    Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config
+    @@ fun () ->
+    let open Fiber.O in
+    let* get_path_and_build_if_necessary = get_path_and_build_if_necessary in
+    let* env = env in
+    let command_to_exec =
+      { Command_to_exec.get_path_and_build_if_necessary =
+          (fun () ->
+            (* TODO we should release the dune lock. But we aren't doing it
+               because we don't unload the database files we've marshalled.
+            *)
+            Build_system.run get_path_and_build_if_necessary)
+      ; args
+      ; env
+      }
+    in
+    Watch.loop ~command_to_exec
+end
+
 let term =
   let+ common = Common.term
   and+ context =
@@ -190,51 +255,16 @@ let term =
       value & flag
       & info [ "no-build" ] ~doc:"don't rebuild target before executing")
   and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in
-  let config = Common.init common in
   (* TODO we should make sure to finalize the current backend before exiting dune.
      For watch mode, we should finalize the backend and then restart it in between
      runs. *)
-  match
-    Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config
-    @@ fun () ->
-    let open Fiber.O in
-    let* setup = Import.Main.setup () in
-    let* setup = Memo.run setup in
-    let sctx = Import.Main.find_scontext_exn setup ~name:context in
-    let get_path_and_build_if_necessary =
-      let context = Dune_rules.Super_context.context sctx in
-      let dir =
-        Path.Build.relative context.build_dir (Common.prefix_target common "")
-      in
-      fun () -> get_path_and_build_if_necessary sctx ~no_rebuild ~dir ~prog
-    in
-    let env = Super_context.context_env sctx in
-    match Common.watch common with
-    | Yes Passive ->
-      User_error.raise [ Pp.textf "passive watch mode is unsupported by exec" ]
-    | Yes Eager ->
-      let command_to_exec =
-        { Command_to_exec.get_path_and_build_if_necessary =
-            (fun () ->
-              (* TODO we should release the dune lock. But we aren't doing it
-                 because we don't unload the database files we've marshalled.
-              *)
-              Build_system.run get_path_and_build_if_necessary)
-        ; args
-        ; env
-        }
-      in
-      let+ () = Watch.loop ~command_to_exec in
-      `In_watch_mode_so_should_loop_forever_and_never_get_here
-    | No ->
-      let+ path = Build_system.run_exn get_path_and_build_if_necessary in
-      `Execve_thunk
-        (fun () ->
-          let prog = Path.to_string path in
-          let argv = prog :: args in
-          restore_cwd_and_execve common prog argv env)
-  with
-  | `In_watch_mode_so_should_loop_forever_and_never_get_here -> ()
-  | `Execve_thunk thunk -> thunk ()
+  let exec_context =
+    Exec_context.init ~common ~context ~no_rebuild ~prog ~args
+  in
+  match Common.watch common with
+  | Yes Passive ->
+    User_error.raise [ Pp.textf "passive watch mode is unsupported by exec" ]
+  | Yes Eager -> Exec_context.run_eager_watch exec_context
+  | No -> Exec_context.run_once exec_context
 
 let command = Cmd.v info term