diff --git a/docs/BUILT.md b/docs/BUILT.md index ceb9d46..4f04896 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -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 diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 742d822..5a45a95 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -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.** ``, ``, 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 diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index afcb736..d814a1a 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -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. `' and `' 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'.") diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index dcc18a1..d87b404 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -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 })") + (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") diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 128a913..7a009a9 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -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