A --two-process re-run checks the whole program before building it and refuses at a stale caller, and a change made while the child has ended waits in the session for the re-run

TODO.org

@@ -1718,10 +1718,11 @@ out versioned bodies and trampolines, and redirecting a value taken before the
 change. =main= stays refused: its caller is startup code no cell reaches.
 docs/BUILT.md, "A signature change installs".
 
-** DONE A module carrying a string literal is never unloaded
+** DONE An expression's module is unloaded unless it hands out a constant
-The transient rule is that a module retaining nothing may go, and a string literal
+CLOSED: [2026-09-25]
-counts as something retained — which silently stopped every module carrying one
+A thunk's string literal is a copy the process keeps, and registry names and initial
-from ever being unloaded. That is why frame descriptors got their own counter.
+images are copied by the runtime, so none of them pins the module; a condition's
+name or a restart's text still does. Rules out unloading on a guess about a literal.
 
 ** DONE A redefinition delivered while parked installs on the next re-run
 The park used to drain the agent ring only when something had asked it to poll,
@@ -1818,12 +1819,12 @@ line and every later row unrun.
 gone. The dev daemon now removes its own on a clean end; the one-shot commands do
 not.
 
-** WAIT An x86 dev session's read after an allocating thunk once answered without the value
+** WAIT An x86 dev session's read of a dyn global after an allocating thunk failed once
 WAIT on a recurrence; the test now prints the failing read's own reply.
-The one failure's message came from a second read, which said "kept", so the global
+The one failure's message came from a second read, which said "kept"; the failing
-was intact and the first read's reply lacked the value: not the collector. Not
+reply itself was not recorded. Not reproduced in 350 churn-and-read cycles under
-reproduced in 350 churn-and-read cycles under 8-way load, three concurrent test_dev
+8-way load, three concurrent test_dev runs, or a valgrind run of the cycle, which
-runs, or a valgrind run of the cycle, which was clean.
+was clean.
 
 * Editor
 

lib/dev.ml

@@ -1041,7 +1041,25 @@ let eval ?forms ?base ?(extra = []) t ~code ~origin ~pause =
      nothing that can go wrong after it. *)
   let before = Session.held t.session in
   let refused msg = Session.restore t.session before; error msg in
-  if now = Gone then error gone
+  if now = Gone && t.relaunch <> None then
+    (* --two-process, the child ended: the form is checked into the session
+       and nothing is sent, because the next process is built from the
+       session whole ([rerun]). *)
+    match
+      Session.eval ~origin ?base ?forms ?pause ~running:false t.session code
+    with
+    | c ->
+      ok
+        ([ ":names " ^ Wire.strings c.Session.names; ":fns ()";
+           ":note "
+           ^ Wire.quote
+               "loaded; the program has ended, so this is in it when M-x \
+                flan-rerun starts it again" ]
+         @ extra)
+    | exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } ->
+      Session.restore t.session before;
+      error ~loc:(Loc.to_string l) msg
+  else if now = Gone then error gone
   else
     match
       Session.eval ~origin ?base ?forms ?pause ~running:(not parked_now)
@@ -3679,37 +3697,33 @@ let relaunch_child t relaunch =
           process once this one has finished. Close its window, or let it \
           finish, and ask again")
   | Gone ->
-    let s = t.session in
+    (* The whole program is checked again first ([Session.rehost]); a caller
-    (match Session.stale_sites s.Session.built s.Session.program with
+       left compiled against a signature that has since changed is where
-     | (x : Session.stale) :: _ as ss ->
+       that fails. *)
-       error ~loc:(Loc.to_string x.Session.at)
+    let refused (d : Loc.diag) =
-         (Printf.sprintf
+      error ~loc:(Loc.to_string d.Loc.dloc)
-            "a re-run builds the program again, and %d call%s compiled for a \
+        ("a re-run builds the whole program again, and it does not compile: "
-             signature %s function no longer has, starting with %s calling %s \
+         ^ d.Loc.dmsg ^ ". Fix this and load it with C-c C-c, then ask again")
-             here. Recompile the caller with C-c C-c, or change %s back, and \
+    in
-             ask again"
+    (match relaunch () with
-            (List.length ss)
+     | child, rd ->
-            (if List.length ss = 1 then " was" else "s were")
+       drain t;
-            (if List.length ss = 1 then "its" else "their")
+       (try Unix.close t.stdout with Unix.Unix_error _ -> ());
-            x.Session.caller x.Session.target x.Session.target)
+       t.stdout <- rd;
-     | [] ->
+       t.child <- Some child;
-       (match relaunch () with
+       t.finished <- false;
-        | child, rd ->
+       t.died <- None;
-          drain t;
+       (* Every body is in the new host now, so no module owns one. *)
-          (try Unix.close t.stdout with Unix.Unix_error _ -> ());
+       Hashtbl.reset t.owners;
-          t.stdout <- rd;
+       ok
-          t.child <- Some child;
+         [ ":note "
-          t.finished <- false;
+           ^ Wire.quote
-          t.died <- None;
+               "started the program again in a new process, built with every \
-          (* Every body is in the new host now, so no module owns one. *)
+                change loaded so far; its globals start over, because the \
-          Hashtbl.reset t.owners;
+                process is new" ]
-          ok
+     | exception Failure m -> error m
-            [ ":note "
+     | exception Loc.Error d -> refused d
-              ^ Wire.quote
+     | exception Loc.Errors (d :: _) -> refused d)
-                  "started the program again in a new process, built with \
-                   every change loaded so far; its globals start over, \
-                   because the process is new" ]
-        | exception Failure m -> error m))
 
 let rerun t =
   match t.relaunch with

lib/session.ml

@@ -783,10 +783,21 @@ let restore t h =
 let rerun t = t.live <- SM.empty
 
 (* The process is about to be built again from what the session holds now
-   (a --two-process re-run), so that becomes what it was built from. *)
+   (a --two-process re-run), so that becomes what it was built from. Checked
+   whole rather than taken from [program], which can hold a caller's old body
+   beside a callee whose signature changed (see [eval]); a fresh build of that
+   pair would be wrong, so it raises the checker's error instead. *)
 let rehost t =
-  t.host <- t.program;
+  let p, env =
-  t.built <- record_built t.env t.program t.program.Tast.fns SM.empty;
+    let was = !Check.print_warnings in
+    Check.print_warnings := false;
+    Fun.protect ~finally:(fun () -> Check.print_warnings := was)
+      (fun () -> Check.program_with_env t.decls)
+  in
+  t.program <- p;
+  t.env <- env;
+  t.host <- p;
+  t.built <- record_built env p p.Tast.fns SM.empty;
   t.live <- SM.empty
 
 (* [forms], when given, are [src] already read — [pruned] runs this over a

test/test_dev.ml

@@ -5182,7 +5182,62 @@ let () =
              (await (fun () ->
                 ignore (ask "(:op \"describe\")");
                 contains_sub (Buffer.contents seen) "45"))
-        then fail "--two-process: the new child never installed a delivery"
+        then fail "--two-process: the new child never installed a delivery";
+        (* A signature change leaves [user] compiled for the old one. The
+           next build is of the whole program, so the re-run is refused at
+           the stale call; a fix evaluated while the child has ended goes
+           into the session, and the re-run after it builds. *)
+        let ev code =
+          ask
+            (Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\")"
+               (Wire.quote code))
+        in
+        let alive () =
+          match Wire.field (ask "(:op \"describe\")") "alive" with
+          | Some { Form.v = Form.Sym "nil"; _ } -> false
+          | _ -> true
+        in
+        List.iter
+          (fun code ->
+             if status (ev code) <> "ok" then
+               fail "--two-process: %s was refused" code)
+          [ "(defn helper [] i64 1)"; "(defn user [] i64 (helper))" ];
+        if not (await ~ms:10000 (fun () -> not (alive ()))) then
+          fail "--two-process: the new child did not finish"
+        else begin
+          let r = ev "(defn helper [x i64] i64 x)" in
+          if status r <> "ok" then
+            fail "--two-process: a change while the child has ended: %s"
+              (Option.value ~default:"" (Wire.string_field r "message"));
+          let r = ask "(:op \"rerun\")" in
+          if status r <> "error"
+          || not (contains_sub
+                    (Option.value ~default:"" (Wire.string_field r "loc"))
+                    "/tmp/buf.flan:1:")
+          then
+            fail "--two-process: a re-run over a stale caller answered %s \
+                  (%s)" (status r)
+              (Option.value ~default:"" (Wire.string_field r "message"));
+          List.iter
+            (fun code ->
+               if status (ev code) <> "ok" then
+                 fail "--two-process: %s was refused" code)
+            [ "(defn user [] i64 (helper 5))"; "(defn step [] i64 (user))" ];
+          Buffer.clear seen;
+          let r = ask "(:op \"rerun\")" in
+          if status r <> "ok" then
+            fail "--two-process: the re-run after the fix: %s"
+              (Option.value ~default:"" (Wire.string_field r "message"))
+          else if not
+                    (await (fun () ->
+                       ignore (ask "(:op \"describe\")");
+                       contains_sub (Buffer.contents seen) "\n"))
+                  || not (String.starts_with ~prefix:"5\n"
+                            (Buffer.contents seen))
+          then
+            fail "--two-process: the fixed program printed %S"
+              (Buffer.contents seen)
+        end
       end;
       ignore (ask "(:op \"close\")");
       Unix.close tc