The inspector buffer is the value, and a commit is a diff
`e` on a line sets that field: prompted with what is there, sending a Flan expression that the program evaluates and the checker measures against the type of the place it is going into. `C-c C-e` turns the buffer into the value — the Flan literal the program wrote, which is the value's own spelling and not a second notation invented for editing it — and `C-c C-c` commits, `C-c C-k` abandons. A commit is a diff. The buffer is read back as a value, compared leaf by leaf with what was drawn, and one write goes out per leaf that changed, so editing one field does not rewrite the others with whatever was on the screen. A shape that changed is a refusal and it voids the edits collected before it: the walk visits fields in order, so a struct with one good change and one impossible one has already collected the good one, and handing that back beside the refusal would make it possible to send half of what was asked for. The truncation guard is the one that is easy to miss. `...` is what the renderer writes where it stopped, and a commit read off a buffer holding one could not tell a field that was never written from one somebody deleted — so such a value refuses to be opened for editing at all. Writing is refused on the expression and address roots, by name. An expression is evaluated wherever the evaluator stands and whenever it next reaches a frame boundary, which for a write means possibly into a running program; globals stay unwritable from here until they have a root that names a stop. test-flan.el runs the whole chain against a real daemon — a frame, a slot index off the listing, a render, a set, a re-read, a typed refusal, an edited buffer, a commit, and a commit against a stop the program has left.
This commit is contained in:
parent
37f8f77380
commit
416ce10ee7
@ -4501,6 +4501,97 @@ expression root with an effect in it would fire once a second for ever.
|
||||
is a symbol on the wire and would be read as a step, so there is no way for a client in that language to spell `()`.
|
||||
The daemon reads a missing `:path` — and `nil` — as the slot itself.
|
||||
|
||||
## Writing one of them back, and the difference between a stop and being stopped
|
||||
|
||||
SLY sets a value from its inspector; this does that and then the thing the author actually wanted, which is the buffer
|
||||
*being* the value. Both are `(:op "set" :frame N :slot I :path (...) :edits (...) :at-stop G)` — one edit for `e` on a
|
||||
line, one per changed leaf for a committed buffer — and both are refused whole if any single edit is impossible.
|
||||
|
||||
**The addressing is `inspect`'s, to the letter**, and that is not economy. Same `stopped_frame`, same slot index, same
|
||||
`Session.step_into`, read by the same wire parser. A write that addressed values its own way would be free to land
|
||||
somewhere the render above it never showed, which is exactly the stale-slot answer both verbs exist to refuse. What is
|
||||
new is that the walk has to end at a **place** rather than a value, and that the value being stored is an expression
|
||||
somebody typed, checked against the type the walk ended at.
|
||||
|
||||
### `stopped_only` is not enough for a write, and the gap is not small
|
||||
|
||||
The gate at `flan_agent_poll` asked `j.stopped_only && depth <= 0` — "is the program stopped". For a *read* that is the
|
||||
whole question: the worst a render can do against the wrong stop is print something that was true of a different frame,
|
||||
into a buffer nobody stores anywhere.
|
||||
|
||||
A write is not that. A module that stores through `flan/dev-slot` reaches its target through whatever snapshot is on
|
||||
top when the store runs. Resume and stop again inside the build window — ~300ms of `llc`, and a game that breaks every
|
||||
frame closes it without trying — and `depth > 0` is true again, the job is accepted, and the store lands in the same
|
||||
slot index of a different stack. Not a fault: a plausible shape, in the wrong place, silently. Nothing already here
|
||||
catches it. The slot fingerprint does not: the same function re-entered has the same fingerprint. The refusal counter
|
||||
does not: it counts jobs that were *dropped*, and this one is not.
|
||||
|
||||
So a write names the **stop** and not the state. `snap_push` has minted a monotone, never-reused generation since the
|
||||
restart machinery needed one for the same reason, and it travels on the request as `at-stop N ` beside `stopped-only `
|
||||
— in front of the path rather than inside the module, for `stopped_only`'s own reason: what is stopped-only, or
|
||||
addressed to one stop, is the *question* and not the code. A new `stop` verb answers the current one (0 while
|
||||
running), `inspect` carries it out on every reply, and it is checked twice:
|
||||
|
||||
- in the daemon, before anything is built, so a stale buffer refuses in a tenth of the time and the sentence names the
|
||||
buffer rather than the module;
|
||||
- in the agent, on the game thread, at the moment the job is claimed — which is the check that makes it *sound*, since
|
||||
everything between the two takes time.
|
||||
|
||||
The two drops say different sentences, because the fixes differ. Resumed: stop it again. Re-stopped: stopping it again
|
||||
does nothing, and what is wanted is to look at what is there now.
|
||||
|
||||
### Three refusals about where, above both backends
|
||||
|
||||
`Session.step_into` builds four shapes and three of them are places. The fourth is named in `session.ml` rather than
|
||||
left to a backend, because `emit`'s `place` would `failwith` on an Option — it derives the type through `Named n` —
|
||||
and `x86`'s `field_loc` handles one fine. Two backends disagreeing about what is writable is worse than either answer.
|
||||
|
||||
Each refusal gives the reason about the *program*, not about the compiler. A data type's case field: which case the
|
||||
bytes are in is the tag, so there is no address to store to that does not also settle it. An option's payload: storing
|
||||
past the tag leaves a `None` holding a value nothing will ever look at. A pointer: an address typed into a prompt is
|
||||
one the editor made up, nothing blessed it, and the program would dereference it at a moment nobody chose — which is
|
||||
the read half's rule said in the other direction.
|
||||
|
||||
### `Check.expression` grew a `want`, and `Check.expressions` a shared frame
|
||||
|
||||
The first is why `3` into an `f32` field is an f32 three. Without an expectation the literal takes its default width
|
||||
and the store is refused for a mismatch the reader never wrote; with one it arrives at the place's type, and what stays
|
||||
refused is what really does not fit — in the checker's own words, which is the only place that sentence should be
|
||||
written down.
|
||||
|
||||
The second is the batch. Two expressions checked apart both number their slots from zero, so splicing them into one
|
||||
thunk would have the second one's `let` reading and writing the first one's storage: a frame that is two frames wearing
|
||||
one frame's clothes. There is exactly one allocator of slot indices in this compiler and it is `ctx`'s counter, so
|
||||
sharing the `ctx` is the whole of the fix.
|
||||
|
||||
The thunk stores and then **renders the same place**, between the same `dev-begin`/`dev-end` the read half uses. What
|
||||
comes back is therefore not the editor's idea of what it asked for; it is what is there afterwards, read by the printer
|
||||
that drew the buffer. One job also means the store and the reading of it cannot straddle a resume. `retains` is left at
|
||||
its default: a module that stores a string literal leaves the program pointing into that module's image, and the
|
||||
default is what keeps the mapping alive for it.
|
||||
|
||||
### The buffer as the value
|
||||
|
||||
A rendered Flan value is a Flan literal, so the editable form of the value is the value's own spelling — no second
|
||||
notation, nothing to translate. `flan-inspect--literal` lays it out over lines and round-trips through
|
||||
`flan-inspect-parse`, which is what makes a commit a comparison of two *parses* rather than of two strings.
|
||||
|
||||
A commit is a diff and not a blast. One write per changed leaf, so editing one field of a struct does not rewrite the
|
||||
others with whatever was on the screen — which matters exactly when it is hardest to see that it does. A shape that
|
||||
changed is a refusal rather than an edit, and the refusal voids the edits that were collected before it: the walk
|
||||
visits fields in order, so a struct with one good change and one impossible one has already collected the good one, and
|
||||
handing that back beside the refusal would make it possible to send half of what was asked for.
|
||||
|
||||
The one guard that is easy to miss: a value the renderer truncated cannot be opened for editing at all. `...` is what
|
||||
it writes where it stopped, and a commit read off a buffer containing one could not tell a field that was never written
|
||||
from a field somebody deleted.
|
||||
|
||||
**Writing is refused on the expression and address roots**, by name. Not an omission to be worked around by sending
|
||||
`(set …)` to be evaluated: an expression is evaluated wherever the evaluator stands and at whatever moment it next
|
||||
reaches a frame boundary, which for a write means possibly into a running program. That leaves globals unwritable from
|
||||
the inspector for now, since the break buffer roots them at an expression — `C-x C-e` on `(set the-global …)` does that
|
||||
write knowingly, and the inspector will not do it behind a key that looks like the safe one.
|
||||
|
||||
## The watch window, and why it is the only listing that is pushed
|
||||
|
||||
The port of the author's Clojure `watch.el`, with the good idea kept and the transport turned round. The original is
|
||||
|
||||
@ -376,6 +376,8 @@ per line.
|
||||
| `g` | read it again |
|
||||
| `TAB` / `n` | next field |
|
||||
| `S-TAB` / `p` | previous field |
|
||||
| `e` | set the field at point |
|
||||
| `C-c C-e` | open the value for editing |
|
||||
| `q` | close |
|
||||
|
||||
Two things worth knowing, because they are unlike other inspectors.
|
||||
@ -443,6 +445,83 @@ root; `RET` only ever lengthens the path under the root already in hand; and
|
||||
starting a new root starts an empty stack. So a stack with both kinds in it
|
||||
cannot be built, and `l` has nothing to cross into.
|
||||
|
||||
### Changing one — `e`, and `C-c C-e`
|
||||
|
||||
The inspector writes as well as reads, and the loop it is for is the one the
|
||||
whole dev story is about: "that field is wrong" and "is it *this* value that
|
||||
fixes it" are two keystrokes apart, where editing the source and reloading
|
||||
answers a different question — it answers what the **next** run does.
|
||||
|
||||
**`e`** sets the field or element at point. You are prompted with what is there
|
||||
now, and what you type is a Flan **expression**, evaluated in the program and
|
||||
checked against the type of the place it is going into. `(+ 1 2)`, a string
|
||||
literal, a whole struct literal all work; one that does not fit comes back with
|
||||
the checker's own sentence — *expected f32, found string* — and nothing is
|
||||
stored. A literal arrives at the place's width, so `3` into an `f32` field is
|
||||
three point oh and not a refusal you would have had to write `3.0` to avoid.
|
||||
Point on no field line at all sets the whole value, which is how a data type's
|
||||
case is changed.
|
||||
|
||||
**`C-c C-e`** turns the buffer into the value. What you get is the Flan literal
|
||||
the program wrote — the value's own spelling, with no second notation to learn
|
||||
— and you edit it as text. **`C-c C-c`** commits; **`C-c C-k`** throws it away.
|
||||
|
||||
A commit is a **diff**, not a blast. The buffer is read back as a value,
|
||||
compared leaf by leaf with what was drawn, and one write is sent per leaf that
|
||||
changed — so editing one field of a struct does not rewrite the others with
|
||||
what happened to be on your screen. Every write in a commit goes in **one**
|
||||
module: either all of them happened at this stop, or none did.
|
||||
|
||||
What it refuses, and each by name with the reason:
|
||||
|
||||
- **A shape that changed.** Adding or removing an element, adding or renaming a
|
||||
field, putting a number where a struct was, changing which case a data type
|
||||
holds. Those are changes to the container or to the tag, not stores into
|
||||
storage. `e` on the value sets it whole, which is the operation that *is*
|
||||
available.
|
||||
- **A value the renderer did not write.** `<ptr>`, `<Name>`, and the `...` the
|
||||
walk writes where it stopped at its depth or span bound. A buffer with one of
|
||||
those in it is a buffer missing part of the value, and a commit read off it
|
||||
could not tell a field that was never written from one you deleted — so the
|
||||
value refuses to be opened for editing at all.
|
||||
- **A pointer.** An address typed into a prompt is one the editor made up.
|
||||
Nothing blessed it and the program would dereference it at a moment nobody
|
||||
chose; the read half does not follow pointers either.
|
||||
- **An option's payload on its own.** The tag is what says whether there is
|
||||
one. Set the option.
|
||||
|
||||
### What makes writing safe
|
||||
|
||||
Writing is refused outright on the expression and address roots. Only the
|
||||
**frame and slot** root can be written to, and the reasons are what the whole
|
||||
feature rests on.
|
||||
|
||||
The program must be **stopped**, because a poke into storage the program is
|
||||
mutating is corruption with a plausible shape. But "stopped" is not enough on
|
||||
its own: a write is built by a compiler, and a third of a second of `llc` is
|
||||
long enough for a game to resume, run a frame, and stop again. The same slot
|
||||
index of a different stack is not the place you were looking at.
|
||||
|
||||
So a write names the **stop** it was addressed to, not the state. Every
|
||||
inspection carries the number of the stop it was read at; a write hands that
|
||||
number back; and it is checked twice — here, before anything is built, so a
|
||||
stale buffer refuses in a tenth of the time and names the buffer rather than
|
||||
the module, and again inside the program, on the game thread, at the moment the
|
||||
module is claimed. A program that went round its loop between the drawing and
|
||||
the commit refuses with *look again and re-do the edit*, which is the whole of
|
||||
the fix.
|
||||
|
||||
The read-only view stays the default. `e` and `C-c C-e` are there when the root
|
||||
can carry them, and the key legend at the foot of the buffer lists them only
|
||||
then — a legend offering a key that would refuse is advertising a refusal.
|
||||
|
||||
A **global** is not writable from here yet: the break buffer roots globals at an
|
||||
expression, and an expression is evaluated wherever the evaluator stands and
|
||||
whenever it next reaches a frame boundary, which for a write means possibly
|
||||
into a running program. `C-x C-e` on `(set the-global …)` does that write
|
||||
knowingly; the inspector will not do it behind a key that looks the same as the
|
||||
safe one.
|
||||
|
||||
### Where the memory went — `M-x flan-allocations` and `M-x flan-leaks`
|
||||
|
||||
The same registry, read as a table rather than at one address. **`M-x
|
||||
|
||||
@ -96,6 +96,7 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'seq)
|
||||
(require 'subr-x)
|
||||
|
||||
@ -420,6 +421,21 @@ whole.")
|
||||
Only the slot root answers with one — it is walking a type, so it knows. An
|
||||
expression root gets back a rendering and nothing else, and the rendering of
|
||||
an atom does not carry its type.")
|
||||
(defvar-local flan-inspect--rendered nil
|
||||
"What the program wrote, before it was parsed.
|
||||
Kept because it is the thing edit mode hands you: a Flan literal is what the
|
||||
renderer writes, so the buffer you type into is the value's own spelling and
|
||||
not a second notation invented for editing it.")
|
||||
(defvar-local flan-inspect--at-stop nil
|
||||
"Which stop this buffer was drawn at, as the daemon numbered it.
|
||||
Nil where the reply did not say — only the slot root does, because only it
|
||||
reads from a frame, and only what is read from a frame can be written back.
|
||||
A write carries this number, and the program refuses it if it has been round
|
||||
its loop and stopped again since: what is on the screen would then describe
|
||||
storage that has moved, and overwriting it would be aimed at nothing anybody
|
||||
looked at.")
|
||||
(defvar-local flan-inspect--editing nil
|
||||
"Non-nil while this buffer is the value rather than a listing of it.")
|
||||
|
||||
(defun flan-inspect--label (child)
|
||||
"How CHILD is named in the list: `0.' for an element, `.x' for a field.
|
||||
@ -571,8 +587,12 @@ DECLARED is the type the daemon named, when it named one."
|
||||
(flan-inspect-refusal node root))
|
||||
'face 'font-lock-comment-face)))))
|
||||
(insert "\n")
|
||||
;; The write keys are only listed where they would work. A legend that
|
||||
;; offered `e' on an expression root would be advertising a refusal.
|
||||
(insert (propertize
|
||||
"RET inspect l back g refresh TAB/n next p previous q quit\n"
|
||||
(if (flan-inspect--writable)
|
||||
"RET inspect l back g refresh TAB/n next p previous q quit\n"
|
||||
"RET inspect e set C-c C-e edit l back g refresh TAB/n next p previous q quit\n")
|
||||
'face 'shadow))
|
||||
(goto-char (point-min))))
|
||||
|
||||
@ -616,10 +636,17 @@ and whether that may be followed is the answer"))
|
||||
(_ (user-error "flan: %S is not a root this inspector knows" root)))))
|
||||
(unless (equal (plist-get r :status) "ok")
|
||||
(user-error "flan: %s" (or (plist-get r :message) "refused")))
|
||||
(cons (or (plist-get r :value)
|
||||
(user-error "flan: the program answered without a value for %s"
|
||||
(flan-inspect--root-label root path)))
|
||||
(plist-get r :type))))
|
||||
(list :value (or (plist-get r :value)
|
||||
(user-error
|
||||
"flan: the program answered without a value for %s"
|
||||
(flan-inspect--root-label root path)))
|
||||
:type (plist-get r :type)
|
||||
;; The stop the read happened at, where the reply carried one. It
|
||||
;; travels with the value rather than being asked for separately,
|
||||
;; because asked separately it would be a second question about a
|
||||
;; different instant — and the whole use of the number is that it is
|
||||
;; true of *what is on the screen*.
|
||||
:at-stop (plist-get r :at-stop))))
|
||||
|
||||
(defun flan-inspect--show (root path &optional stack)
|
||||
"Render ROOT walked by PATH in the inspector buffer, with STACK behind it."
|
||||
@ -629,9 +656,12 @@ and whether that may be followed is the answer"))
|
||||
(unless (derived-mode-p 'flan-inspect-mode) (flan-inspect-mode))
|
||||
(setq flan-inspect--root root)
|
||||
(setq flan-inspect--path path)
|
||||
(setq flan-inspect--node (flan-inspect-parse (car answer)))
|
||||
(setq flan-inspect--type (cdr answer))
|
||||
(setq flan-inspect--rendered (plist-get answer :value))
|
||||
(setq flan-inspect--node (flan-inspect-parse flan-inspect--rendered))
|
||||
(setq flan-inspect--type (plist-get answer :type))
|
||||
(setq flan-inspect--at-stop (plist-get answer :at-stop))
|
||||
(setq flan-inspect--stack stack)
|
||||
(setq flan-inspect--editing nil)
|
||||
(flan-inspect--render root path flan-inspect--node stack
|
||||
flan-inspect--type))
|
||||
(display-buffer buf)
|
||||
@ -769,6 +799,356 @@ someone asked for reads very differently from one a timer produced."
|
||||
flan-inspect--stack)
|
||||
(with-current-buffer flan-inspect-buffer (goto-char (min p (point-max))))))
|
||||
|
||||
;;; Writing one back
|
||||
|
||||
;; SLY sets a value from its inspector, and the reason it is worth having here
|
||||
;; is the reason the read half exists: the loop between "that field is wrong"
|
||||
;; and "is it this value that fixes it" is the loop the whole dev story is
|
||||
;; about, and changing the source and reloading answers a different question —
|
||||
;; it answers what the *next* run does.
|
||||
;;
|
||||
;; Two ways in, and they are the same request underneath. `e' on a line sets
|
||||
;; one field. `C-c C-e' turns the buffer into the value itself, you edit it
|
||||
;; like text, and `C-c C-c' sends one write per leaf you changed. Both end in
|
||||
;; `(:op "set")' with a list of (path, expression) edits, both are refused
|
||||
;; whole if any one edit is impossible, and both redraw from what the program
|
||||
;; holds afterwards rather than from what was typed.
|
||||
;;
|
||||
;; What makes writing defensible at all is that the program is stopped and
|
||||
;; stays stopped. The daemon checks that, the agent checks it again on the
|
||||
;; game thread at the moment the module is claimed, and the *stop* is named
|
||||
;; rather than the state — so a program that resumed and stopped again between
|
||||
;; the drawing and the commit refuses, instead of storing into the same slot
|
||||
;; index of a stack nobody looked at.
|
||||
|
||||
(defun flan-inspect--writable (&optional what)
|
||||
"Why this buffer cannot be written to, or nil if it can.
|
||||
WHAT names the operation in the refusal."
|
||||
(let ((what (or what "a write")))
|
||||
(cond
|
||||
((null flan-inspect--root) "nothing is being inspected")
|
||||
;; The write verb roots at a frame slot and has no other root. That is
|
||||
;; not an omission to be worked around here by sending `(set …)' to be
|
||||
;; evaluated: an expression is evaluated wherever the evaluator stands and
|
||||
;; at whatever moment it gets a frame boundary, which for a *write* means
|
||||
;; storing into a program that is very possibly running — the one thing
|
||||
;; this must not do. So it is refused, with the root that can.
|
||||
((not (eq (car-safe flan-inspect--root) :slot))
|
||||
(format "%s roots at a frame's slot, and this buffer is on %s. \
|
||||
`i' on a local in the break buffer gives the root that can be written to"
|
||||
what
|
||||
(if (eq (car-safe flan-inspect--root) :addr)
|
||||
"an address"
|
||||
"an expression")))
|
||||
((not (and (integerp flan-inspect--at-stop) (> flan-inspect--at-stop 0)))
|
||||
(format "%s has to name the stop it was read at, and this drawing \
|
||||
carries none. Press `g' to read it again" what))
|
||||
(t nil))))
|
||||
|
||||
(defun flan-inspect--send (edits)
|
||||
"Store EDITS, a list of (STEPS . CODE), into what this buffer is showing.
|
||||
STEPS are relative to the buffer's own path. Redraws from the reply, which is
|
||||
the program's storage read back and not an echo of what was sent."
|
||||
(let* ((root flan-inspect--root)
|
||||
(path flan-inspect--path)
|
||||
(stack flan-inspect--stack)
|
||||
(frame (nth 1 root))
|
||||
(slot (nth 2 root))
|
||||
(r (funcall
|
||||
flan-inspect-request-function
|
||||
(append
|
||||
(list :op "set" :frame frame :slot slot)
|
||||
(when path
|
||||
(list :path (mapcar #'flan-inspect-wire-step path)))
|
||||
(list :at-stop flan-inspect--at-stop
|
||||
:edits
|
||||
(mapcar
|
||||
(lambda (e)
|
||||
(append (list :code (cdr e))
|
||||
(when (car e)
|
||||
(list :path
|
||||
(mapcar #'flan-inspect-wire-step
|
||||
(car e))))))
|
||||
edits))))))
|
||||
(unless (equal (plist-get r :status) "ok")
|
||||
(user-error "flan: %s" (or (plist-get r :message) "refused")))
|
||||
;; Redrawn from a fresh read rather than from the reply's value, even
|
||||
;; though the reply carries one. The reply is the value at the path that
|
||||
;; was written; the buffer may be showing a parent of it, and drawing the
|
||||
;; child there would be the wrong value in the right place. `--show' also
|
||||
;; picks up the new stop number, which the next commit needs.
|
||||
(flan-inspect--show root path stack)
|
||||
(message "flan: wrote %s" (plist-get r :value))
|
||||
r))
|
||||
|
||||
(defun flan-inspect-set ()
|
||||
"Set the field or element at point, or the whole value when point is not on one.
|
||||
Prompts with what is there now; what you type is a Flan *expression*, checked
|
||||
in the program against the type of the place it is going into — so `(+ 1 2)',
|
||||
a string literal and a struct literal all work, and one that does not fit is
|
||||
refused in the checker's own words."
|
||||
(interactive)
|
||||
(let ((why (flan-inspect--writable "setting a value")))
|
||||
(when why (user-error "flan: %s" why)))
|
||||
(let* ((step (get-text-property (point) 'flan-inspect-step))
|
||||
(node (or (get-text-property (point) 'flan-inspect-node)
|
||||
flan-inspect--node))
|
||||
;; The step the wire wants carries the type it is a field *of*, the
|
||||
;; same graft `flan-inspect-into' makes and for the same reason: a
|
||||
;; data type's payload sits at an offset that depends on the case.
|
||||
(steps (cond
|
||||
((null step) nil)
|
||||
((eq (plist-get flan-inspect--node :kind) 'option) (list '(:some)))
|
||||
(t (list (pcase step
|
||||
(`(:field ,name)
|
||||
(list :field name
|
||||
(plist-get flan-inspect--node :type)))
|
||||
(_ step))))))
|
||||
(where (flan-inspect--root-label
|
||||
flan-inspect--root
|
||||
(append flan-inspect--path steps)))
|
||||
(now (flan-inspect--literal node))
|
||||
(code (read-string (format "Set %s to: " where) now)))
|
||||
(when (string-empty-p (string-trim code))
|
||||
(user-error "flan: nothing to store"))
|
||||
(flan-inspect--send (list (cons steps code)))))
|
||||
|
||||
;;; The buffer as the value
|
||||
|
||||
;; The second half, and the one that is not SLY's. A rendered Flan value is a
|
||||
;; Flan literal — `(Point {.x 1.5 .y 2.5})' is what the renderer writes and
|
||||
;; what the source would write — so the editable form of the value is the
|
||||
;; value's own spelling, with no second notation to learn and nothing to
|
||||
;; translate. Editing it is editing text; committing it is a diff.
|
||||
;;
|
||||
;; A diff and not a blast. A struct with one changed field sends one write for
|
||||
;; that field, so the untouched fields are not rewritten with what was on the
|
||||
;; screen — which matters exactly when it is hardest to see that it does: two
|
||||
;; people, or a program and a person, touching the same value.
|
||||
|
||||
(defun flan-inspect--literal (node &optional indent)
|
||||
"NODE as Flan source, laid out over lines from INDENT.
|
||||
Round-trips through `flan-inspect-parse': what this writes is what that reads,
|
||||
which is what makes the commit a comparison of two parses rather than a
|
||||
comparison of two strings."
|
||||
(let* ((indent (or indent 0))
|
||||
(pad (make-string (+ indent 2) ?\s))
|
||||
(kids (plist-get node :children)))
|
||||
(pcase (plist-get node :kind)
|
||||
('struct
|
||||
(if (null kids)
|
||||
(format "(%s {})" (plist-get node :text))
|
||||
(concat "(" (plist-get node :text) " {"
|
||||
(mapconcat
|
||||
(lambda (c)
|
||||
(concat "\n" pad "." (format "%s" (car c)) " "
|
||||
(flan-inspect--literal (cdr c) (+ indent 2))))
|
||||
kids "")
|
||||
"})")))
|
||||
('seq
|
||||
(if (null kids) "[]"
|
||||
(concat "["
|
||||
(mapconcat
|
||||
(lambda (c)
|
||||
(concat "\n" pad (flan-inspect--literal (cdr c) (+ indent 2))))
|
||||
kids "")
|
||||
"]")))
|
||||
('option
|
||||
(concat "(some " (flan-inspect--literal (cdr (car kids)) indent) ")"))
|
||||
(_ (plist-get node :text)))))
|
||||
|
||||
(defun flan-inspect--complete (node)
|
||||
"Why NODE is not a whole value, or nil if it is.
|
||||
The renderer stops at a depth of 4 and a span of 8, and what it writes when it
|
||||
stops is `...'. A buffer holding one of those is a buffer where some of the
|
||||
value is simply not present — and a commit read off it would look exactly like
|
||||
somebody having deleted the part that was never written."
|
||||
(cond
|
||||
((eq (plist-get node :kind) 'trunc)
|
||||
"the renderer stopped at its depth bound of 4 here, so part of this value \
|
||||
was never written. Inspect the field that holds it, which re-roots the walk")
|
||||
((plist-get node :truncated)
|
||||
"the renderer stopped at its span bound of 8, so some of these are not in \
|
||||
the buffer — and a commit read off it could not tell them from ones you had \
|
||||
deleted")
|
||||
(t (seq-some (lambda (c) (flan-inspect--complete (cdr c)))
|
||||
(plist-get node :children)))))
|
||||
|
||||
(defun flan-inspect--diff (old new)
|
||||
"One edit per leaf that differs between OLD and NEW.
|
||||
Returns (EDITS . REFUSAL): EDITS is a list of (STEPS . CODE) and REFUSAL, when
|
||||
it is non-nil, is why the two cannot be compared at all. A shape that changed
|
||||
is a refusal and not an edit — adding a field to a struct or an element to an
|
||||
array is not something a store can do, and quietly writing the leaves that did
|
||||
line up would be the half-done version of what was asked."
|
||||
(let ((edits nil) (why nil))
|
||||
(cl-labels
|
||||
((no (fmt &rest args) (unless why (setq why (apply #'format fmt args))))
|
||||
(label (steps)
|
||||
(if steps
|
||||
(mapconcat (lambda (s)
|
||||
(pcase s
|
||||
(`(:field ,f . ,_) (concat "." f))
|
||||
(`(:index ,i) (format "[%d]" i))
|
||||
(`(:some) ".some")
|
||||
(_ "")))
|
||||
(reverse steps) "")
|
||||
"this value"))
|
||||
(walk (o n steps parent)
|
||||
(let ((ok (plist-get o :kind)) (nk (plist-get n :kind)))
|
||||
(cond
|
||||
((equal o n) nil)
|
||||
;; Asked of the *old* node and before the kinds are compared,
|
||||
;; because the question is what the program wrote and not what
|
||||
;; was typed over it. `<ptr>' and `<Name>' are what the renderer
|
||||
;; writes when it has not written the value, so anything in their
|
||||
;; place is an edit of nothing, whatever shape it now has.
|
||||
((memq ok '(ptr opaque))
|
||||
(no "%s is written as %s, which is what the renderer writes \
|
||||
when it did not write the value — so there is nothing there to have changed"
|
||||
(label steps) (plist-get o :text)))
|
||||
((not (eq ok nk))
|
||||
(no "%s was %s and is now %s: a store replaces a value, it \
|
||||
does not change what kind of thing is there. Use `e' on it to set the whole \
|
||||
value"
|
||||
(label steps) (flan-inspect--kind-name ok)
|
||||
(flan-inspect--kind-name nk)))
|
||||
((memq ok '(struct option))
|
||||
(if (and (eq ok 'struct)
|
||||
(not (equal (plist-get o :text) (plist-get n :text))))
|
||||
;; The head is the struct's name, and for a data type it is
|
||||
;; `Type.case' — so a changed head is a changed *case*, which
|
||||
;; is a change to the tag and not to any field under it.
|
||||
(no "%s is a %s and the buffer says %s: which case a data \
|
||||
type holds is the tag, not a field, so it is set whole. Use `e' on it"
|
||||
(label steps) (plist-get o :text) (plist-get n :text))
|
||||
(children o n steps)))
|
||||
((eq ok 'seq)
|
||||
(if (/= (length (plist-get o :children))
|
||||
(length (plist-get n :children)))
|
||||
(no "%s had %d element%s and the buffer has %d: adding or \
|
||||
removing one is a change to the container, which is a thing the program does \
|
||||
and not a thing a store does"
|
||||
(label steps) (length (plist-get o :children))
|
||||
(if (= 1 (length (plist-get o :children))) "" "s")
|
||||
(length (plist-get n :children)))
|
||||
(children o n steps)))
|
||||
((equal (plist-get o :text) (plist-get n :text)) nil)
|
||||
(t
|
||||
(push (cons (reverse steps) (plist-get n :text)) edits))))
|
||||
(ignore parent))
|
||||
(children (o n steps)
|
||||
(let ((ok (mapcar #'car (plist-get o :children)))
|
||||
(nk (mapcar #'car (plist-get n :children))))
|
||||
(if (not (equal ok nk))
|
||||
(no "%s has %s in the buffer and %s in the program: a store \
|
||||
writes what is there, it does not add or rename fields"
|
||||
(label steps)
|
||||
(if nk (mapconcat (lambda (k) (format "%s" k)) nk " ") "nothing")
|
||||
(if ok (mapconcat (lambda (k) (format "%s" k)) ok " ") "nothing"))
|
||||
(dolist (c (plist-get o :children))
|
||||
(let ((step (if (integerp (car c))
|
||||
(list :index (car c))
|
||||
(if (eq (plist-get o :kind) 'option)
|
||||
(list :some)
|
||||
(list :field (car c) (plist-get o :type))))))
|
||||
(walk (cdr c)
|
||||
(cdr (assoc (car c) (plist-get n :children)))
|
||||
(cons step steps) o)))))))
|
||||
(walk old new nil nil))
|
||||
;; A refusal voids the edits rather than sitting beside them. The walk
|
||||
;; visits fields in order, so a struct with one good change and one
|
||||
;; impossible one collects the good one before it reaches the other — and
|
||||
;; handing that back with the refusal would make it possible for a caller
|
||||
;; to send half of what was asked for. Nothing does; this is what makes
|
||||
;; it not merely a convention.
|
||||
(cons (and (null why) (nreverse edits)) why)))
|
||||
|
||||
(defun flan-inspect--kind-name (kind)
|
||||
"KIND, said in words, for a refusal that has to name two of them."
|
||||
(pcase kind
|
||||
('struct "a struct") ('seq "a sequence") ('option "an option")
|
||||
('ptr "a pointer") ('opaque "a type with no structure")
|
||||
('trunc "the renderer's mark for where it stopped")
|
||||
(_ "a single value")))
|
||||
|
||||
(defun flan-inspect-edit ()
|
||||
"Turn this buffer into the value, editable.
|
||||
What you get is the Flan literal the program wrote. Change it as text;
|
||||
`C-c C-c' sends one write per leaf you changed and redraws from what the
|
||||
program holds afterwards, `C-c C-k' throws the edit away."
|
||||
(interactive)
|
||||
(let ((why (flan-inspect--writable "editing the value")))
|
||||
(when why (user-error "flan: %s" why)))
|
||||
(when flan-inspect--editing (user-error "flan: this buffer is already open for editing"))
|
||||
(let ((why (flan-inspect--complete flan-inspect--node)))
|
||||
(when why (user-error "flan: %s" why)))
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert (propertize (flan-inspect--root-label flan-inspect--root
|
||||
flan-inspect--path)
|
||||
'face 'font-lock-function-name-face)
|
||||
"\n")
|
||||
(when flan-inspect--type
|
||||
(insert (propertize (format "%s\n" flan-inspect--type)
|
||||
'face 'font-lock-type-face)))
|
||||
(insert (propertize
|
||||
"--- Editing. C-c C-c commits what you changed, C-c C-k abandons it.\n"
|
||||
'face 'font-lock-comment-face))
|
||||
(insert "\n")
|
||||
(insert (flan-inspect--literal flan-inspect--node))
|
||||
(insert "\n")
|
||||
(setq buffer-read-only nil)
|
||||
(setq-local truncate-lines nil)
|
||||
(setq flan-inspect--editing t)
|
||||
;; The header is not part of the value, so it is not part of what gets
|
||||
;; parsed back — and it is fixed rather than merely un-parsed, because a
|
||||
;; header edited by accident would otherwise read as the value having
|
||||
;; grown a line.
|
||||
(let ((end (save-excursion (goto-char (point-min)) (forward-line 4) (point))))
|
||||
(add-text-properties (point-min) end '(read-only t front-sticky t)))
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)))
|
||||
|
||||
(defun flan-inspect--edited ()
|
||||
"What the editable part of this buffer says, parsed."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line 4)
|
||||
(let ((text (buffer-substring-no-properties (point) (point-max))))
|
||||
(when (string-empty-p (string-trim text))
|
||||
(user-error "flan: there is nothing left in the buffer to commit"))
|
||||
(let ((node (flan-inspect-parse text)))
|
||||
(unless node
|
||||
(user-error "flan: the buffer does not read as a Flan value"))
|
||||
node))))
|
||||
|
||||
(defun flan-inspect-commit ()
|
||||
"Send one write per leaf changed since this buffer was opened for editing."
|
||||
(interactive)
|
||||
(unless flan-inspect--editing
|
||||
(user-error "flan: this buffer is a listing, not the value; `C-c C-e' opens it for editing"))
|
||||
(let* ((old flan-inspect--node)
|
||||
(new (flan-inspect--edited))
|
||||
(d (flan-inspect--diff old new))
|
||||
(edits (car d))
|
||||
(why (cdr d)))
|
||||
(when why (user-error "flan: %s" why))
|
||||
(unless edits
|
||||
;; Not silently nothing. A commit that found no change is a fact worth
|
||||
;; saying — most often it means the edit went into the header, or into a
|
||||
;; part of the buffer that is a summary rather than the value.
|
||||
(user-error "flan: nothing in the buffer differs from what the program holds"))
|
||||
(flan-inspect--send edits)))
|
||||
|
||||
(defun flan-inspect-abandon ()
|
||||
"Throw the edit away and draw what the program holds."
|
||||
(interactive)
|
||||
(unless flan-inspect--editing
|
||||
(user-error "flan: this buffer is not open for editing"))
|
||||
(flan-inspect--show flan-inspect--root flan-inspect--path
|
||||
flan-inspect--stack))
|
||||
|
||||
(defun flan-inspect--fields ()
|
||||
"The start of every inspectable line, in order.
|
||||
Both movement commands go through this rather than walking property changes
|
||||
@ -823,6 +1203,15 @@ the kind of thing nobody reports and everybody notices."
|
||||
(define-key map [backtab] #'flan-inspect-previous)
|
||||
(define-key map "p" #'flan-inspect-previous)
|
||||
(define-key map "q" #'quit-window)
|
||||
;; The write half. `e' for the one field under point, because that is the
|
||||
;; letter Emacs uses for "edit the thing here" everywhere else a buffer
|
||||
;; lists things; the prefixed pair for the mode, because `C-c C-c' is what
|
||||
;; commits an editing buffer in this editor — message, log-edit and
|
||||
;; org-src all — and `C-c C-k' is what abandons one.
|
||||
(define-key map "e" #'flan-inspect-set)
|
||||
(define-key map (kbd "C-c C-e") #'flan-inspect-edit)
|
||||
(define-key map (kbd "C-c C-c") #'flan-inspect-commit)
|
||||
(define-key map (kbd "C-c C-k") #'flan-inspect-abandon)
|
||||
map)
|
||||
"Keys in `flan-inspect-mode'.")
|
||||
|
||||
|
||||
@ -655,6 +655,280 @@ unwind would send the next one to a daemon that is not there."
|
||||
(or (test-flan--caught #'flan-inspect-pop) ""))))))
|
||||
|
||||
|
||||
;;; Writing one back
|
||||
|
||||
(message "\nsetting a value, and the buffer as the value")
|
||||
|
||||
(defun test-flan--writable (value &optional type replies body)
|
||||
"Open a slot root on VALUE, at a stop, and run BODY in its buffer.
|
||||
The stop number is what makes the buffer writable at all, so it is in the
|
||||
fixture rather than in each test: a reply without one is a reply from a read
|
||||
the daemon could not date, and this helper is for the case where it could."
|
||||
(test-flan--slot
|
||||
1 0 "b"
|
||||
(or replies
|
||||
(lambda (form)
|
||||
(if (equal (plist-get form :op) "set")
|
||||
(list :status "ok" :type (or type "Blob") :value value :at-stop 7
|
||||
:wrote 1)
|
||||
(list :status "ok" :type (or type "Blob") :value value :at-stop 7))))
|
||||
body))
|
||||
|
||||
;; The two refusals that come before any request: a root that names no frame,
|
||||
;; and a drawing that names no stop. Both are refusals of *this buffer*
|
||||
;; rather than of the value in it, and both say which root can.
|
||||
(let ((flan-inspect-request-function
|
||||
(lambda (_) (list :status "ok" :value "7" :type "i32")))
|
||||
(flan-inspect-buffer " *test-inspect*"))
|
||||
(save-window-excursion
|
||||
(flan-inspect "g")
|
||||
(with-current-buffer " *test-inspect*"
|
||||
(test-flan--check "an expression root cannot be written to"
|
||||
(string-match-p
|
||||
"roots at a frame's slot"
|
||||
(or (test-flan--caught #'flan-inspect-set) "")))
|
||||
(test-flan--check "and neither can an address root, for the same reason"
|
||||
(progn
|
||||
(flan-inspect-address 4096 nil)
|
||||
(string-match-p
|
||||
"roots at a frame's slot"
|
||||
(or (test-flan--caught #'flan-inspect-set) "")))))))
|
||||
|
||||
(test-flan--slot
|
||||
1 0 "b"
|
||||
(lambda (_) (list :status "ok" :type "i32" :value "7"))
|
||||
(lambda ()
|
||||
(test-flan--check "a slot root the daemon did not date cannot be written to"
|
||||
(string-match-p
|
||||
"name the stop"
|
||||
(or (test-flan--caught #'flan-inspect-set) "")))
|
||||
(test-flan--check "and the legend does not offer keys that would refuse"
|
||||
(not (string-match-p "e set" (buffer-string))))))
|
||||
|
||||
;; `e' on a field line. What is sent is the buffer's own path with the line's
|
||||
;; step on the end, the stop the drawing was made at, and the expression typed
|
||||
;; — not a value the client converted into anything.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7 .name \"sandy\"})" "Blob" nil
|
||||
(lambda ()
|
||||
(test-flan--check "the legend offers the write keys where they work"
|
||||
(string-match-p "e set" (buffer-string)))
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next) ; .id
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(+ 1 2)")))
|
||||
(flan-inspect-set))
|
||||
(let ((sent (car (last test-flan--asked 2))))
|
||||
(test-flan--check "e sends a set"
|
||||
(equal (plist-get sent :op) "set"))
|
||||
(test-flan--check "rooted at the frame and slot the buffer is on"
|
||||
(and (equal (plist-get sent :frame) 1)
|
||||
(equal (plist-get sent :slot) 0)))
|
||||
(test-flan--check "naming the stop the drawing was made at"
|
||||
(equal (plist-get sent :at-stop) 7))
|
||||
(test-flan--check "with one edit, at the field the line names"
|
||||
(equal (plist-get sent :edits)
|
||||
'((:code "(+ 1 2)" :path ("id")))))
|
||||
(test-flan--check "and the expression is sent as it was typed"
|
||||
(equal (plist-get (car (plist-get sent :edits)) :code)
|
||||
"(+ 1 2)")))
|
||||
(test-flan--check "and the buffer is drawn again from a fresh read"
|
||||
(equal (plist-get (car test-flan--asked) :op) "inspect"))))
|
||||
|
||||
;; The prompt offers what is there, so the common edit is a character.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7 .name \"sandy\"})" "Blob" nil
|
||||
(lambda ()
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next) (flan-inspect-next) ; .name
|
||||
(let ((offered nil))
|
||||
(cl-letf (((symbol-function 'read-string)
|
||||
(lambda (_ &optional init &rest _r) (setq offered init) "\"sandy2\"")))
|
||||
(flan-inspect-set))
|
||||
(test-flan--check "the prompt starts from what is there now"
|
||||
(equal offered "\"sandy\"")))))
|
||||
|
||||
;; Point on nothing in particular sets the whole value, which is how a data
|
||||
;; type's case is changed and how anything the field list cannot reach is.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7})" "Blob" nil
|
||||
(lambda ()
|
||||
(goto-char (point-min))
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(Blob {.id 9})")))
|
||||
(flan-inspect-set))
|
||||
(let ((sent (car (last test-flan--asked 2))))
|
||||
(test-flan--check "point off a field line sets the whole value"
|
||||
(equal (plist-get sent :edits)
|
||||
'((:code "(Blob {.id 9})")))))))
|
||||
|
||||
;; A refusal from the daemon reaches the person and changes nothing. The
|
||||
;; refusals that matter here are the daemon's own — a type that does not fit,
|
||||
;; a stop that has moved — and this end must not paper over either.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7})" "Blob"
|
||||
(lambda (form)
|
||||
(if (equal (plist-get form :op) "set")
|
||||
(list :status "error" :message "expected i32, found string")
|
||||
(list :status "ok" :type "Blob" :value "(Blob {.id 7})" :at-stop 7)))
|
||||
(lambda ()
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next)
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "\"no\"")))
|
||||
(test-flan--check "the checker's refusal reaches the person"
|
||||
(string-match-p
|
||||
"expected i32, found string"
|
||||
(or (test-flan--caught #'flan-inspect-set) ""))))))
|
||||
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7})" "Blob"
|
||||
(lambda (form)
|
||||
(if (equal (plist-get form :op) "set")
|
||||
(list :status "error"
|
||||
:message "this was written against stop 7 and the program is at \
|
||||
stop 9 now: it ran on and stopped again, so what is on the screen is not what \
|
||||
would be overwritten. Look again and re-do the edit")
|
||||
(list :status "ok" :type "Blob" :value "(Blob {.id 7})" :at-stop 7)))
|
||||
(lambda ()
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next)
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "9")))
|
||||
(test-flan--check "a stale drawing is refused with what to do about it"
|
||||
(string-match-p
|
||||
"Look again"
|
||||
(or (test-flan--caught #'flan-inspect-set) ""))))))
|
||||
|
||||
;;; The buffer as the value
|
||||
|
||||
;; The literal the editable buffer holds is the value's own spelling, and it
|
||||
;; has to read back as what it was written from — otherwise a commit would
|
||||
;; diff a parse against a different parse and see changes nobody made.
|
||||
(let ((round
|
||||
(lambda (s)
|
||||
(equal (flan-inspect-parse s)
|
||||
(flan-inspect-parse
|
||||
(flan-inspect--literal (flan-inspect-parse s)))))))
|
||||
(test-flan--check "a struct round-trips through the editable spelling"
|
||||
(funcall round "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})"))
|
||||
(test-flan--check "an array does too"
|
||||
(funcall round "[ 10 20 30]"))
|
||||
(test-flan--check "and an option, and a nested one"
|
||||
(funcall round "(some (V {.x 1 .y (some 2)}))")))
|
||||
|
||||
(let ((old (flan-inspect-parse "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})")))
|
||||
;; One leaf changed is one edit, with the steps that reach it and nothing
|
||||
;; else — the whole point of diffing rather than writing the value back.
|
||||
(let ((d (flan-inspect--diff
|
||||
old
|
||||
(flan-inspect-parse
|
||||
"(Blob {.id 7 .name \"sandy\" .pos (V {.x 2.5 .y 0})})"))))
|
||||
(test-flan--check "one changed leaf is one edit"
|
||||
(equal (car d) '((((:field "pos" "Blob") (:field "x" "V")) . "2.5"))))
|
||||
(test-flan--check "and nothing is refused about it" (null (cdr d))))
|
||||
(let ((d (flan-inspect--diff
|
||||
old
|
||||
(flan-inspect-parse
|
||||
"(Blob {.id 8 .name \"tuned\" .pos (V {.x 1.5 .y 0})})"))))
|
||||
(test-flan--check "two changed leaves are two edits, and only two"
|
||||
(equal (car d)
|
||||
'((((:field "id" "Blob")) . "8")
|
||||
(((:field "name" "Blob")) . "\"tuned\"")))))
|
||||
(let ((d (flan-inspect--diff old (flan-inspect-parse "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})"))))
|
||||
(test-flan--check "an untouched value is no edits at all"
|
||||
(and (null (car d)) (null (cdr d)))))
|
||||
;; And the shapes that are not stores. Each is refused whole, so the leaf
|
||||
;; that did line up beside it does not go either.
|
||||
(let ((d (flan-inspect--diff
|
||||
old
|
||||
(flan-inspect-parse
|
||||
"(Blob {.id 8 .name \"sandy\" .pos 3})"))))
|
||||
(test-flan--check "a leaf where a struct was is refused, not written"
|
||||
(and (null (car d)) (string-match-p "kind of thing" (cdr d)))))
|
||||
(let ((d (flan-inspect--diff
|
||||
old
|
||||
(flan-inspect-parse "(Blob {.id 7 .name \"sandy\"})"))))
|
||||
(test-flan--check "a field removed is refused by name"
|
||||
(and (null (car d))
|
||||
(string-match-p "does not add or rename" (cdr d))))))
|
||||
|
||||
(let ((d (flan-inspect--diff (flan-inspect-parse "[ 1 2 3]")
|
||||
(flan-inspect-parse "[ 1 2 3 4]"))))
|
||||
(test-flan--check "an element added is a change to the container, and refused"
|
||||
(and (null (car d))
|
||||
(string-match-p "3 elements and the buffer has 4" (cdr d)))))
|
||||
|
||||
(let ((d (flan-inspect--diff
|
||||
(flan-inspect-parse "(Shape.circle {.r 1})")
|
||||
(flan-inspect-parse "(Shape.square {.r 1})"))))
|
||||
(test-flan--check "a data type's case is the tag, so it is not a field edit"
|
||||
(and (null (car d)) (string-match-p "set whole" (cdr d)))))
|
||||
|
||||
(let ((d (flan-inspect--diff (flan-inspect-parse "(B {.p <ptr>})")
|
||||
(flan-inspect-parse "(B {.p 4096})"))))
|
||||
(test-flan--check "typing over what the renderer did not write is refused"
|
||||
(and (null (car d)) (string-match-p "nothing there" (cdr d)))))
|
||||
|
||||
;; The truncation guard. A value the renderer stopped short of is one where
|
||||
;; some of the fields are simply absent from the buffer, and a commit read off
|
||||
;; it could not tell them from fields somebody deleted.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7 .deep (V {.a (W {.b ...})})})" "Blob" nil
|
||||
(lambda ()
|
||||
(test-flan--check "a truncated value refuses to be opened for editing"
|
||||
(string-match-p
|
||||
"never written"
|
||||
(or (test-flan--caught #'flan-inspect-edit) "")))))
|
||||
|
||||
;; And the whole round trip: open, edit the text, commit, and what goes out is
|
||||
;; one write for the leaf that changed.
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7 .name \"sandy\"})" "Blob" nil
|
||||
(lambda ()
|
||||
(flan-inspect-edit)
|
||||
(test-flan--check "editing shows the value as a Flan literal"
|
||||
(string-match-p "(Blob {" (buffer-string)))
|
||||
(test-flan--check "and says how to commit it"
|
||||
(string-match-p "C-c C-c commits" (buffer-string)))
|
||||
(test-flan--check "a commit with nothing changed says so"
|
||||
(string-match-p
|
||||
"nothing in the buffer differs"
|
||||
(or (test-flan--caught #'flan-inspect-commit) "")))
|
||||
(goto-char (point-min))
|
||||
(search-forward ".id 7")
|
||||
(replace-match ".id 42")
|
||||
(flan-inspect-commit)
|
||||
(let ((sent (car (last test-flan--asked 2))))
|
||||
(test-flan--check "the commit writes the one leaf that changed"
|
||||
(equal (plist-get sent :edits)
|
||||
'((:code "42" :path ("id")))))
|
||||
(test-flan--check "and names the stop the buffer was drawn at"
|
||||
(equal (plist-get sent :at-stop) 7)))
|
||||
(test-flan--check "and the buffer is a listing again afterwards"
|
||||
(not flan-inspect--editing))))
|
||||
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7})" "Blob" nil
|
||||
(lambda ()
|
||||
(flan-inspect-edit)
|
||||
(goto-char (point-max))
|
||||
(insert "junk (")
|
||||
(test-flan--check "an edit that has stopped being a value refuses whole"
|
||||
(let ((why (test-flan--caught #'flan-inspect-commit)))
|
||||
;; It reads as *something*, but not as the same shape,
|
||||
;; which is the refusal that names what changed.
|
||||
(and why (not (string-match-p "wrote" why)))))
|
||||
(flan-inspect-abandon)
|
||||
(test-flan--check "and abandoning draws what the program holds"
|
||||
(and (not flan-inspect--editing)
|
||||
(string-match-p "\\.id +7" (buffer-string))))))
|
||||
|
||||
(test-flan--writable
|
||||
"(Blob {.id 7})" "Blob" nil
|
||||
(lambda ()
|
||||
(test-flan--check "committing a listing says it is not an edit"
|
||||
(string-match-p
|
||||
"C-c C-e"
|
||||
(or (test-flan--caught #'flan-inspect-commit) "")))))
|
||||
|
||||
|
||||
;;; Restarts: which of them can be taken
|
||||
|
||||
(message "\nrestarts, and §4's shadowing")
|
||||
|
||||
@ -15,6 +15,7 @@
|
||||
(require 'flan-repl)
|
||||
(require 'flan-watch)
|
||||
(require 'flan-lower)
|
||||
(require 'flan-inspect)
|
||||
|
||||
(defvar test-flan--failures 0)
|
||||
|
||||
@ -831,8 +832,13 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
||||
;; Break it: `step' is called every time round the program's loop, so a body
|
||||
;; that errors stops it on its own game thread, in a frame of its own — not
|
||||
;; inside anything this client asked for. Nothing tells Emacs.
|
||||
;;
|
||||
;; The local in front of the error is for the inspector's write half further
|
||||
;; down: a frame has to have a named slot holding something with a field in
|
||||
;; it before anything can be stored into one. It is read back out by the
|
||||
;; error, so it is not a binding the checker can call unused.
|
||||
(flan--eval
|
||||
"(defn step [] i64 (restart-case (do (error (Missing {.id 7})) 0) (use-placeholder [] -1)))"
|
||||
"(defn step [] i64 (let [blip (Missing {.id 7})] (restart-case (do (error (Missing {.id (.id blip)})) 0) (use-placeholder [] -1))))"
|
||||
"form")
|
||||
(let ((deadline (+ (float-time) 20)))
|
||||
(while (and (not flan--stopped) (< (float-time) deadline))
|
||||
@ -884,6 +890,84 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
||||
(flan-clear-result)
|
||||
(delete-region beg (point-max)))
|
||||
|
||||
;; The inspector, and then the inspector writing. This is the one place the
|
||||
;; whole chain runs against a real program: a frame the shadow stack knows,
|
||||
;; a slot index read off the listing, a render, a store, and a second render
|
||||
;; that is not the first one's echo — it is a fresh request, so what it shows
|
||||
;; came out of the program's storage after the write.
|
||||
(let* ((listing (flan--request '(:op "locals" :frame 0)))
|
||||
(slot (car (delq nil
|
||||
(mapcar (lambda (l)
|
||||
(and (equal (nth 0 l) "blip") (nth 3 l)))
|
||||
(plist-get listing :locals)))))
|
||||
(read-id (lambda ()
|
||||
(plist-get (flan--request
|
||||
(list :op "inspect" :frame 0 :slot slot
|
||||
:path '("id")))
|
||||
:value)))
|
||||
(refusal (lambda (f)
|
||||
(or (condition-case e (progn (funcall f) nil)
|
||||
(error (error-message-string e)))
|
||||
""))))
|
||||
(test-flan--check "the stopped frame's listing gives the local a slot index"
|
||||
(integerp slot))
|
||||
(when (integerp slot)
|
||||
(save-window-excursion
|
||||
(with-current-buffer (flan-inspect-slot 0 slot "blip")
|
||||
(test-flan--check "the inspector draws the local from the frame"
|
||||
(string-match-p "\\.id +7" (buffer-string)))
|
||||
(test-flan--check "and the drawing says which stop it was made at"
|
||||
(and (integerp flan-inspect--at-stop)
|
||||
(> flan-inspect--at-stop 0)))
|
||||
;; Level one: one field, from the line that names it.
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next)
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "(+ 40 2)")))
|
||||
(flan-inspect-set))
|
||||
(test-flan--check "a field set from the inspector lands in the frame"
|
||||
(string-match-p "\\.id +42" (buffer-string)))
|
||||
(test-flan--check "and reading it again agrees with the program"
|
||||
(equal (funcall read-id) "42"))
|
||||
;; A value that does not fit is refused in the checker's own words,
|
||||
;; and nothing moves.
|
||||
(goto-char (point-min))
|
||||
(flan-inspect-next)
|
||||
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "\"no\"")))
|
||||
(test-flan--check "a value of the wrong type is refused by the checker"
|
||||
(string-match-p "expected i32"
|
||||
(funcall refusal #'flan-inspect-set))))
|
||||
(test-flan--check "and the refused write changed nothing"
|
||||
(equal (funcall read-id) "42"))
|
||||
;; Level two: the buffer *is* the value, edited as text and committed
|
||||
;; as a diff.
|
||||
(flan-inspect-edit)
|
||||
(test-flan--check "editing shows the value as the literal it is"
|
||||
(string-match-p "(Missing {" (buffer-string)))
|
||||
(goto-char (point-min))
|
||||
(search-forward ".id 42")
|
||||
(replace-match ".id 11")
|
||||
(flan-inspect-commit)
|
||||
(test-flan--check "committing the buffer stores what was changed in it"
|
||||
(string-match-p "\\.id +11" (buffer-string)))
|
||||
(test-flan--check "and the program agrees"
|
||||
(equal (funcall read-id) "11"))
|
||||
;; And a commit against a stop the program has left refuses rather
|
||||
;; than storing into a stack nobody looked at. The stop is moved on
|
||||
;; here rather than the program, because making a program leave a
|
||||
;; break and come back inside a batch run is a race; what is under
|
||||
;; test is the refusal, and it is the program making it.
|
||||
(flan-inspect-edit)
|
||||
(goto-char (point-min))
|
||||
(search-forward ".id 11")
|
||||
(replace-match ".id 99")
|
||||
(setq flan-inspect--at-stop (+ 1000 flan-inspect--at-stop))
|
||||
(test-flan--check "a commit against a stop the program has left is refused"
|
||||
(string-match-p
|
||||
"Look again" (funcall refusal #'flan-inspect-commit)))
|
||||
(test-flan--check "and that write did not land either"
|
||||
(equal (funcall read-id) "11")))))
|
||||
(when (get-buffer flan-inspect-buffer) (kill-buffer flan-inspect-buffer)))
|
||||
|
||||
;; And installing, which the break loop allows on purpose: there is no frame
|
||||
;; in progress, so the rule against swapping a body that is on the stack does
|
||||
;; not apply. This is the fix-it-and-retry loop — the broken `step' is
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user