JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A handler-bind clause runs with only the handlers outside its own form in force, and a stale call in main's running loop stays listed until the callee changes back or the program re-runs

Browse Source 
The first is CLHS 9.1.4.1: a clause that signalled the condition it handles used to re-enter itself until the stack ran out. The stale list now names a lifted clause by the function it is written in, and BUILT.md's cost line is measured against master.
This commit is contained in:
Joseph Ferano 2026-09-25 11:15:52 +07:00
parent 0d771494a6
commit ed8dbbcd62
11 changed files with 269 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
docs/BUILT.md
View File

@ -1494,7 +1494,16 @@ symbol, with its call sites — callee, the signature it had when the body was c
host program and each accepted module replaces the bodies it compiled. After an evaluation, `stale_sites` is every
recorded site whose callee's signature in the new program is not the one recorded, and it rides on the reply as
`:stale`; the editor puts each in `*flan-diagnostics*`. Recompiling a caller replaces its record and drops it from the
list.
list. A site is named by the declaration its body belongs to, so a call in a handler clause lifted out of `step` is
`step`'s.
**Except in `main`.** Recompiling a function changes what its *next* call runs, and `main` is not called again while
the program runs: its loop is the activation the stale call is in. So while the program runs, a stale site in `main`
is flagged `:running`, and when `main` is recompiled the body it started with is kept in `Session.live` and stays on
the list until a re-run (`Session.rerun`) — the editor's sentence then says to change the callee back or re-run,
since evaluating `main` again cannot help. A re-run enters `main` through its cell and so reaches the new body. Any
other function the program never leaves has the same property and is not tracked: the dev shadow stack could say
which bodies are live, but the x86 backend pushes no frames onto it.
**A stale caller's source may no longer check**, and that must not refuse the form that changed the callee:
`(scale ticks)` after `scale` gained a parameter is an arity error in a body nobody is recompiling. So `Check` has a
@ -1513,10 +1522,12 @@ compiled bodies like any other and are listed by their own file and line, the ca
importer included. The prelude has no stale callers to list, because a session cannot redefine a prelude function at
all — the form is refused as a second definition.
A release build has no cells, so it has neither the word nor the compare. Measured on a 200M-call loop of a one-line
function, dev build, both sides with three-word cells so the difference is the compare alone: x86 median 2.91 s
against 2.59 s without it (about 1.6 ns a call); LLVM `-O2` median 0.32 s against 0.39 s — the checked build ran faster
in all nine rounds, which is most likely code layout and was not investigated.
A release build has no cells, so it has neither the word nor the compare. Measured against master's compiler on a
200M-call loop of a one-line function, dev build, with `perf stat` counting user-mode events because wall time on a
shared machine moved by more than the difference: x86 runs 5 more instructions a call (13.0G to 14.0G) and about 2 more
cycles (median 9.23G to 9.49G); LLVM `-O2` runs 2 more instructions a call (2.6G to 3.0G) and *fewer* cycles (median
1.24G to 1.04G), consistently across rounds — a layout effect, not investigated. Wall time at the fastest of nine runs:
x86 2.03 s to 2.27 s, LLVM 0.30 s to 0.26 s.
### The agent — dev loop step 3

7
emacs/MANUAL.md
View File

@ -849,6 +849,13 @@ Evaluating `(defn scale [x i64 k i64] i64 (* x k))` installs the new `scale`
and names `step` as a stale caller. The next call from `step` stops on
`StaleCall`; evaluating `step` again, calling `(scale ticks 3)`, clears it.
A call in `main` is the exception to that fix. While the program runs, it is
inside the `main` it started with, and that body never returns to be called
again, so evaluating `main` again does not reach the loop it is in. The listing
says so for each such call, and the program keeps stopping there until `scale`
is defined with the old signature again or the program is re-run with `M-x
flan-rerun`. The same holds for any function the program never leaves.
A function value taken before the change keeps the body it was taken from and
goes on computing what it did. A value taken by a stale caller after the change
stops where it is taken.

20
emacs/flan.el
View File

@ -2355,11 +2355,21 @@ of the tenth name tells you neither how many there were nor which."
(defun flan--stale-message (site)
"The sentence for SITE, one entry of a reply's `:stale' list."
(let ((callee (plist-get site :callee)))
(format "this call to %s was compiled for %s, and %s is defined as %s. \
Evaluate %s again to compile it against the new definition."
callee (plist-get site :compiled) callee (plist-get site :current)
(plist-get site :caller))))
(let ((callee (plist-get site :callee))
(compiled (plist-get site :compiled)))
(concat
(format "this call to %s was compiled for %s, and %s is defined as %s. "
callee compiled callee (plist-get site :current))
(if (plist-get site :running)
;; `main' is the one caller no evaluation can reach: the program is
;; inside the body it started with and never calls it again.
(format "It is in %s, which is still running the body it started \
with, so evaluating %s again does not reach it. Define %s with %s again, or \
re-run the program (M-x flan-rerun)."
(plist-get site :caller) (plist-get site :caller) callee
compiled)
(format "Evaluate %s again to compile it against the new definition."
(plist-get site :caller))))))
(defun flan--report-stale (stale)
"Log every call site in STALE, a reply's `:stale' list.

8
lib/dev.ml
View File

@ -874,11 +874,12 @@ let stale_field (ss : Session.stale list) =
(List.map
(fun (x : Session.stale) ->
Printf.sprintf
"(:loc %s :caller %s :callee %s :compiled %s :current %s)"
"(:loc %s :caller %s :callee %s :compiled %s :current %s%s)"
(Wire.quote (Loc.to_string x.Session.at))
(Wire.quote x.Session.caller) (Wire.quote x.Session.target)
(Wire.quote x.Session.compiled)
(Wire.quote x.Session.current))
(Wire.quote x.Session.current)
(if x.Session.running then " :running t" else ""))
ss) ]
let eval t ~code ~origin ~pause =
@ -904,7 +905,7 @@ let eval t ~code ~origin ~pause =
let refused msg = Session.restore t.session before; error msg in
if now = Gone then error gone
else
match Session.eval ~origin ?pause t.session code with
match Session.eval ~origin ?pause ~running:(not parked_now) t.session code with
| c when not c.Session.installs ->
(* Accepted into the session and nothing to send: a declaration the
program already has, with no body and no new storage. Saying "ok" and
@ -3330,6 +3331,7 @@ let rerun t =
let stopped_in_park = liveness t = Parked && at_break in
(match Program.rerun ~stopped:at_break () with
| Ok () ->
Session.rerun t.session;
(* The park this session was explaining is over, so the park after it
gets the explanation again — see [install_note]. Cleared here as
well as in [eval] because a run can start and finish with nothing

74
lib/session.ml
View File

@ -53,6 +53,11 @@ type stale = {
compiled : string; (* the signature it was compiled for *)
current : string; (* the signature the function has now *)
at : Loc.t;
(* True when the call is in [main] and the program is running: the
activation it is in is [main]'s loop, which never returns to be called
again, so compiling [main] again cannot reach it. Changing the callee
back or re-running the program does. *)
running : bool;
}
type t = {
@ -96,6 +101,11 @@ type t = {
modules are accepted — so it is what was *compiled*, which after a
signature change is not what [program] would check to. *)
mutable built : built SM.t;
(* The bodies of [main], and of the clauses lifted out of it, as the
running activation was compiled — kept when [main] is compiled again
while the program runs, because the loop the program is in is still the
old one and nothing re-enters it until a re-run. Emptied by [rerun]. *)
mutable live : built SM.t;
}
let fail = Loc.fail
@ -152,23 +162,30 @@ let record_built env (p : Tast.program) (fns : Tast.fn list) m =
it was compiled for, in source order. A callee [p] does not have is
skipped rather than reported: nothing could have been installed under it
since, so the cell still holds what the site was compiled against. *)
let stale_sites built (p : Tast.program) : stale list =
let stale_sites ?(live = SM.empty) ?(running = false) built (p : Tast.program) :
stale list =
let sigs = Hashtbl.create 64 in
List.iter
(fun (f : Tast.fn) ->
Hashtbl.replace sigs f.Tast.name (Emit.sig_text f.Tast.params f.Tast.ret))
p.Tast.fns;
SM.fold
(fun caller b acc ->
List.fold_left
(fun acc (st : site) ->
match Hashtbl.find_opt sigs st.callee with
| Some now when not (String.equal now st.csig) ->
{ caller; target = st.callee; compiled = st.csig; current = now;
at = st.sloc } :: acc
| _ -> acc)
acc b.sites)
built []
(* Named by the declaration a body belongs to: a clause lifted out of
[step] is [step]'s call, and a generic's copy is the generic's. *)
let from ~kept m acc =
SM.fold
(fun _ b acc ->
let running = kept || (running && String.equal b.owner "main") in
List.fold_left
(fun acc (st : site) ->
match Hashtbl.find_opt sigs st.callee with
| Some now when not (String.equal now st.csig) ->
{ caller = b.owner; target = st.callee; compiled = st.csig;
current = now; at = st.sloc; running } :: acc
| _ -> acc)
acc b.sites)
m acc
in
from ~kept:true live (from ~kept:false built [])
|> List.sort (fun a b ->
match String.compare a.at.Loc.file b.at.Loc.file with
| 0 -> Loc.before a.at b.at
@ -227,7 +244,7 @@ let create ?(debug = false) ?(x86 = false) ~file () =
that buffer. [macro_union] keeps the left. *)
macros = Load.macro_union (own_macros forms) l.Load.macros;
thunks = 0; debug; x86;
built = record_built env p p.Tast.fns SM.empty }, l)
built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l)
(* What a macro may call, for the same reason [macros] is held: an evaluation
parses one form with no import in sight, and a package macro whose body
@ -615,20 +632,26 @@ type held = {
(* And what the process was compiled with, which an acceptance moves too:
a module that never arrived compiled nothing. *)
hbuilt : built SM.t;
hlive : built SM.t;
}
let held t =
{ hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros;
hbuilt = t.built }
hbuilt = t.built; hlive = t.live }
let restore t h =
t.decls <- h.hdecls;
t.program <- h.hprogram;
t.env <- h.henv;
t.macros <- h.hmacros;
t.built <- h.hbuilt
t.built <- h.hbuilt;
t.live <- h.hlive
let eval ?(origin = "<eval>") ?pause t src : change =
(* A re-run calls [main] through its cell, so the body it enters is the
newest one and no older activation is left running. *)
let rerun t = t.live <- SM.empty
let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
let forms = Reader.read_all ~file:origin src in
Parse.with_imported ~decls:(package_decls t) t.macros @@ fun () ->
(* Through [Load] like any other source, so an evaluated (import ...) means
@ -1082,18 +1105,35 @@ let eval ?(origin = "<eval>") ?pause t src : change =
program.Tast.fns
in
let built = record_built env program rebuilt t.built in
(* [main]'s running activation is the body the program started with, and
compiling [main] again does not reach it: the loop it is in never
returns to be called again. So while the program runs, the body it was
started with is kept, and its stale sites stay on the list. *)
let live =
if not running then t.live
else
List.fold_left
(fun live (f : Tast.fn) ->
match SM.find_opt f.Tast.name t.built with
| Some b when String.equal b.owner "main"
&& not (SM.mem f.Tast.name live) ->
SM.add f.Tast.name b live
| _ -> live)
t.live rebuilt
in
t.macros <- !macros;
t.decls <- decls;
t.program <- program;
t.env <- env;
t.built <- built;
t.live <- live;
(* [run_thunk] counts: a form that is only a (defclass ...) already
installs its constructor, but a module carrying nothing but the
registration still has something for the program to run. *)
{ ir; x86 = t.x86; names; fns;
installs =
fns <> [] || allocates || consts <> [] || run_thunk <> None;
stale = stale_sites built program }
stale = stale_sites ~live ~running built program }
(* ── Evaluating an expression ──────────────────────────────────────── *)

22
runtime/flan_rt.c
View File

@ -72,10 +72,22 @@ void flan_handler_pop(flan_handler *h) {
*
* A handler that transfers stops the walk. The remaining handlers are for a
* signal that is still looking for someone; this one has been answered. */
/* While a clause runs, the handlers in force are the ones that were in force
* when its handler-bind was established — the frames below it — and not the
* whole stack. That is Common Lisp's rule (CLHS 9.1.4.1; SBCL's
* %handler-bind rebinds *handler-clusters* to the rest of the list around
* each call), and without it a clause that signals the condition it handles
* reaches itself again, and again, until the stack runs out. The stack is put
* back afterwards whether or not the clause transferred: a transfer's target
* can be a restart-case inside the handler-bind's own body, whose frame does
* not pop this handler on the way there. */
void flan_signal(uint32_t type_id, void *condition, void *xfer) {
for (flan_handler *h = handlers; h != NULL; h = h->prev)
flan_handler *saved = handlers;
for (flan_handler *h = saved; h != NULL; h = h->prev)
if (h->type_id == type_id) {
handlers = h->prev;
h->fn(condition, xfer, h->env);
handlers = saved;
if (*(void **)xfer != NULL) return;
}
}
@ -1126,9 +1138,11 @@ void flan_stale_call(const char *site, const char *callee, const char *want,
rt_flush_out();
fprintf(stderr,
"%s: this call to %s was compiled for %s, and %s is defined as %s. "
"Evaluate the function this call is in again, so that it is "
"compiled against the new definition.\n",
site, callee, want, callee, now);
"Evaluating the function this call is in again fixes its next call. "
"A function that is still running, such as main's loop, is never "
"called again: define %s with %s again, or run the program "
"again.\n",
site, callee, want, callee, now, callee, want);
rt_die();
}

10
test/programs/dev-stale.flan
View File

@ -34,3 +34,13 @@
(restart-case (step)
(skip-frame [] 0)))
0)
;;; A stale call inside a handler-bind clause that handles StaleCall. The body's
;;; call to [scale] signals, the clause runs, and the clause's own call to
;;; [scale] signals again — which reaches the handlers outside this
;;; handler-bind and not the clause itself, so it stops in the break buffer
;;; rather than recursing until the stack runs out. The clause is a lifted
;;; function, and the stale list names it as [guarded].
(defn guarded [] i64
(handler-bind [(StaleCall [c] (set seen (scale 1)))]
(scale 5)))

46
test/programs/handler-reentry.flan Normal file
View File

@ -0,0 +1,46 @@
;;;; A handler-bind clause that signals the condition it is handling.
;;;;
;;;; While a clause runs, the handlers in force are the ones that were in force
;;;; when its handler-bind was established (CLHS 9.1.4.1). So the inner clause's
;;;; own bad index reaches the *outer* clause, once, and not the inner one
;;;; again — which used to recurse until the stack ran out.
;;;;
;;;; The second half is the other order: after the inner clause has run and
;;;; declined, the handler it belongs to is in force again for the next signal.
(defonce hits i64)
(def grid [4 i32] [1 2 3 4])
(defn bad [i i32] i32 (at grid i))
(defn nested [] i64
(restart-case
(handler-bind [(BoundsError [c] (set hits (+ hits 100)) (invoke-restart 'outer))]
(restart-case
(handler-bind [(BoundsError [c]
(set hits (+ hits 1))
(bad 9)
(invoke-restart 'inner))]
(bad 7))
(inner [] 0)))
(outer [] 0))
hits)
(defn again [] i64
(set hits 0)
(restart-case
(handler-bind [(BoundsError [c] (set hits (+ hits 1)) (invoke-restart 'out))]
(handler-bind [(BoundsError [c] (set hits (+ hits 10)))]
(bad 5)
0))
(out [] 0))
(restart-case
(handler-bind [(BoundsError [c] (set hits (+ hits 1000)) (invoke-restart 'out))]
(bad 6))
(out [] 0))
hits)
(defn main [] i32
(println (nested))
(println (again))
0)

10
test/test_acceptance.ml
View File

@ -916,6 +916,16 @@ let () =
outputs "conditions" "programs/conditions.flan" conditions_out;
outputs ~opt:"-O0" "conditions, -O0" "programs/conditions.flan" conditions_out;
outputs ~dev:true "conditions, dev" "programs/conditions.flan" conditions_out;
(* A clause that signals what it handles reaches the handlers outside its
own handler-bind and not itself (CLHS 9.1.4.1), and its handler is in
force again once it has declined. It used to recurse until the stack
ran out. *)
let reentry_out = "101\n1011\n" in
outputs "handler re-entry" "programs/handler-reentry.flan" reentry_out;
outputs ~dev:true "handler re-entry, dev" "programs/handler-reentry.flan"
reentry_out;
outputs ~x86:true "handler re-entry, --x86" "programs/handler-reentry.flan"
reentry_out;
(* restart-case and invoke-restart, §3 to §6: the transfer itself. A
fall-through with nothing handling it, a clause reached from two frames
down, the defer in between running on the way out, an inner frame

35
test/test_dev.ml
View File

@ -6645,7 +6645,8 @@ let () =
fail "--%s: a signature change was refused: %s" backend (said r)
else begin
let locs = stale_locs r in
if not (at 23 locs && at 26 locs && List.length locs = 2) then
if not (at 23 locs && at 26 locs && at 45 locs && at 46 locs
&& List.length locs = 4) then
fail "--%s: the reply named the stale callers %s" backend
(String.concat ", " locs);
if not (await ~ms:20000 stopped) then
@ -6686,7 +6687,8 @@ let () =
fail "--%s: recompiling the stale caller: %s" backend (said r)
else begin
let locs = stale_locs r in
if not (at 26 locs && List.length locs = 1) then
if not (at 26 locs && not (at 23 locs) && List.length locs = 3)
then
fail "--%s: after recompiling step the stale list is %s"
backend (String.concat ", " locs)
end;
@ -6737,6 +6739,35 @@ let () =
"(:op \"restart\" :name \"abandon-evaluation\")");
if not (await ~ms:20000 (fun () -> not (stopped ()))) then
fail "--%s: the abandoned evaluation never let go" backend
end;
(* A stale call inside a clause handling StaleCall. The
clause's handler is not in force while the clause runs,
so its own stale call reaches the break loop once,
rather than the clause again until the stack runs out. *)
let r =
request c
"(:op \"eval-expr\" :code \"(guarded)\" \
:file \"programs/dev-stale.flan\")"
in
if status r <> "error" then
fail "--%s: a stale call inside a handler answered: %s"
backend (said r)
else if not (await ~ms:20000 stopped) then
fail "--%s: a stale call inside a handler never stopped" backend
else begin
(match
Wire.string_field (request c "(:op \"break\")") "site"
with
| Some site when contains_sub site "dev-stale.flan:45:" -> ()
| Some site ->
fail "--%s: the stale call in the clause stopped at %s"
backend site
| None -> fail "--%s: the clause's stale call has no :site" backend);
ignore
(request c
"(:op \"restart\" :name \"abandon-evaluation\")");
if not (await ~ms:20000 (fun () -> not (stopped ()))) then
fail "--%s: the abandoned clause never let go" backend
end
end
end

55
test/test_session.ml
View File

@ -95,7 +95,11 @@ let () =
in
let want =
[ ("step", "scale", "[i64] i64", "[i64 i64] i64", 23);
("pick", "scale", "[i64] i64", "[i64 i64] i64", 26) ]
("pick", "scale", "[i64] i64", "[i64 i64] i64", 26);
(* The clause's call is named for the function it is written in,
not for the lifted function it became. *)
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 45);
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 46) ]
in
if named <> want then
fail "the stale callers were %s"
@ -110,7 +114,9 @@ let () =
with
| c ->
(match c.Session.stale with
| [ x ] when x.Session.caller = "pick" -> ()
| [ a; b; c ] when a.Session.caller = "pick"
&& b.Session.caller = "guarded"
&& c.Session.caller = "guarded" -> ()
| l ->
fail "after recompiling step the stale callers were %s"
(String.concat ", "
@ -123,7 +129,7 @@ let () =
(match Session.eval t "(defn lonely [x i64] i64 (+ x 1))" with
| c ->
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
<> [ "pick" ]
<> [ "pick"; "guarded"; "guarded" ]
then fail "an unrelated evaluation lost track of the stale caller"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "an evaluation after a signature change was refused: %s" m);
@ -141,6 +147,49 @@ let () =
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "changing a signature back was refused: %s" m));
(* A stale call in [main] is one that evaluating [main] again cannot fix
while the program runs: its loop is the activation the call is in, and
it never returns to be called again. So the site is flagged, and when
[main] is compiled again the body the program started with stays on the
list until a re-run. With the program parked, compiling [main] again is
an ordinary fix. *)
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
let mains (c : Session.change) =
List.filter_map
(fun (x : Session.stale) ->
if x.Session.caller = "main" then Some x.Session.running else None)
c.Session.stale
in
let main_src =
"(defn main [] i32 (agent/start \"/tmp/x.sock\") \
(dotimes [i 6000] (agent/wait 5) (restart-case (step 1) (skip-frame [] 0))) 0)"
in
(match Session.eval t "(defn step [x i64] i64 (set seen (scale x)) seen)" with
| c ->
if mains c <> [ true ] then fail "a stale call in main was not flagged as running"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing step: %s" m);
(match Session.eval t main_src with
| c ->
if mains c <> [ true ] then
fail "recompiling main while it runs cleared its stale call"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling main: %s" m);
Session.rerun t;
(match Session.eval t "(defn lonely [x i64] i64 (+ x 2))" with
| c -> if mains c <> [] then fail "a re-run did not clear main's stale call"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "after a re-run: %s" m));
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
ignore
(Session.eval ~running:false t "(defn step [x i64] i64 (set seen (scale x)) seen)");
match
Session.eval ~running:false t
"(defn main [] i32 (dotimes [i 3] (restart-case (step 1) (skip-frame [] 0))) 0)"
with
| c ->
if List.exists (fun (x : Session.stale) -> x.Session.caller = "main")
c.Session.stale
then fail "recompiling main while parked left it stale"
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling a parked main: %s" m);
(* What a tolerated caller's failed check made is taken back, generic copies
included, so a body in the same form that needs the same copy gets one
generated for it rather than a cached name. *)