A prelude body moved by one live shadowing is compiled again when a later shadowing moves a call inside it

lib/session.ml

@@ -1209,9 +1209,12 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
       in
       List.filter_map
         (fun (f : Tast.fn) ->
-           if Check.internal_name f.Tast.name then
+           (* A moved body not yet in the process is installed; one that is
-             (if known t f.Tast.name || SM.mem f.Tast.name t.built then None
+              — moved by an earlier shadowing — is compiled again like any
-              else Some f.Tast.name)
+              other when a later shadowing moves a call inside it. *)
+           if Check.internal_name f.Tast.name
+              && not (known t f.Tast.name || SM.mem f.Tast.name t.built)
+           then Some f.Tast.name
            else
              match SM.find_opt f.Tast.name t.built with
              | Some b when calls_moved f b ->

test/test_dev.ml

@@ -5955,6 +5955,83 @@ let () =
       [ [||]; [| "--two-process" |] ];
     Own_tmp.remove deep;
 
+    (* ── Prelude functions shadowed live keep the prelude's own calls ──
+
+       [rand] and then [rand-int] redefined in a running program: the
+       prelude's [rand-float-range] still reaches the prelude's [rand], which
+       still reaches the prelude's [rand-int], so it answers something other
+       than what 4096 would make of it. The second shadowing moves a call
+       inside a body the first one had already moved. Both backends. *)
+    List.iter
+      (fun backend ->
+         let ssock = tmp ("shadow" ^ backend ^ ".sock")
+         and sout = tmp ("shadow" ^ backend ^ ".out") in
+         (try Sys.remove ssock with Sys_error _ -> ());
+         let fd =
+           Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
+         in
+         let pid =
+           Unix.create_process flan
+             [| flan; "dev"; "programs/dev-pause.flan"; "-s"; ssock; backend |]
+             Unix.stdin fd Unix.stderr
+         in
+         Unix.close fd;
+         if not (listening ~pid ssock) then begin
+           fail "the %s shadowing daemon %s" backend !listen_why;
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ())
+         end
+         else begin
+           let c = connect ssock in
+           let said r =
+             Option.value ~default:(status r) (Wire.string_field r "message")
+           in
+           (try
+              List.iter
+                (fun code ->
+                   let r =
+                     request c
+                       (Printf.sprintf
+                          "(:op \"eval\" :code %S :file \"programs/dev-pause.flan\")"
+                          code)
+                   in
+                   if status r <> "ok" then
+                     fail "%s: %s: %s" backend code (said r))
+                [ "(defn rand [] f64 0.5)"; "(defn rand-int [] u64 4096)" ];
+              let ask code =
+                let r =
+                  request c
+                    (Printf.sprintf
+                       "(:op \"eval-expr\" :code %S :file \"programs/dev-pause.flan\")"
+                       code)
+                in
+                Option.value ~default:(said r) (Wire.string_field r "value")
+              in
+              (match ask "(rand-int)", ask "(rand)" with
+               | "4096", "0.5" -> ()
+               | a, b ->
+                 fail "%s: the shadowing bodies answer %s and %s" backend a b);
+              (* 4096 through the prelude's rand is 2^-52, which is what the
+                 prelude's calls answered when they followed the new body. *)
+              let v = ask "(rand-float-range 0.0 1.0)" in
+              match float_of_string_opt v with
+              | Some x when x > 1e-9 && x < 1.0 -> ()
+              | _ ->
+                fail "%s: the prelude's rand-float-range followed a shadowing \
+                      body: %s" backend v
+            with (Wire.Closed | Unix.Unix_error _) as e ->
+              fail "%s: the shadowing session ended: %s" backend
+                (Printexc.to_string e));
+           (try
+              ignore (Wire.send c "(:op \"close\")");
+              ignore (Wire.recv c)
+            with _ -> ());
+           (try Unix.close c with Unix.Unix_error _ -> ());
+           (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ());
+           (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
+         end;
+         (try Sys.remove sout with Sys_error _ -> ()))
+      [ "--llvm"; "--x86" ];
+
     (* ── A build that fails is a refusal, not the end of the session ── *)
 
     (* Evaluating runs a compiler, and a compiler can fail in ways the

test/test_session.ml

@@ -286,6 +286,24 @@ let () =
      fail "redefining a shadowed rand-int again installed %s"
        (String.concat " " c.Session.fns));
 
+  (* Two shadowings, in either order: the prelude body the first one moved is
+     compiled again when the second moves a call inside it. *)
+  List.iter
+    (fun (first, second, want) ->
+       let t, _ = Session.create ~file:"programs/reload.flan" () in
+       ignore (Session.eval ~origin:"programs/reload.flan" t first);
+       let c = Session.eval ~origin:"programs/reload.flan" t second in
+       List.iter
+         (fun n ->
+            if not (List.mem n c.Session.fns) then
+              fail "shadowing %S after %S did not install %s: %s" second first
+                n (String.concat " " c.Session.fns))
+         want)
+    [ ("(defn rand [] f64 0.5)", "(defn rand-int [] u64 4096)",
+       [ "rand-int"; "prelude~/rand-int"; "prelude~/rand" ]);
+      ("(defn rand-int [] u64 4096)", "(defn rand [] f64 0.5)",
+       [ "rand"; "prelude~/rand" ]) ];
+
   (* And a mark or a step once the program has a [pause] and a [step-point] of
      its own: the call spliced in is still the prelude's, or a mark would run
      the program's function and never stop. *)