An expression that makes a function value keeps its module mapped, a process a merged program starts does not take the session's socket, and an evaluation's value is its own expression's and not one a restart resumed

lib/dev.ml

@@ -283,6 +283,19 @@ let stop_reply t =
 
 let stop_gen t : int option = Option.map fst (stop_reply t)
 
+(* How many evaluated expressions the agent has queued, and the highest one
+   that has returned a value; [None] from an agent without the verb. *)
+let calls t : (int * int) option =
+  match request t "calls" with
+  | exception Unix.Unix_error _ -> None
+  | text ->
+    (match String.split_on_char ' ' (String.trim text) with
+     | [ q; v ] ->
+       (match int_of_string_opt q, int_of_string_opt v with
+        | Some q, Some v -> Some (q, v)
+        | _ -> None)
+     | _ -> None)
+
 (* The same stop with whose code it stopped in: [Some true] when the thread
    was running an evaluated thunk, [Some false] when it was in the program's
    own code, [None] from an agent that does not say. *)
@@ -1253,6 +1266,10 @@ let eval_expr t ~code ~origin ~pause =
     match Session.eval_expr ~origin ~pause t.session code with
     | c ->
       let before = match result t with Some (g, _) -> g | None -> 0L in
+      (* This expression's number among those the agent has queued: an
+         earlier one resumed by a restart can publish after this one is sent,
+         and the result counter alone would take its value for this one's. *)
+      let mine = Option.map (fun (q, _) -> q + 1) (calls t) in
       (* Read here, beside [before], and for the same kind of reason: all
          three are the "how things stood" half of a difference the wait below
          measures. A program already sitting in a break when the request
@@ -1406,9 +1423,16 @@ let eval_expr t ~code ~origin ~pause =
                  the sleep has to stay a sleep. *)
               drain t;
               let value () =
-                match result t with
+                let returned =
-                | Some (g, v) when Int64.compare g before > 0 -> Some v
+                  match mine, calls t with
-                | _ -> None
+                  | Some m, Some (_, v) -> v >= m
+                  | _ -> true
+                in
+                if not returned then None
+                else
+                  match result t with
+                  | Some (g, v) when Int64.compare g before > 0 -> Some v
+                  | _ -> None
               in
               match value () with
               | Some v -> `Value v

lib/emit.ml

@@ -5770,6 +5770,43 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
 
    String literals still have to come along: they are this module's own
    constants, and omitting them is an undefined [@.str.N] at link time. *)
+
+(* Whether an expression thunk makes a function value anywhere in its body or
+   in the clauses lifted out of it. Such a value's code address is in this
+   module — a lambda's body, or the thick wrapper a named function is handed
+   out through — and it may be stored anywhere, so the module must stay
+   mapped. Both backends ask this before marking a thunk's module
+   unloadable. *)
+let thunk_makes_fn_values (p : Tast.program) name =
+  let mine = Hashtbl.create 8 in
+  Hashtbl.replace mine name ();
+  (* Lifted clauses nest: a lambda inside a lambda is lifted out of the
+     outer one's body, so the set grows until nothing new joins it. *)
+  let rec close () =
+    let grew = ref false in
+    List.iter
+      (fun (f : Tast.fn) ->
+         match f.Tast.fparent with
+         | Some q when Hashtbl.mem mine q && not (Hashtbl.mem mine f.Tast.name) ->
+           Hashtbl.replace mine f.Tast.name (); grew := true
+         | _ -> ())
+      p.Tast.fns;
+    if !grew then close ()
+  in
+  close ();
+  let found = ref false in
+  List.iter
+    (fun (f : Tast.fn) ->
+       if Hashtbl.mem mine f.Tast.name then
+         List.iter
+           (Tast.walk (fun (e : Tast.expr) ->
+              match e.Tast.e with
+              | Tast.FnAddr _ | Tast.Closure _ | Tast.Thicken _ -> found := true
+              | _ -> ()))
+           f.Tast.body)
+    p.Tast.fns;
+  !found
+
 let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
       ?(known = fun _ -> true) ?(retains = true)
       ?call ?(consts = []) ?(annotate = false) (p : Tast.program) ~fns
@@ -6045,7 +6082,8 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
          into the result buffer, so nothing outside the module holds an address
          inside it once the call has returned. Without this, clicking through
          the frames of a break loop costs a permanent mapping per click. *)
-      if fns = [ fn ] && consts = [] && ((not retains) || m.nstr = 0) then
+      if fns = [ fn ] && consts = [] && ((not retains) || m.nstr = 0)
+         && not (thunk_makes_fn_values p fn) then
         Buffer.add_string m.out "\n@flan_reload_transient = global i8 1\n"
     | None -> ()
   end;

lib/x86.ml

@@ -5621,7 +5621,7 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
      function's registry names are not counted: the registry copies them. *)
   (match call with
    | Some fn
-     when fns = [ fn ] && consts = []
+     when fns = [ fn ] && consts = [] && not (Emit.thunk_makes_fn_values p fn)
           && ((not retains) || md.Emit.nstr = 0) ->
      Buffer.add_string out
        "\n\t.data\n\t.globl\tflan_reload_transient\n\

test/test_agent.ml

@@ -65,8 +65,9 @@ let send path line =
    binary is the parent of every program it starts, which is the
    --two-process shape. *)
 let daemon_env path =
-  [| "FLAN_AGENT_SOCKET=" ^ path;
+  let me = string_of_int (Unix.getpid ()) in
-     "FLAN_AGENT_OWNER=" ^ string_of_int (Unix.getpid ()) |]
+  [| "FLAN_AGENT_SOCKET=" ^ path; "FLAN_AGENT_OWNER=" ^ me;
+     "FLAN_DEV_PARENT=" ^ me |]
 
 let () =
   match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
@@ -342,59 +343,71 @@ let () =
        is not this program's, and it picks and announces a path of its own as
        if nothing were set. The file standing in for the session's socket has
        to still be the same file afterwards. *)
-    let stolen = tmp "stolen.sock" and serr = tmp "stolen.err" in
+    let inherited ~shape ~owner =
-    Out_channel.with_open_bin stolen (fun oc ->
+      let stolen = tmp "stolen.sock" and serr = tmp "stolen.err" in
-      output_string oc "the session's");
+      Out_channel.with_open_bin stolen (fun oc ->
-    let senv =
+        output_string oc "the session's");
-      Array.append aenv
+      let senv =
-        [| "FLAN_AGENT_SOCKET=" ^ stolen; "FLAN_AGENT_OWNER=1" |]
+        Array.append aenv
+          [| "FLAN_AGENT_SOCKET=" ^ stolen; "FLAN_AGENT_OWNER=" ^ owner |]
+      in
+      let s1 = ofd (tmp "stolen.out") and s2 = ofd serr in
+      let spid = Unix.create_process_env aexe [| aexe |] senv Unix.stdin s1 s2 in
+      Unix.close s1;
+      Unix.close s2;
+      let prefix = "flan agent: listening on " in
+      let sannounced () =
+        let text = In_channel.with_open_bin serr In_channel.input_all in
+        List.find_map
+          (fun l ->
+             if String.length l > String.length prefix
+                && String.sub l 0 (String.length prefix) = prefix
+             then Some (String.sub l (String.length prefix)
+                          (String.length l - String.length prefix))
+             else None)
+          (String.split_on_char '\n' text)
+      in
+      (match
+         if await (fun () -> sannounced () <> None) then sannounced () else None
+       with
+       | None ->
+         fail "%s: a program with someone else's FLAN_AGENT_SOCKET announced no \
+               socket of its own" shape;
+         (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
+       | Some p ->
+         if p = stolen then fail "%s: the inherited path was bound: %S" shape p;
+         if not (await (fun () -> Sys.file_exists p)) then
+           fail "%s: nothing was bound at the announced %S" shape p
+         else ignore (send p aso);
+         let reaped =
+           await ~ms:5000 (fun () ->
+             match Unix.waitpid [ Unix.WNOHANG ] spid with
+             | 0, _ -> false
+             | _ -> true)
+         in
+         if not reaped then begin
+           (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
+           fail "%s: the program with an inherited variable never finished" shape
+         end);
+      (match In_channel.with_open_bin stolen In_channel.input_all with
+       | "the session's" -> ()
+       | _ -> fail "%s: the inherited FLAN_AGENT_SOCKET's file was replaced" shape
+       | exception Sys_error _ ->
+         fail "%s: the inherited FLAN_AGENT_SOCKET's file was removed" shape);
+      List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
+        [ stolen; serr; tmp "stolen.out" ]
     in
-    let s1 = ofd (tmp "stolen.out") and s2 = ofd serr in
+    (* Nobody's pid. *)
-    let spid = Unix.create_process_env aexe [| aexe |] senv Unix.stdin s1 s2 in
+    inherited ~shape:"an owner that is not this process" ~owner:"1";
-    Unix.close s1;
+    (* A merged build's owner is the program itself, so a process the program
-    Unix.close s2;
+       starts has the owner as its parent; with no FLAN_DEV_PARENT naming it,
-    let prefix = "flan agent: listening on " in
+       that is not the --two-process shape and the socket is not its. Here the
-    let sannounced () =
+       test binary stands in for the program. *)
-      let text = In_channel.with_open_bin serr In_channel.input_all in
+    inherited ~shape:"a child of a merged program"
-      List.find_map
+      ~owner:(string_of_int (Unix.getpid ()));
-        (fun l ->
-           if String.length l > String.length prefix
-              && String.sub l 0 (String.length prefix) = prefix
-           then Some (String.sub l (String.length prefix)
-                        (String.length l - String.length prefix))
-           else None)
-        (String.split_on_char '\n' text)
-    in
-    (match
-       if await (fun () -> sannounced () <> None) then sannounced () else None
-     with
-     | None ->
-       fail "a program with someone else's FLAN_AGENT_SOCKET announced no \
-             socket of its own";
-       (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
-     | Some p ->
-       if p = stolen then fail "the inherited path was bound: %S" p;
-       if not (await (fun () -> Sys.file_exists p)) then
-         fail "nothing was bound at the announced %S" p
-       else ignore (send p aso);
-       let reaped =
-         await ~ms:5000 (fun () ->
-           match Unix.waitpid [ Unix.WNOHANG ] spid with
-           | 0, _ -> false
-           | _ -> true)
-       in
-       if not reaped then begin
-         (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
-         fail "the program with an inherited variable never finished"
-       end);
-    (match In_channel.with_open_bin stolen In_channel.input_all with
-     | "the session's" -> ()
-     | _ -> fail "the inherited FLAN_AGENT_SOCKET's file was replaced"
-     | exception Sys_error _ ->
-       fail "the inherited FLAN_AGENT_SOCKET's file was removed");
 
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
-      [ aexe; aso; aout; aerr; bad; stolen; serr; tmp "stolen.out" ];
+      [ aexe; aso; aout; aerr; bad ];
 
     (* ── No (agent/start) at all ────────────────────────────────────── *)
 

test/test_dev.ml

@@ -6784,7 +6784,38 @@ let () =
                        (%s)" backend
                    (Option.value ~default:"" (Wire.string_field r "value"))
                    (said r)
-             end
+             end;
+             (* A function value an expression makes has its code in that
+                expression's module — a lambda's body, or the wrapper a named
+                function is handed out through — so that module stays mapped.
+                Later expressions are mapped between the store and the call,
+                where an unloaded one would have been. *)
+             let defd code =
+               let r =
+                 request c
+                   (Printf.sprintf
+                      "(:op \"eval\" :code %s \
+                       :file \"programs/dev-dyn-global.flan\")" (Wire.quote code))
+               in
+               if status r <> "ok" then fail "--%s: %s: %s" backend code (said r)
+             in
+             defd "(defonce kept (Option (Fn [i64] i64)))";
+             defd "(defn twice [x i64] i64 (* x 2))";
+             let call_kept want what =
+               for i = 1 to 3 do
+                 ignore (ev (Printf.sprintf "(do (println \"pad %d\") %d)" i i))
+               done;
+               let r = ev "(match kept (Some f) (f 1) (None) -1)" in
+               if Wire.string_field r "value" <> Some want then
+                 fail "--%s: %s kept by an unloaded expression answered %S \
+                       (%s)" backend what
+                   (Option.value ~default:"" (Wire.string_field r "value"))
+                   (said r)
+             in
+             ignore (ev "(do (set kept (Some (fn [x] (+ x 7)))) 0)");
+             call_kept "8" "a lambda";
+             ignore (ev "(do (set kept (Some twice)) 0)");
+             call_kept "2" "a named function"
            end;
            ignore (request c "(:op \"close\")");
            (try Unix.close c with Unix.Unix_error _ -> ());
@@ -8958,6 +8989,23 @@ let () =
              "(:op \"eval-expr\" :code %s :file \"programs/dev-own-break.flan\")"
              (Wire.quote code))
       in
+      (* An expression stopped in a break and resumed by a restart finishes
+         after the restart's reply, and here it finishes after the next
+         expression has been sent: its value must not answer for that one. *)
+      let r =
+        ev "(restart-case (do (error (Late {})) 0) \
+            (slow [] (do (usleep 500000) 5)))"
+      in
+      if status r <> "error" then
+        fail "resumed value: the first expression did not stop: %s" (said r)
+      else begin
+        let r = request c "(:op \"restart\" :name \"slow\")" in
+        if status r <> "ok" then fail "resumed value: restart: %s" (said r);
+        let r = ev "(do (usleep 300000) 23)" in
+        if Wire.string_field r "value" <> Some "23" then
+          fail "resumed value: the next expression answered %S (%s)"
+            (Option.value ~default:"" (Wire.string_field r "value")) (said r)
+      end;
       let r = ev "(do (set go 1) 0)" in
       if status r <> "ok" then fail "own break: setting go: %s" (said r)
       else begin

vendor/agent/flan_agent.c

@@ -214,8 +214,19 @@ typedef struct {
   void      *handle;
   int        stopped_only;
   int32_t    at_stop;
+  uint32_t   call_id;          /* its place among jobs with a call; 0 if none */
 } job;
 
+/* Which evaluated expression the result buffer holds. Every job with a call
+ * is numbered as the listener queues it, and a call that returns records its
+ * number, so a daemon waiting for its own expression's value is not answered
+ * by an earlier expression that a restart resumed and that published after
+ * the new one was sent. The highest wins: an expression run inside another's
+ * break returns first, and the outer one only resumes on a later request.
+ * The [calls] verb answers both counts. */
+static _Atomic uint32_t calls_queued;
+static _Atomic uint32_t calls_valued;
+
 /* Said once, in one place, and shipped to the daemon over [refusals] rather
  * than written down again at the other end. A refusal is a sentence naming
  * what actually happened, and the thing that actually happened is not "the
@@ -1335,6 +1346,8 @@ int32_t flan_agent_poll(void) {
       if (sigsetjmp(escape, 1) == 0) {
         eval_escape = &escape;
         j.call();
+        if (j.call_id > atomic_load(&calls_valued))
+          atomic_store(&calls_valued, j.call_id);
       } else {
         if (flan_condition_stacks_restore) flan_condition_stacks_restore(mh, mr, md);
         if (flan_dev_frames_restore) flan_dev_frames_restore(mf);
@@ -1920,6 +1933,14 @@ static void handle_line(char *line, sink *o) {
    * editor polls this without knowing the state already. */
   /* After the number, whose code stopped: "eval" when the thread was inside
    * an evaluated thunk, "program" when it was in the program's own code. */
+  if (strcmp(line, "calls") == 0) {
+    char hdr[48];
+    int  k = snprintf(hdr, sizeof hdr, "%u %u\n",
+                      (unsigned)atomic_load(&calls_queued),
+                      (unsigned)atomic_load(&calls_valued));
+    if (k > 0) emit(o, hdr, (size_t)k);
+    return;
+  }
   if (strcmp(line, "stop") == 0) {
     snapshot *s = (atomic_load(&depth) > 0) ? snap_top() : NULL;
     char hdr[32];
@@ -2199,7 +2220,9 @@ static void handle_line(char *line, sink *o) {
    * is the failure being fixed. */
   if (!publish((job){ .install = f, .call = c,
                       .handle = transient == NULL ? NULL : h,
-                      .stopped_only = stopped_only, .at_stop = at_stop }))
+                      .stopped_only = stopped_only, .at_stop = at_stop,
+                      .call_id = c == NULL ? 0
+                                 : atomic_fetch_add(&calls_queued, 1) + 1 }))
     fprintf(stderr, "flan: reload queue full after it was checked\n");
   return;
 }
@@ -2498,8 +2521,17 @@ static const char *daemon_socket(void) {
     return NULL;
   pid = strtol(own, &end, 10);
   if (end == own || *end != '\0' || pid <= 0) return NULL;
-  if (pid != (long)getpid() && pid != (long)getppid()) return NULL;
+  if (pid == (long)getpid()) return env;
-  return env;
+  /* The parent only under --two-process, which is the one shape that sets
+   * FLAN_DEV_PARENT, and to the same pid. In a merged build the owner is the
+   * program itself, so a process it starts has the owner as its parent and
+   * must not take the socket. */
+  {
+    const char *par = getenv("FLAN_DEV_PARENT");
+    if (par != NULL && strcmp(par, own) == 0 && pid == (long)getppid())
+      return env;
+  }
+  return NULL;
 }
 
 /* [path] is a Flan string: ptr and len, not NUL-terminated.