From 6583392504f3f9767a9253b31f264e8b09b7a2f6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 22:51:02 +0700 Subject: [PATCH] A prelude body moved by one live shadowing is compiled again when a later shadowing moves a call inside it --- lib/session.ml | 9 ++++-- test/test_dev.ml | 77 ++++++++++++++++++++++++++++++++++++++++++++ test/test_session.ml | 18 +++++++++++ 3 files changed, 101 insertions(+), 3 deletions(-) diff --git a/lib/session.ml b/lib/session.ml index b60917ed..dc4683b5 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -1209,9 +1209,12 @@ let eval ?(origin = "") ?base ?forms ?pause ?(step = false) ?(running = tr in List.filter_map (fun (f : Tast.fn) -> - if Check.internal_name f.Tast.name then - (if known t f.Tast.name || SM.mem f.Tast.name t.built then None - else Some f.Tast.name) + (* A moved body not yet in the process is installed; one that is + — moved by an earlier shadowing — is compiled again like any + 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 -> diff --git a/test/test_dev.ml b/test/test_dev.ml index 3dd86d92..46a4eb4c 100644 --- a/test/test_dev.ml +++ 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 diff --git a/test/test_session.ml b/test/test_session.ml index 2beb7a28..3fdda3f9 100644 --- a/test/test_session.ml +++ b/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. *)