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

The globals a stopped stack touches, in a section of their own

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-12 16:23:31 +07:00
commit 3325c41fb7
9 changed files with 820 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
BUILT.md
View File

@ -1408,6 +1408,59 @@ Each slot is rendered **from its address** rather than copied into the thunk fir
size of the slot — 40KB for sand's grid — and the walk only ever shows eight elements of it. The cost is one call to
`flan/dev-slot` per leaf the walk reaches rather than one per slot, which the depth and span caps already bound.
### Globals of a stopped stack
The other half, and in this language arguably the more useful one: a game keeps most of its state in top-level
`defvar`s and `sand.flan` holds its entire grid that way, so "what is this program's state right now" was a question
with nowhere to ask it.
```
(:op "globals") → (:status "ok"
:globals (("grid" "[4 i32]" "[ 7 5 0 0]" (0 1))
("pressure" "i64" "12" (0))
("label" "string" "\"running\"" (1)))
:refused () :skipped ())
```
**Not per frame, and that is the design rather than a layout preference.** A global is not part of a frame — it is
program state the frame happened to touch — so nesting it under one implies an ownership that is not there and repeats
the name once per frame that reads it. So: one section, whose contents are the **union of the globals every frame on
the current stack references**.
**The compiler does the choosing.** `Reach.expr_refs` is the walk that already computes what a function refers to — it
is how the link drops a package nothing calls — and pointed at one body it answers that body's reference set. Listing
*all* of a program's globals instead would bury the one that matters under the prelude's PRNG state; taking only what
the stack reaches is a filter the compiler can apply and a person cannot. Direct references only, with no transitive
closure through calls: a callee that reads a global is either on this stack, contributing its own references already,
or it is not on it and is not part of where the program stopped.
**Each entry carries the frames that touch it, by index**, which is what the conditions buffer already numbers frames
by. That recovers what per-frame nesting would have told you — "the whole chain is reading this" reads differently from
"only the innermost does" — at no cost in duplication. **Ordered by the innermost frame that touches it**, because a
deep stack makes the union large and proximity to the error is what puts the likely culprit on top; ties keep
declaration order.
**The mechanism is one step simpler than `locals`.** A local is reached by *address*, and only the stopped program
knows where its frame is — hence `flan/dev-slot`, hence the `bound_slots` round trip, hence the null-until-bound
refusal. A global is reached by *name*: `Emit.redefinition` writes a global the host already has as `external`, so the
dlopened thunk binds to the program's own storage and the dynamic linker does the work. Nothing is asked of the stopped
thread at all, and there is no not-yet-bound case, because a global's storage exists from the moment the process
started. It is `Render.render` over `(Global n)` — the same root `C-x C-e` uses when you type a global's name at it.
**A frame that cannot be attributed contributes nothing and says so.** An `eval` frame has no declaration in this
session; a lifted handler clause has none of its own; a frame whose body was redefined since it was entered holds a
body whose reference set is a claim about different code. All three go into `:skipped` with the reason, because "the
union is incomplete and here is why" and "these are all of them" are different answers and the second one is the lie.
**And the hole in that, which is narrow and is not closed.** `Emit.slot_fingerprint` hashes a body's *slots*. For
`locals` that is exactly the right cut: identical slots means the names still describe the storage, so the answer is
still true. Here it is not, because a body can change which globals it names without touching a single slot — and then
this section shows the *new* body's reference set attributed to the *old* frame. The values stay correct; they are read
from the program's storage by name. What can be wrong is one frame's membership in the union and the frame numbers
beside an entry. Closing it needs a second fingerprint over the reference set itself, in `%fninfo` and in the agent
that reads it. It is written down here and in `dev.ml` rather than papered over with a check that does not check it,
and `test_dev.ml` drives the redefinition case that *is* caught rather than asserting the one that is not.
### Conditions — step 2: `restart-case` and `invoke-restart`
`spec-conditions.md` §3 to §6: the transfer. A handler runs where the signal was, decides, and control resumes at a

20
NEXT.md
View File

@ -369,21 +369,11 @@ reason there is no collector.
## Decided in discussion, queued
**Globals in the break buffer — one section, scoped to the stack.** Locals are readable; globals are not shown anywhere,
and in this language they are arguably the more useful half: a game keeps most of its state in top-level `defvar`s and
`sand.flan` holds its entire grid that way.
Not per frame. A global is not part of a frame — it is program state the frame happened to touch — so nesting it under
one implies an ownership that is not there and repeats the name once per frame that reads it. Instead: its own section,
whose contents are the **union of the globals every frame on the current stack references**, which keeps the compiler
doing the choosing (the per-function reference set is already known) without listing all of a program's globals.
Two refinements decided with it: **annotate each entry with which frames touch it**, which recovers what per-frame would
have told you at no cost in duplication; and **order by the innermost frame that touches it**, since a deep stack makes
the union large and proximity to the error is the ordering that puts the likely culprit on top.
The daemon already has the pieces — `describe` returns the globals, `Session.render` walks a concrete type to a printed
value, and the `layout` op established that a qualified name is an identity the daemon can resolve.
**Globals in the break buffer — built.** One section under the stack, holding the union of the globals every frame on
the current stack references, each entry annotated with the frames that touch it and ordered by the innermost one. It
is `(:op "globals")` in `dev.ml` and `flan-cnr--insert-globals` in the break buffer. See BUILT.md, "Globals of a
stopped stack" — including the one hole left open, which is that the redefinition check is a fingerprint over a body's
*slots* and so does not catch a new body that names different globals while binding the same locals.
**The break buffer opens by itself when the program stops.** Today a condition stops the program and the buffer appears
only when `C-c C-b` is typed. `flan-dev--absorb` already inspects every reply for `:stopped` and a poll covers the case

57
emacs/MANUAL.md
View File

@ -427,11 +427,58 @@ rather than left blank:
- a `Vec` or a pointer, which render as `<vec>` and `<ptr>` here exactly as
they do everywhere else.
**One known wrong answer.** If a function's body is redefined while the program
is stopped inside it, and the new body happens to have the same number of slots
of the same types, the frame will show the *new* names against the *old*
values. The check that should catch this does not fire. There is a failing test
pinned to it, so this is recorded rather than lurking.
**A redefined body is refused, not guessed at.** Installing a fix while the
program is stopped is deliberately allowed — it is the fix-it-and-retry loop —
so the frame on the stack and the body the daemon holds can be two bodies of
one function. A redefinition that renames a local changes neither the slot
count nor the types, and showing the new names against the old storage would be
a confident wrong answer in the one place someone is working out what went
wrong. Each frame therefore carries a fingerprint of its body's slots, and a
frame whose fingerprint no longer matches is refused by name with that reason.
Redefining one function says nothing about the others, so every untouched frame
still answers.
## The globals the stack is working on
Under the stack there is one more section: the globals this stopped stack
reaches. In this language that is often the more useful half — a game keeps
most of its state in top-level `defvar`s, and `sand.flan` holds its entire grid
that way.
It is **one section, not a fold under each frame**. A global is not part of a
frame; it is program state the frame happened to touch. Nesting it under one
would imply an ownership that is not there and would repeat the name once per
frame that reads it.
It is **scoped to the stack, not to the program**. The contents are the union
of the globals every frame on the stack references — the compiler already knows
each function's reference set, so it does the choosing. Listing all of a
program's globals instead would bury the one you want under the prelude's PRNG
state.
Each entry says **which frames touch it**, by the same number the Stack section
labels them with. That recovers what per-frame nesting would have told you —
"the whole chain is reading this" reads differently from "only the innermost
does" — at no cost in duplication. And the order is **by the innermost frame
that touches it**, because a deep stack makes the union large and proximity to
the error is what puts the likely culprit on top.
`i` works on a global line exactly as it does on a local: a global's name is an
expression, so the inspector can be pointed at it with nothing new.
Two things are said rather than left out. A global whose type the structural
printer has no arm for is refused by name with the reason. And a frame the
daemon could not attribute — one belonging to an expression you evaluated in
the break loop, a lifted handler clause, or a body redefined since it was
entered — is listed under "the union is incomplete", because a short list and a
complete list look identical if nothing says which it is.
**One hole worth knowing.** The redefinition check is a fingerprint over a
body's *slots*. A new body that names different globals while binding exactly
the same locals is not caught, and that frame's contribution will be the new
body's reference set. The values shown are still read from the program's own
storage and are still correct; what can be wrong is which frames an entry is
annotated with.
## Stopping on purpose

113
emacs/flan-cnr.el
View File

@ -80,7 +80,9 @@ from fixtures, and so `flan-dev.el' is named in one place.")
(stack
. "the program is running. A backtrace is the game thread's frame chain and it is changing while it runs, so the daemon refuses to take one [not a missing feature: ask again once it has stopped]")
(locals
. "this frame has no named locals the daemon can read. A slot the compiler invented is refused by name rather than shown as `s4', and a slot whose binding had not run when the error happened has no address yet [both are refusals with reasons, not gaps — the frame's own line says how many slots it has]"))
. "this frame has no named locals the daemon can read. A slot the compiler invented is refused by name rather than shown as `s4', and a slot whose binding had not run when the error happened has no address yet [both are refusals with reasons, not gaps — the frame's own line says how many slots it has]")
(globals
. "no frame on this stack references a global [not a gap: the section is the *union of what the frames reach*, not a listing of everything the program has, so an empty one means the state this stack is working on is all in its locals]"))
"Why a section of this buffer is empty, by name.")
(defun flan-cnr--why (key)
@ -260,6 +262,70 @@ its use, because it is a fact about the prelude.")
'mouse-face 'highlight)))))))))))
(insert "\n"))
(defun flan-cnr--insert-globals (state)
"Draw the globals the stopped stack reaches.
One section rather than a fold under each frame, and that is the design rather
than a layout choice. A global is not part of a frame — it is program state
the frame happened to touch — so nesting it under one implies an ownership that
is not there, and repeats the name once per frame that reads it.
What recovers the useful half of per-frame nesting is the annotation: each
entry says which frames touch it, by the same index the stack section numbers
them with. \"the whole chain is reading this\" and \"only the innermost is\"
are different facts and they read differently here.
The order is the daemon's, and it is by the innermost frame that touches each
one: a deep stack makes the union large, and proximity to the error is what
puts the likely culprit on top."
(flan-cnr--section "Globals this stack reaches — innermost frame first:")
(let ((globals (plist-get state :globals))
(refused (plist-get state :globals-refused))
(skipped (plist-get state :globals-skipped)))
(if (and (null globals) (null refused) (null skipped))
(insert (flan-cnr--unavailable 'globals))
(let ((w (apply #'max 1 (mapcar (lambda (g) (length (nth 0 g))) globals))))
(dolist (g globals)
(let ((start (point))
(frames (nth 3 g)))
(insert (format " %s%s %s = %s"
(nth 0 g)
(make-string (- w (length (nth 0 g))) ?\s)
(propertize (nth 1 g) 'face 'font-lock-type-face)
(nth 2 g)))
;; No frames at all should not be reachable — the daemon chooses
;; these *by* the frames that touch them — but "frame" followed by
;; nothing would be the one shape here that reads as a bug in the
;; program rather than in this line, so it says so instead.
(insert (propertize
(if (null frames) " (no frame recorded)\n"
(format " %s %s\n"
(if (cdr frames) "frames" "frame")
(mapconcat #'number-to-string frames ", ")))
'face 'shadow))
;; The same property the locals lines carry, so `i' reaches a
;; global exactly as it reaches a local: a global *is* an
;; expression in the source, which is what the inspector needs.
(add-text-properties start (point)
(list 'flan-cnr-inspect (nth 0 g)
'mouse-face 'highlight)))))
(dolist (r refused)
(insert (format " %s%s\n"
(if (string-empty-p (nth 0 r)) ""
(propertize (format "%s: " (nth 0 r)) 'face 'shadow))
(propertize (nth 1 r) 'face 'shadow))))
;; A frame the daemon could not attribute means the union above is not
;; the whole union. Said, rather than left to look like a complete
;; answer with fewer entries in it.
(when skipped
(insert (propertize
" the union is incomplete; these frames could not be attributed:\n"
'face 'font-lock-warning-face))
(dolist (s skipped)
(insert (propertize (format " %s — %s\n" (nth 0 s) (nth 1 s))
'face 'shadow))))))
(insert "\n"))
(defun flan-cnr--render (state)
"Draw STATE, a plist, into the current buffer."
(let ((inhibit-read-only t))
@ -269,6 +335,9 @@ its use, because it is a fact about the prelude.")
(flan-cnr--insert-condition state)
(flan-cnr--insert-restarts state)
(flan-cnr--insert-stack state)
;; After the stack, because it is scoped *by* the stack: the frame numbers
;; an entry is annotated with have to be on screen above it to read.
(flan-cnr--insert-globals state)
(insert (propertize
"RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n"
'face 'shadow))
@ -372,7 +441,7 @@ its use, because it is a fact about the prelude.")
(user-error
(if (get-text-property (point) 'flan-cnr-frame)
"flan: this is the frame's own line; TAB opens it, then i on a local"
"flan: point is not on a local — TAB opens a frame, i inspects a local in it")))
"flan: point is not on a local or a global — TAB opens a frame, i inspects a local in it or a global below")))
(require 'flan-inspect)
(flan-inspect expr)))
@ -442,12 +511,14 @@ anyone who would rather TAB always moved."
"What a stopped Flan program is offering."
(setq buffer-read-only t))
(defun flan-cnr-state-from-reply (reply &optional fields stack)
(defun flan-cnr-state-from-reply (reply &optional fields stack globals)
"The buffer's state, out of a `break' REPLY.
FIELDS is the condition's layout, if it was asked for and answered — a list of
(NAME TYPE VALUE), where VALUE is nil because no running program was consulted
to get it.
GLOBALS is what `flan-cnr-globals' returned, or nil.
Everything this cannot fill in is left nil deliberately: the renderer draws a
section saying why rather than leaving one out, and a section that is absent
cannot be told from one that is empty.
@ -462,7 +533,14 @@ data and the fixture-driven tests can drive it without a socket."
;; drive it with no socket. Nil is still a legitimate answer — the
;; renderer draws the reason rather than leaving the section out.
:stack stack
:locals nil))
:locals nil
;; Three keys rather than one nested structure: the renderer draws the
;; entries, the per-global refusals and the unattributable frames in
;; three different shapes, and a plist it can `plist-get' each of is
;; what keeps `flan-cnr--insert-globals' a function of its argument.
:globals (nth 0 globals)
:globals-refused (nth 1 globals)
:globals-skipped (nth 2 globals)))
(defun flan-cnr-layout (type)
"The fields of TYPE, as the renderer wants them, or nil.
@ -530,6 +608,30 @@ why this works at all while the thread is stopped."
(list (plist-get r :locals) (plist-get r :refused))
(list nil (list (list "" (or (plist-get r :message) "refused")))))))
(defun flan-cnr-globals ()
"The globals the stopped stack reaches: (ENTRIES REFUSED SKIPPED).
ENTRIES are (NAME TYPE VALUE FRAMES) rows, ordered by the innermost frame that
touches each one, with FRAMES the indices of every frame that does.
Unlike the locals, this is fetched once for the whole buffer rather than per
frame when one is opened, and that follows from what it is: a section scoped to
the stack has one answer, and asking per frame would be asking the same
question as many times as there are frames and then unioning the results here.
REFUSED is a global the structural printer had no arm for, by name and with the
reason. SKIPPED is a *frame* the daemon could not attribute — an expression's
own frame, a lifted handler clause, or a body redefined since it was entered —
which matters because it means the union is smaller than the real one. Both
are drawn rather than dropped, for the reason the whole buffer is built on: a
list that is missing something and a list that is complete look identical if
nothing says which it is."
(let ((r (funcall flan-cnr-request-function '(:op "globals"))))
(when (equal (plist-get r :status) "ok")
(list (plist-get r :globals)
(plist-get r :refused)
(plist-get r :skipped)))))
;;;###autoload
(defun flan-cnr-show ()
"Show what the stopped program is offering, in a buffer.
@ -547,7 +649,8 @@ walk from a running program."
(flan-cnr--render
(flan-cnr-state-from-reply r
(flan-cnr-layout (plist-get r :condition))
(flan-cnr-backtrace))))
(flan-cnr-backtrace)
(flan-cnr-globals))))
(pop-to-buffer buf)
buf)))

83
emacs/test-flan-cider.el
View File

@ -603,6 +603,89 @@
(test-flan--check "and the restarts are drawn anyway"
(string-match-p "\\[retry\\]" text))))
;; The globals section. One section rather than a fold under each frame, and
;; the fixtures below are what makes that visible: `grid' is touched by two
;; frames and appears once.
(let* ((state (list :condition "Boom"
:restarts '("retry")
:stack (list (list :fn "sim/inner" :loc "g.flan:12:1")
(list :fn "main" :loc "g.flan:30:1"))
;; Ordered as the daemon orders it: by the innermost frame
;; that touches each one.
:globals '(("grid" "[4 i32]" "[ 7 5 0 0]" (0 1))
("pressure" "i64" "12" (0))
("label" "string" "\"running\"" (1)))))
(buf (test-flan--cnr state))
(text (with-current-buffer buf (buffer-string))))
(test-flan--check "a global is named, typed and valued"
(string-match-p "pressure +i64 = 12" text))
(test-flan--check "and it is one section, not one per frame"
(= 1 (seq-count (lambda (l) (string-match-p "grid" l))
(split-string text "\n"))))
;; The annotation is what recovers the half per-frame nesting would have
;; told you, and it costs no duplication to say it.
(test-flan--check "a global two frames touch says both"
(string-match-p "frames 0, 1" text))
(test-flan--check "and one only the innermost touches says one"
(string-match-p "frame 0\n" text))
(test-flan--check "the innermost frame's globals come first"
(< (string-match "pressure" text) (string-match "label" text)))
;; `i' reaches a global the same way it reaches a local: a global's name is
;; an expression the program can be handed, which is the whole trick the
;; inspector is built on.
(with-current-buffer buf
(goto-char (point-min))
(test-flan--check "and a global line is inspectable"
(progn (search-forward "pressure")
(equal (get-text-property (point) 'flan-cnr-inspect)
"pressure")))))
;; Empty is a claim, not a gap: the section is the union of what the stack
;; reaches, so nothing in it means the state is all in the locals.
(let ((text (with-current-buffer
(test-flan--cnr (list :condition "Boom" :restarts '("retry")
:stack (list (list :fn "f"))))
(buffer-string))))
(test-flan--check "an empty globals section says what empty means"
(string-match-p "not available.*union of what the frames reach"
text)))
;; A frame the daemon could not attribute makes the union smaller than the real
;; one, and a list that is short without saying so is the failure this whole
;; buffer is built to avoid.
(let ((text (with-current-buffer
(test-flan--cnr
(list :condition "Boom" :restarts '("retry")
:stack (list (list :fn "f"))
:globals '(("label" "string" "\"x\"" (1)))
:globals-refused '(("weird" "no printer for (Map i64 i64)"))
:globals-skipped
'(("0: sim/inner" "this frame's body was redefined since it was entered"))))
(buffer-string))))
(test-flan--check "a global with no printer is refused by name"
(string-match-p "weird: no printer" text))
(test-flan--check "an unattributable frame says the union is incomplete"
(string-match-p "union is incomplete" text))
(test-flan--check "and names the frame it lost"
(string-match-p "0: sim/inner" text)))
;; The fetch is a function from a reply to data, like the other two, so it is
;; drivable with no socket.
(let ((flan-cnr-request-function
(lambda (_) '(:status "ok"
:globals (("g" "i64" "1" (0)))
:refused (("h" "no printer"))
:skipped (("1: m" "redefined"))))))
(let ((got (flan-cnr-globals)))
(test-flan--check "globals come back as entries, refusals and skipped frames"
(equal got '((("g" "i64" "1" (0)))
(("h" "no printer"))
(("1: m" "redefined")))))))
(let ((flan-cnr-request-function (lambda (_) '(:status "error" :message "running"))))
(test-flan--check "and a refusal is nil, not an error"
(null (flan-cnr-globals))))
(let ((flan-cnr-request-function
(lambda (_) '(:status "ok" :restarts nil :stopped nil))))
(test-flan--check "a running program is refused, by name"

233
lib/dev.ml
View File

@ -871,6 +871,236 @@ let locals t ~frame =
error ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> error m)))
(* [(:op "globals")] — the globals the stopped stack reaches, in one section.
Locals were the half the shadow stack was built for; these are arguably the
more useful half in this language. A game keeps most of its state in
top-level [defvar]s and sand.flan holds its entire grid that way, so "what
is the program's state right now" is a question about globals and there was
nowhere to ask it.
**Not per frame, and that is the design.** A global is not part of a frame —
it is program state the frame happened to touch — so nesting it under one
implies an ownership that is not there, and repeats the name once per frame
that reads it. So: one section, whose contents are the union of the globals
every frame on the current stack references.
**The compiler does the choosing.** [Reach.expr_refs] is the walk that
already computes what a function refers to — it is how the link drops a
package nothing calls — and pointed at one body it answers that body's
reference set. Listing *all* of a program's globals instead would bury the
one that matters under the prelude's PRNG state; taking only what the stack
reaches is the filter the compiler can apply and a person cannot.
Direct references only, with no transitive closure through the calls a body
makes. A callee that reads a global is either on this stack — in which case
it is contributing its own references already — or it is not, in which case
it is not part of where the program stopped.
**Each entry says which frames touch it**, by index, which is what the stack
section already numbers them by. That recovers what per-frame nesting would
have told you — "the whole chain is reading this" reads differently from
"only the innermost does" — at no cost in duplication.
**Ordered by the innermost frame that touches it.** A deep stack makes the
union large, and proximity to the error is what puts the likely culprit on
top. Ties keep declaration order, which is the order the source has them in.
**A frame that cannot be attributed contributes nothing and says so.** An
eval frame has no declaration in this session; a lifted handler clause has
none of its own; and a frame whose body has been redefined since it was
entered holds a body whose reference set is a claim about different code.
In every case the honest answer is that the union is incomplete and which
frame made it so — [:skipped] — rather than a list that silently is not the
union it says it is. The *values* would still have been right; the
attribution is what goes wrong, and attribution is what this op is for.
**And the hole in that, stated rather than papered over.**
[Emit.slot_fingerprint] hashes a body's *slots* — every slot's name with the
spelling of its type — so it catches a redefinition that binds differently
and misses one that does not. For [locals] that is exactly the right cut:
if the slots are identical then the names still describe the storage and
the answer is still true. Here it is not, because a body can change which
globals it names without touching a single slot, and then this section
shows the *new* body's reference set attributed to the *old* frame.
The values stay correct — they come from the program's storage by name —
and so does everything the other frames contribute. What can be wrong is
one frame's membership in the union and the frame numbers beside an entry.
Closing it means a second fingerprint over the reference set itself, which
is a change to [%fninfo] and to the agent that reads it; it is not done,
and the failure it leaves is narrow enough to name here rather than to
pretend away with a check that does not check it.
Nothing is copied out of the program here either, and the mechanism is one
step simpler than [locals]: a global is reached by name rather than by
address, because [Emit.redefinition] writes a global the host already has as
[external] and the dynamic linker binds the thunk to the program's own
storage. So there is no [bound_slots] round trip and no not-yet-bound case —
a global's storage exists from the moment the process started. *)
let globals_op t =
if not (alive t) then error "the program exited; restart flan dev"
else
match state t with
| Running ->
error
"the program is running; globals are read against a stopped stack, and \
the stack is what decides which of them to show"
| Unreachable m -> error ("cannot ask the program for its globals: " ^ m)
| Stopped _ ->
(match backtrace t with
| Error m -> error ("the program refused to say where it is: " ^ m)
| Ok (frames, _) ->
let all = t.session.Session.program.Tast.globals in
let is_global n =
List.exists (fun (g : Tast.global) -> String.equal g.Tast.gname n) all
in
(* name -> the frame indices that reference it, innermost lowest *)
let touched : (string, int list) Hashtbl.t = Hashtbl.create 32 in
let skipped = ref [] in
List.iteri
(fun i (name, _, mine, nslots, sig_) ->
let skip why =
skipped := (Printf.sprintf "%d: %s" i name, why) :: !skipped
in
if not mine then
skip
"a frame of the expression this break is inside, not of the \
program; its thunk is not part of the session, so there is no \
record of what it refers to"
else
match find_fn t name with
| None ->
skip
"not a function this session holds; a lifted handler clause \
has no declaration of its own to read references from"
| Some fn ->
if nslots <> Array.length fn.Tast.slots then
skip
"the frame is running a body that has been redefined \
since, so what this session holds is a different body's \
reference set"
else if sig_ <> Emit.slot_fingerprint fn then
skip
"this frame's body was redefined since it was entered, so \
what it refers to here is a claim about different code"
else begin
(* Once per frame per name: a body that reads the grid in
four places touches it once as far as this is
concerned. *)
let seen = Hashtbl.create 8 in
let note n =
if is_global n && not (Hashtbl.mem seen n) then begin
Hashtbl.add seen n ();
let prev =
try Hashtbl.find touched n with Not_found -> []
in
Hashtbl.replace touched n (prev @ [ i ])
end
in
List.iter (Reach.expr_refs note) fn.Tast.body;
List.iter (Reach.expr_refs note) fn.Tast.fdefers
end)
frames;
let skipped = List.rev !skipped in
let wanted =
(* Declaration order first, so a tie on the innermost frame breaks
the way the source reads. [stable_sort] then keeps it. *)
List.filter
(fun (g : Tast.global) -> Hashtbl.mem touched g.Tast.gname)
all
in
let innermost (g : Tast.global) =
List.fold_left min max_int (Hashtbl.find touched g.Tast.gname)
in
let ordered =
List.stable_sort
(fun a b -> compare (innermost a) (innermost b))
wanted
in
let where (g : Tast.global) =
Wire.list
(List.map string_of_int
(List.sort_uniq compare (Hashtbl.find touched g.Tast.gname)))
in
let skipped_field =
":skipped "
^ Wire.list
(List.map
(fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ])
skipped)
in
if ordered = [] then
ok
[ ":globals ()"; ":refused ()"; skipped_field;
":note "
^ Wire.quote
"no frame on this stack references a global; there is \
nothing here that is not already in the locals" ]
else begin
let c, refused = Session.render_globals t.session ~globals:ordered in
let before = match result t with Some (g, _) -> g | None -> 0L in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "g%d.so" t.n) in
match Build.shared
~opts:{ Build.default with Build.dev = true;
Build.debug = t.session.Session.debug }
~ir:c.Session.ir ~out () with
| _ ->
(match deliver t out with
| "ok" ->
let rec wait ms =
match result t with
| Some (g, v) when Int64.compare g before > 0 -> Some v
| _ when ms <= 0 -> None
| _ ->
ignore (Unix.select [] [] [] 0.005);
if alive t then wait (ms - 5) else None
in
(match wait 5000 with
| Some v ->
(* One line per global, name and type and value, tab
separated — safe because every string the renderer emits
is escaped. The frames are added back here, from the
table above, because the thunk knows nothing about the
stack it was chosen for. *)
let by_name = Hashtbl.create 32 in
List.iter
(fun (g : Tast.global) ->
Hashtbl.replace by_name g.Tast.gname (where g))
ordered;
let entries =
List.filter_map
(fun line ->
match String.split_on_char '\t' line with
| [ n; ty; value ] ->
Some
(Wire.list
[ Wire.quote n; Wire.quote ty; Wire.quote value;
(try Hashtbl.find by_name n
with Not_found -> Wire.list []) ])
| _ -> None)
(String.split_on_char '\n' v)
in
ok
[ ":globals " ^ Wire.list entries;
":refused "
^ Wire.list
(List.map
(fun (n, why) ->
Wire.list [ Wire.quote n; Wire.quote why ])
refused);
skipped_field ]
| None ->
error
"the program did not reach a frame boundary; is it calling \
(agent/poll)?")
| reply -> error ("the program refused the module: " ^ reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e))
| exception Failure m -> error m
end)
(* A choice is validated by the *program*, on its listener thread, against a
stack the stopped game thread is holding still — not here. The daemon has no
copy of that stack and anything it checked would be a guess that was true a
@ -1262,6 +1492,9 @@ let handle t req =
| Some "backtrace" -> backtrace_op t
| Some "locals" ->
locals t ~frame:(match Wire.int_field req "frame" with Some n -> n | None -> 0)
(* No :frame, and that is the point: the section is the stack's, not a
frame's. See [globals_op]. *)
| Some "globals" -> globals_op t
| Some "layout" ->
(match Wire.string_field req "type" with
| Some ty -> layout t ~ty

84
lib/session.ml
View File

@ -553,6 +553,90 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
(* ── The globals a stopped stack reaches ───────────────────────────── *)
(* The other half of what a break loop can show, and in this language arguably
the more useful one: a game keeps most of its state in top-level [defvar]s,
and sand.flan holds its entire grid that way.
Almost the same thunk as [render_locals] with a different root, and the
difference is the whole reason this is a second function rather than a
parameter. A local is reached by *address* — [flan/dev-slot] hands back
where the frame is, and only the stopped program knows that. A global is
reached by *name*: [Emit.redefinition] writes a global the host already has
as [external], so the loaded module binds to the program's own storage and
the dynamic linker does the work. Nothing has to be asked of the stopped
thread at all, which is also why there is no [bound] list here — a global's
storage exists from the moment the process started, so there is no
not-yet-bound case to refuse.
[globals] is chosen by the caller and not here, because the choice is about
the *stack* and this function is about rendering. See [Dev.globals_op].
One line per global — name, type, value, tab separated — the same framing
[render_locals] uses, and safe for the same reason: every string the
renderer emits goes through [flan_dev_emit_str], which escapes both. *)
let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
: change * (string * string) list =
let loc = Loc.unknown in
let extra = ref [] and nslots = ref 0 in
let c =
{ Render.structs = t.program.Tast.structs;
enums = Hashtbl.fold (fun k v acc -> (k, v) :: acc) t.env.Check.enums [];
emit = dev_emitter;
alloc = (fun ty ->
let i = !nslots in
incr nslots;
extra := ty :: !extra;
i) }
in
let bytes_of str =
{ Tast.e =
Tast.Prim (Tast.Bytes, [ { Tast.e = Tast.Str str; ty = Types.String; loc } ]);
ty = Types.Slice (Types.Int Types.U8); loc }
in
let lit str = c.Render.emit.Render.ebytes (bytes_of str) in
let nullary n = { Tast.e = Tast.Call (n, []); ty = Types.Unit; loc } in
let refused = ref [] in
let one (g : Tast.global) =
let v = { Tast.e = Tast.Global g.Tast.gname; ty = g.Tast.gty; loc } in
match Render.render c 0 v with
| parts ->
Some
((lit (g.Tast.gname ^ "\t" ^ Types.to_string g.Tast.gty ^ "\t") :: parts)
@ [ lit "\n" ])
| exception Loc.Error (_, why) ->
(* A type the structural printer has no arm for. Named with its reason
rather than left out, for [render_locals]'s reason: a global that is
missing and a global that could not be printed are different facts,
and a list that showed neither would be the same lie twice. *)
refused := (g.Tast.gname, why) :: !refused;
None
in
let body = List.concat (List.filter_map one globals) in
t.thunks <- t.thunks + 1;
let name = Printf.sprintf "globals/%d" t.thunks in
let thunk : Tast.fn =
{ Tast.name; params = []; ret = Types.Unit;
body = (nullary "flan/dev-begin" :: body) @ [ nullary "flan/dev-end" ];
fdefers = []; fparent = None; floc = loc;
slots = Array.of_list (List.rev !extra);
(* Every slot in here is the walk's own scratch: what is being shown is
the program's storage, which this thunk reaches by name. *)
snames = Array.make (List.length !extra) None }
in
let program =
{ t.program with
Tast.fns = t.program.Tast.fns @ [ thunk ];
externs = t.program.Tast.externs @ externs }
in
let ir =
Emit.redefinition ~dev:true ~debug:t.debug ~known:(known t) ~call:name
program ~fns:[ name ]
in
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
let eval_expr ?(origin = "<eval>") t src : change =
let form =
match Reader.read_all ~file:origin src with

39
test/programs/dev-globals.flan Normal file
View File

@ -0,0 +1,39 @@
;;;; A program that stops with state worth looking at *outside* the frame.
;;;;
;;;; dev-locals.flan is about what one frame holds. This is about what the
;;;; whole stopped stack is reading, which in this language is most of the
;;;; program: a game keeps its state in top-level defvars, and sand.flan holds
;;;; its entire grid that way.
;;;;
;;;; The globals are declared in an order the answer must *not* come back in.
;;;; [label] is written first and is touched only by [main], the outer frame,
;;;; so ordering by the innermost frame that touches it has to put it last;
;;;; [grid] and [pressure] are both innermost-touched and must keep the order
;;;; they are declared in. [untouched] is read by no frame on the stack and
;;;; must not appear at all — that is the whole claim of scoping the section to
;;;; the stack rather than listing everything the program has.
(import agent "vendor:agent")
(defstruct Boom [why i32])
(defvar label string)
(defvar grid [4 i32])
(defvar pressure i64)
(defvar untouched i64 99)
;; The inner frame. It writes two globals and then errors with nothing
;; handling the condition, so the program stops here with [main] under it.
(defn inner [] i64
(set pressure 12)
(set (at grid 0) 7)
(error (Boom {.why 3}))
0)
(defn main [] i32
(agent/start "/tmp/flan-dev-globals-fallback.sock")
(set label "running")
(set (at grid 1) 5)
(print (inner)) (println "")
(dotimes [i 4000]
(agent/wait 5))
0)

163
test/test_dev.ml
View File

@ -884,6 +884,169 @@ let () =
end
end;
(* ── The globals a stopped stack reaches ───────────────────────── *)
(* The other half of what a break loop can show. Locals are one frame's;
these are the program's, and the question is which of them to show:
all of a program's globals would bury the one that matters under the
prelude's PRNG state, and per-frame nesting would imply an ownership a
global does not have and repeat the name once per frame that reads it.
So: one section, the union of what every frame on the stack references,
each entry saying which frames touch it, ordered by the innermost one
that does. [dev-globals.flan] is built so that all three of those
claims fail visibly if any of them is dropped. *)
let gsock = tmp "globals.sock" and gout = tmp "globals.out" in
(try Sys.remove gsock with Sys_error _ -> ());
let gfd = Unix.openfile gout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let gpid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-globals.flan"; "-s"; gsock |]
Unix.stdin gfd Unix.stderr
in
Unix.close gfd;
if not (await (fun () -> Sys.file_exists gsock)) then begin
fail "the globals daemon never listened";
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ())
end
else begin
let c = connect gsock in
let ask sexp = Wire.parse (Wire.send c sexp; Wire.recv c) in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
fail "the globals program never stopped"
else begin
(* (name type value (frame ...)) — four fields, the fourth a list of
numbers, which is what makes the annotation readable against the
stack section's own numbering. *)
let rows r =
match Wire.field r "globals" with
| Some { Form.v = Form.List l; _ } ->
List.filter_map
(fun (e : Form.t) ->
match e.Form.v with
| Form.List [ { Form.v = Form.Str n; _ };
{ Form.v = Form.Str ty; _ };
{ Form.v = Form.Str v; _ };
{ Form.v = Form.List fs; _ } ] ->
Some
(n, ty, v,
List.filter_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.Int i -> Some (Int64.to_int i)
| _ -> None)
fs)
| _ -> None)
l
| _ -> []
in
let r = ask "(:op \"globals\")" in
if status r <> "ok" then
fail "globals: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"))
else begin
let want =
(* [grid] before [pressure] because that is the order they are
declared in and both are touched by frame 0; [label] last
because the innermost frame that touches it is 1, even though
it is declared before either. Ordering by proximity to the
error is what puts the likely culprit on top of a deep stack,
and declaring [label] first is how this notices that the sort
happened at all.
[grid]'s two writes are the two frames: [main] set element 1
before calling, [inner] set element 0 after. The value is read
out of the program's own storage, so both are in it. *)
[ ("grid", "[4 i32]", "[ 7 5 0 0]", [ 0; 1 ]);
("pressure", "i64", "12", [ 0 ]);
("label", "string", "\"running\"", [ 1 ]) ]
in
let got = rows r in
if got <> want then
fail "the globals of the stopped stack: %s"
(String.concat ", "
(List.map
(fun (n, ty, v, fs) ->
Printf.sprintf "%s %s = %s (%s)" n ty v
(String.concat " " (List.map string_of_int fs)))
got));
(* And the one that must not be there. [untouched] is a global of
this program that no frame on this stack reads, and a section
that listed it would be the "all the globals" answer this op
exists instead of. The prelude's own globals are the same claim
at scale: [rand-state] is in the session too. *)
if List.exists (fun (n, _, _, _) -> n = "untouched") got then
fail "a global no frame on the stack references was listed anyway";
if List.exists (fun (n, _, _, _) -> n = "rand-state") got then
fail "the prelude's globals were listed; the section is not scoped \
to the stack"
end;
(* A frame whose body has been redefined since it was entered cannot
be attributed: what this session holds is a different body's
reference set. It is named in [:skipped] rather than dropped,
because "the union is incomplete and here is why" and "these are
all of them" are different answers.
The redefinition binds a local, deliberately, because that is what
the detector can see. [Emit.slot_fingerprint] hashes a body's
*slots*, so a new body with the same slots and different global
references is not caught — the hole is stated in BUILT.md, and a
test that asserted otherwise would be asserting a mechanism that is
not there. *)
let r =
ask
"(:op \"eval\" :code \"(defn inner [] i64 (let [z (i64 1)] (set untouched z)) (error (Boom {.why 3})) 0)\" :file \"/tmp/buf.flan\")"
in
if status r <> "ok" then
fail "installing a new body while stopped: %s"
(Option.value ~default:"" (Wire.string_field r "message"))
else begin
let r = ask "(:op \"globals\")" in
if status r <> "ok" then
fail "globals after a redefinition: %s"
(Option.value ~default:(status r) (Wire.string_field r "message"));
let skipped =
match Wire.field r "skipped" with
| Some { Form.v = Form.List l; _ } -> List.length l
| _ -> 0
in
if skipped = 0 then
fail "the frame of a superseded body was attributed anyway";
(* [main] is untouched by that redefinition and must still
contribute: a refusal that fired for every frame would pass the
check above and make the whole verb useless. *)
let got = rows r in
if not (List.exists (fun (n, _, _, _) -> n = "label") got) then
fail "redefining one function dropped an untouched frame's globals";
(* And the new body's references must not have leaked in under the
old frame. [untouched] is what the installed body reads and the
frame on the stack does not. *)
if List.exists (fun (n, _, _, _) -> n = "untouched") got then
fail "a superseded frame contributed the *new* body's references"
end
end;
(* Nothing handled the condition, so there is no restart to resume by
and [abort] is the only way out. The daemon owns the program's
lifetime, so it comes down on its own. *)
ignore (ask "(:op \"abort\")");
Unix.close c;
if not
(await ~ms:5000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] gpid with
| 0, _ -> false
| _ -> true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] gpid) with Unix.Unix_error _ -> ())
end
end;
(* ── Disassembly ───────────────────────────────────────────────── *)
(* A third daemon, over a program that keeps running, because the two