Joseph Ferano
416ce10ee7
`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.
1225 lines
60 KiB
EmacsLisp
1225 lines
60 KiB
EmacsLisp
;;; flan-inspect.el --- Navigate a running program's values -*- lexical-binding: t; -*-
|
|
|
|
;; Author: Joseph Ferano <joseph@ferano.io>
|
|
;; Version: 0.1.0
|
|
;; Package-Requires: ((emacs "29.1"))
|
|
;; Keywords: languages, lisp, tools
|
|
|
|
;; The headers above are what make this directory installable. M-x
|
|
;; package-install-file on it reads them, and a file with no Version: is not a
|
|
;; package as far as package.el is concerned -- until now the client was
|
|
;; reachable only by adding it to load-path by hand, which is a thing to
|
|
;; explain to every person who wants to try it.
|
|
;;
|
|
;; 29.1 is the floor because it is the oldest Emacs any of this has been run
|
|
;; against, not because some function here is known to need it. dape, which
|
|
;; flan-dape drives, asks for 29.1 as well and is a soft dependency: it is
|
|
;; reached through declare-function, so the rest of the client loads and works
|
|
;; without it and it is deliberately not listed above. The compiler this talks
|
|
;; to is not an Emacs package and cannot be listed here either -- emacs/MANUAL.md
|
|
;; says what has to be on PATH.
|
|
|
|
;; `C-x C-e' renders a value once and puts it in the echo area. This is the
|
|
;; interactive version of the same walk: the fields laid out one per line, RET
|
|
;; to go into one, `l' to come back, `g' to read it again. CIDER's inspector,
|
|
;; adapted — and the adaptation is the whole design, so it is worth stating
|
|
;; what changed and why.
|
|
;;
|
|
;; CIDER's inspector keeps its stack **on the server**. `inspect-push' hands
|
|
;; the middleware an index and the middleware walks into the object it is
|
|
;; already holding; the client's own stack is only remembered point positions.
|
|
;; That is available to it because a JVM value can be retained: the middleware
|
|
;; keeps a reference and the collector leaves it alone.
|
|
;;
|
|
;; Nothing here can do that. A Flan value has no header, the thunk that
|
|
;; rendered it is `dlclose'd the moment it returns, and there is no heap to
|
|
;; retain anything in. So the stack is a stack of **expressions**, on this
|
|
;; side, and going into a field means sending a *different expression* —
|
|
;; `(.pos b)' where the last one was `b'. Two consequences, one good and one
|
|
;; that has to be said out loud:
|
|
;;
|
|
;; the view is never stale. Every step and every `g' reads the program as
|
|
;; it is now, at a frame boundary it agreed to stop on. CIDER's inspector
|
|
;; shows you the object as it was when you pushed;
|
|
;;
|
|
;; and the root expression runs again on every step. Appending a field
|
|
;; accessor to it is pure, but the root need not be — `(spawn-enemy)' as a
|
|
;; root spawns one per keystroke. Which is why there is no auto-refresh and
|
|
;; why `g' is a key someone presses.
|
|
;;
|
|
;; The other thing this buys, and the reason it is worth having at all next to
|
|
;; `C-x C-e': the renderer bounds its walk at depth 4 and span 8
|
|
;; (lib/session.ml). A field past either bound comes back as `...' and no
|
|
;; amount of squinting at the echo area recovers it. Re-rooting the walk at
|
|
;; that field renders it from depth 0 — the bound moves with you.
|
|
;;
|
|
;;; Two ways to root a walk, and why there had to be a second
|
|
;;
|
|
;; Everything above describes the *expression* root, and it has one hole: an
|
|
;; expression is evaluated where the evaluator stands. `i' on a local in the
|
|
;; break buffer used to send that local's name, and on the innermost frame
|
|
;; that lands in the right frame by luck. On any other it may resolve to a
|
|
;; global, to another binding of the same name, or to nothing — with the
|
|
;; locals listing right above it showing the frame's own storage, because that
|
|
;; listing renders from each frame's slot addresses and is frame-accurate.
|
|
;; The display was right and this buffer was not.
|
|
;;
|
|
;; Rooting at the slot's address alone does not fix it, and that was tried:
|
|
;; an address is not an expression, so the first RET has nothing to build
|
|
;; from. What the shadow stack changed is that the *step* does not have to be
|
|
;; an expression either. The daemon has the frame's address and every slot's
|
|
;; type, so going into a field is an address plus an offset with that field's
|
|
;; type — the arithmetic `Render.render' already does for the listing. So
|
|
;; there is a second rooting mode here, `flan-inspect-slot', and the daemon
|
|
;; verb behind it is `(:op "inspect" :frame N :slot I :path (...))'.
|
|
;;
|
|
;; The two roots are not equally capable and the buffer says which it is on:
|
|
;;
|
|
;; the expression root works on a *running* program and roots at anything
|
|
;; you can write, a call included. It cannot reach an option's payload,
|
|
;; because Flan has no accessor form that does, and it cannot say which
|
|
;; frame it means;
|
|
;;
|
|
;; the slot root names one frame and one slot, so it is exact, and it
|
|
;; reaches an option's payload and a data type case's fields, which have offsets
|
|
;; but no accessor. It needs a stopped program, it is refused if the
|
|
;; frame's body was redefined since it was entered — the same slot
|
|
;; fingerprint the listing is refused by — and it cannot root at an
|
|
;; expression, so `g' after the program resumes is refused rather than
|
|
;; quietly answered from somewhere else.
|
|
;;
|
|
;; `l' never crosses between them, and that is structural rather than a rule:
|
|
;; a stack entry carries its own root, RET only ever extends the path under
|
|
;; the root it already has, and every new root — `flan-inspect',
|
|
;; `flan-inspect-slot' — starts with an empty stack. So a mixed stack cannot
|
|
;; be built, and that stays true if a third rooting mode is ever added.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'seq)
|
|
(require 'subr-x)
|
|
|
|
(declare-function flan--request "flan" (form))
|
|
|
|
(defgroup flan-inspect nil
|
|
"Navigating values in a running Flan program."
|
|
:prefix "flan-inspect-"
|
|
:group 'flan)
|
|
|
|
(defcustom flan-inspect-buffer "*flan-inspect*"
|
|
"Where the inspector draws."
|
|
:type 'string)
|
|
|
|
(defvar flan-inspect-request-function #'flan--request
|
|
"How the inspector reaches the program.
|
|
Called with one plist — a request — and returning the reply plist. It is a
|
|
variable rather than a direct call so that a test can hand the renderers a
|
|
reply without a daemon behind them, and so that this file names
|
|
`flan.el' in exactly one place.")
|
|
|
|
;;; Reading what the renderer wrote
|
|
|
|
;; The value comes back as a string, and that string is very nearly an
|
|
;; s-expression — `(Blob {.id 7 .pos (V {.x 1.5 .y 0})})'. Nearly, because
|
|
;; Emacs' `read' has no `{', so it is parsed here instead. The grammar is
|
|
;; small and fixed by `Session.render' (lib/session.ml), and every case below
|
|
;; names the line of it that produces it.
|
|
;;
|
|
;; (Name {.f V .f V}) a struct, with ` ...' before the `}' if the walk hit
|
|
;; its span bound of 8 fields
|
|
;; [ V V V] an array or a slice, ` ...' likewise
|
|
;; (some V) / none an option
|
|
;; <ptr> a pointer, never followed
|
|
;; <Name> a named type the walk had no structure for
|
|
;; ... the depth bound, 4, reached at this position
|
|
;; :name an enum member, or its number if it matched none
|
|
;; "…" a string, escaped in C
|
|
;; true / false / () bool, and the value of a Unit expression
|
|
;; 1.5 / 7 / 18446… a number
|
|
;;
|
|
;; A node is a plist: :kind, :text (what the renderer wrote for it), :type
|
|
;; where there is one, and :children as a list of (LABEL . NODE).
|
|
|
|
(defun flan-inspect--skip-space (s i)
|
|
(while (and (< i (length s)) (memq (aref s i) '(?\s ?\n ?\t))) (setq i (1+ i)))
|
|
i)
|
|
|
|
(defun flan-inspect--read-string (s i)
|
|
"Read a quoted string starting at I (which is the opening quote)."
|
|
(let ((out (list ?\")) (i (1+ i)) (done nil))
|
|
(while (and (not done) (< i (length s)))
|
|
(let ((c (aref s i)))
|
|
(cond ((eq c ?\\)
|
|
(setq i (1+ i))
|
|
(when (< i (length s)) (push (aref s i) out) (setq i (1+ i))))
|
|
((eq c ?\") (push ?\" out) (setq i (1+ i)) (setq done t))
|
|
(t (push c out) (setq i (1+ i))))))
|
|
(cons (list :kind 'atom :text (concat (nreverse out))) i)))
|
|
|
|
(defun flan-inspect--read-atom (s i)
|
|
"Read a bare token at I: a number, a keyword, `true', `none', `...'."
|
|
(let ((start i))
|
|
(while (and (< i (length s))
|
|
(not (memq (aref s i) '(?\s ?\n ?\t ?\) ?\] ?\}))))
|
|
(setq i (1+ i)))
|
|
(let ((text (substring s start i)))
|
|
(cons (list :kind (if (equal text "...") 'trunc 'atom) :text text) i))))
|
|
|
|
(defun flan-inspect--read-angle (s i)
|
|
"Read `<ptr>' or `<Name>' at I."
|
|
(let ((end (or (string-match ">" s i) (1- (length s)))))
|
|
(let ((text (substring s i (1+ end))))
|
|
(cons (list :kind (if (equal text "<ptr>") 'ptr 'opaque) :text text)
|
|
(1+ end)))))
|
|
|
|
(defun flan-inspect--read-seq (s i)
|
|
"Read `[ V V]' at I, which is `[' — an array or a slice."
|
|
(let ((i (1+ i)) (kids nil) (n 0) (more nil) (done nil))
|
|
(while (not done)
|
|
(setq i (flan-inspect--skip-space s i))
|
|
(cond
|
|
((>= i (length s)) (setq done t))
|
|
((eq (aref s i) ?\]) (setq i (1+ i)) (setq done t))
|
|
(t (let ((r (flan-inspect--read s i)))
|
|
(setq i (cdr r))
|
|
;; A bare `...' inside a sequence is the renderer saying it stopped,
|
|
;; not an element. It is the last thing it writes either way.
|
|
(if (eq (plist-get (car r) :kind) 'trunc)
|
|
(setq more t)
|
|
(push (cons n (car r)) kids)
|
|
(setq n (1+ n)))))))
|
|
(cons (list :kind 'seq
|
|
:text (format "%d element%s%s" n (if (= n 1) "" "s")
|
|
(if more ", and more the renderer did not write" ""))
|
|
:truncated more
|
|
:children (nreverse kids))
|
|
i)))
|
|
|
|
(defun flan-inspect--read-struct (s i)
|
|
"Read `(Name {…})' or `(some V)' at I, which is `('."
|
|
(let ((j (1+ i)))
|
|
(let ((start j))
|
|
(while (and (< j (length s)) (not (memq (aref s j) '(?\s ?\))))) (setq j (1+ j)))
|
|
(let ((head (substring s start j)))
|
|
(cond
|
|
;; (some V). There is no accessor form in Flan that reaches an
|
|
;; option's payload — the compiler gets at it as field 1 and nothing
|
|
;; in the surface language does — so this parses, prints, and refuses
|
|
;; to be entered.
|
|
((equal head "some")
|
|
(let* ((r (flan-inspect--read s (flan-inspect--skip-space s j)))
|
|
(k (flan-inspect--skip-space s (cdr r))))
|
|
(cons (list :kind 'option :text "some" :type "Option"
|
|
:children (list (cons "some" (car r))))
|
|
(if (and (< k (length s)) (eq (aref s k) ?\))) (1+ k) k))))
|
|
(t
|
|
;; `(Name {' then `.field VALUE' pairs, then `})'.
|
|
(setq j (flan-inspect--skip-space s j))
|
|
(when (and (< j (length s)) (eq (aref s j) ?\{)) (setq j (1+ j)))
|
|
(let ((kids nil) (more nil) (done nil))
|
|
(while (not done)
|
|
(setq j (flan-inspect--skip-space s j))
|
|
(cond
|
|
((>= j (length s)) (setq done t))
|
|
((eq (aref s j) ?\}) (setq j (1+ j)) (setq done t))
|
|
;; A dot, which is how a struct literal is written in the
|
|
;; source and now how `Render.render' prints one. The colon
|
|
;; belongs to keywords — an enum member renders as `:green', and
|
|
;; one of those is a *value* here, never a field label — so the
|
|
;; two cannot be told apart by anything but this character.
|
|
;; `...' also begins with a dot and is the renderer saying it
|
|
;; stopped, not a field called `..'. A field name never starts
|
|
;; with a second dot, so one character of lookahead separates
|
|
;; them.
|
|
((and (eq (aref s j) ?.)
|
|
(< (1+ j) (length s))
|
|
(not (eq (aref s (1+ j)) ?.)))
|
|
(let ((start j))
|
|
(while (and (< j (length s)) (not (memq (aref s j) '(?\s ?\}))))
|
|
(setq j (1+ j)))
|
|
(let ((name (substring s (1+ start) j))
|
|
(r (flan-inspect--read s (flan-inspect--skip-space s j))))
|
|
(setq j (cdr r))
|
|
(push (cons name (car r)) kids))))
|
|
(t (let ((r (flan-inspect--read s j)))
|
|
(setq j (cdr r))
|
|
(if (eq (plist-get (car r) :kind) 'trunc)
|
|
(setq more t)
|
|
;; Not a `:field' and not `...'. Rather than guess, keep
|
|
;; it where it was written.
|
|
(push (cons "?" (car r)) kids))))))
|
|
(setq j (flan-inspect--skip-space s j))
|
|
(when (and (< j (length s)) (eq (aref s j) ?\))) (setq j (1+ j)))
|
|
(cons (list :kind 'struct :text head :type head
|
|
:truncated more
|
|
:children (nreverse kids))
|
|
j))))))))
|
|
|
|
(defun flan-inspect--read (s i)
|
|
"Read one rendered value out of S at I. Returns (NODE . NEXT-INDEX)."
|
|
(let ((i (flan-inspect--skip-space s i)))
|
|
(if (>= i (length s))
|
|
(cons (list :kind 'atom :text "") i)
|
|
(pcase (aref s i)
|
|
(?\( (flan-inspect--read-struct s i))
|
|
(?\[ (flan-inspect--read-seq s i))
|
|
(?\" (flan-inspect--read-string s i))
|
|
(?< (flan-inspect--read-angle s i))
|
|
(_ (flan-inspect--read-atom s i))))))
|
|
|
|
(defun flan-inspect-parse (rendered)
|
|
"Parse RENDERED — what the daemon put in a reply's :value — into a node."
|
|
(car (flan-inspect--read (or rendered "") 0)))
|
|
|
|
;;; Where a field is, said in Flan
|
|
|
|
;; A step is not an index into something remembered; it is a piece of source.
|
|
;; `(.pos b)' and `(at (.tags b) 2)' are expressions the program can be handed
|
|
;; exactly as a person would type them, which is what makes the whole thing
|
|
;; work without a handle to retain.
|
|
|
|
(defun flan-inspect-step-expr (expr step)
|
|
"The Flan expression reaching STEP inside EXPR.
|
|
A `:field' step may carry the type it was read out of, for the slot root's
|
|
benefit; here it is ignored, because an accessor is written the same way
|
|
whatever the value came from."
|
|
(pcase step
|
|
(`(:field ,name . ,_) (format "(.%s %s)" name expr))
|
|
(`(:index ,i) (format "(at %s %d)" expr i))
|
|
(_ expr)))
|
|
|
|
;;; Where a field is, said as an offset
|
|
|
|
;; The slot root's version of the same step, and it is not source: the daemon
|
|
;; is walking a type, so a field is its name and an element is its number.
|
|
;; Two cases need more than the name.
|
|
;;
|
|
;; A data type's payload sits at an offset that depends on which case the value
|
|
;; is in, and only the renderer knows which case it currently is — it wrote
|
|
;; `(Union.case {.f …})'. So the type travels with the step and the wire
|
|
;; spelling is `Union.case.f'. Guessing the case from a field name two
|
|
;; cases share would read one case's layout over another's payload.
|
|
;;
|
|
;; An option's payload has no name at all; it is the symbol `some'.
|
|
|
|
(defun flan-inspect-wire-step (step)
|
|
"STEP as the `inspect' op spells it."
|
|
(pcase step
|
|
(`(:field ,name ,type)
|
|
(if (and (stringp type) (string-match-p "\\." type))
|
|
(concat type "." name)
|
|
name))
|
|
(`(:field ,name) name)
|
|
(`(:index ,i) i)
|
|
(`(:some) 'some)
|
|
(_ (format "%s" step))))
|
|
|
|
;;; A root, and the path walked from it
|
|
|
|
;; A root is `(:expr EXPR)', `(:slot FRAME SLOT NAME)' or `(:addr N TYPE)'.
|
|
;; The path is a list of steps applied to it in order, and the pair is the
|
|
;; whole of this buffer's position — which is why a stack entry carries both
|
|
;; and `l' cannot cross between two kinds of root by accident.
|
|
;;
|
|
;; The third one has no frame in it. An expression root is evaluated wherever
|
|
;; the evaluator stands and a slot root is a frame and an index; an address
|
|
;; root is a number somebody has in their hand, out of a debugger or a
|
|
;; valgrind report, and the daemon asks the allocation registry what is there.
|
|
;; It takes no path: what it renders is a `(Ptr T)', so the whole answer is
|
|
;; the pointer arm's branch — followed if the storage is live, an epitaph if
|
|
;; it is not — and stepping in would be stepping from the pointee, which is
|
|
;; the deref the registry has only just been asked to bless.
|
|
|
|
(defun flan-inspect--root-label (root path)
|
|
"How ROOT walked by PATH is named at the top of the buffer and in the trail."
|
|
(pcase root
|
|
(`(:expr ,expr)
|
|
(seq-reduce #'flan-inspect-step-expr path expr))
|
|
(`(:slot ,frame ,_slot ,name)
|
|
(concat (format "%s [frame %d]" name frame)
|
|
(mapconcat (lambda (s)
|
|
(pcase s
|
|
(`(:field ,f . ,_) (concat "." f))
|
|
(`(:index ,i) (format "[%d]" i))
|
|
(`(:some) ".some")
|
|
(_ "")))
|
|
path "")))
|
|
;; The address in hex, because that is the spelling every tool that hands
|
|
;; one out uses, and the type only when it was *named*: an unnamed one is
|
|
;; the registry's own answer and the reply's own `:type' line says it.
|
|
(`(:addr ,addr ,ty)
|
|
(if ty (format "#x%x as %s" addr ty) (format "#x%x" addr)))
|
|
(_ "?")))
|
|
|
|
;;; Why a thing cannot be entered
|
|
|
|
;; Every refusal is by name and carries its reason, because the alternative —
|
|
;; RET doing nothing on some lines and something on others — is a UI that
|
|
;; teaches you nothing about the language.
|
|
|
|
(defun flan-inspect-refusal (node &optional root)
|
|
"Why NODE cannot be inspected, or nil if it can.
|
|
ROOT is the root the walk is on, because two of these are refusals of the
|
|
*expression* root rather than of the value. Omitted means the expression
|
|
root, which is the older and the more limited of the two."
|
|
(pcase (plist-get node :kind)
|
|
('struct (and (null (plist-get node :children))
|
|
"a struct with no fields the renderer could reach"))
|
|
('seq (and (null (plist-get node :children))
|
|
"an empty sequence: there is no element to go into"))
|
|
('option
|
|
;; The one place the two roots differ in the slot root's favour, and it
|
|
;; is worth saying which it is rather than refusing flatly: the payload
|
|
;; is field 1 and the compiler reaches it there, so an address root steps
|
|
;; into it by offset. Nothing in the surface language does, so an
|
|
;; expression root has nothing to send.
|
|
(and (not (eq (car-safe root) :slot))
|
|
"an option's payload: Flan has no accessor form that reaches it, so there is no expression to send. `i' on a local in the break buffer roots at the slot's address instead, and that root can step into it"))
|
|
('ptr
|
|
;; And its address is not here either. `Render.render' (lib/render.ml)
|
|
;; writes the bare word `<ptr>' for every pointer, on purpose: it is the
|
|
;; same renderer `print' uses, an address is not stable across runs, and
|
|
;; test_acceptance.ml pins the current text for exactly that reason.
|
|
;; Showing the address needs the renderer to write it, which is a decision
|
|
;; about the language's printer rather than about this buffer.
|
|
"a pointer: the renderer never follows one, and dereferencing a pointer on your behalf is not safe. It does not write the address either — `print' uses the same renderer, and an address is not stable across runs")
|
|
('trunc
|
|
"truncated: the walk stopped at its depth bound of 4. Inspect the field that holds it, which re-roots the walk")
|
|
('opaque
|
|
;; A *followed* pointer lands here rather than on the `ptr' arm above,
|
|
;; because that arm matches the bare word. Saying "no structure for this
|
|
;; type" of it would be false and unhelpful at once: it has structure, it
|
|
;; is right there, and the reason you cannot step in is that the step
|
|
;; would start from the pointee — the deref the registry blessed once and
|
|
;; is not being asked about again.
|
|
(if (string-prefix-p "<ptr " (or (plist-get node :text) ""))
|
|
"a pointer the registry let the renderer follow: the pointee is already drawn, one level deeper. Stepping in would step from it, which is a second deref nobody has asked about — root at it with `M-x flan-inspect-address' instead"
|
|
(format "%s: the walk had no structure for this type, so there are no fields to show"
|
|
(plist-get node :text))))
|
|
('atom (format "%s is an atom; it has no fields" (plist-get node :text)))
|
|
(_ "not something this inspector knows how to enter")))
|
|
|
|
;;; Drawing it
|
|
|
|
(defvar-local flan-inspect--root nil
|
|
"What this buffer's walk starts from.
|
|
One of `(:expr EXPR)\=', `(:slot FRAME SLOT NAME)\=' or `(:addr N TYPE)\='.")
|
|
(defvar-local flan-inspect--path nil
|
|
"The steps walked from `flan-inspect--root\=', outermost first.
|
|
Together with the root this is the whole of where the buffer is. It is a
|
|
path rather than a remembered value because nothing here can retain a Flan
|
|
value: every step is a fresh request, which is what keeps the view current.")
|
|
(defvar-local flan-inspect--stack nil
|
|
"Where we have been: a list of (ROOT PATH . POINT), last-pushed first.
|
|
Each entry carries its own root, which is what makes `l\=' unable to cross
|
|
between two kinds of root: it can only ever restore a pair that was pushed
|
|
whole.")
|
|
(defvar-local flan-inspect--node nil "The parsed value being shown.")
|
|
(defvar-local flan-inspect--type nil
|
|
"The type the daemon said the walk ended at, or nil if it did not say.
|
|
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.
|
|
A field is written with the dot it is written with in the source, which is also
|
|
what `flan-inspect-step-expr' puts in the expression it sends."
|
|
(let ((k (car child)))
|
|
(if (integerp k) (format "%d." k) (format ".%s" k))))
|
|
|
|
;;; What a leaf is, beyond its decimal
|
|
|
|
;; A number is shown in decimal and nothing else, which is the wrong base for
|
|
;; about half the numbers anyone opens this buffer for: a colour is
|
|
;; `0x303030FF', a gesture is an OR of flags, a mask is read a bit at a time.
|
|
;; The decimal is still first — it is what the value *is* — and the other two
|
|
;; bases are beside it.
|
|
;;
|
|
;; Nothing is asked of the program for this. It is arithmetic on a number the
|
|
;; renderer already wrote, which is why it works on a stopped program and costs
|
|
;; no round trip.
|
|
|
|
(defun flan-inspect--integer (node)
|
|
"NODE's value as an integer, or nil if it is not written as one.
|
|
Only a bare decimal integer counts. A float is not one: its bits are an IEEE
|
|
layout and reinterpreting them would be a different question from this, and one
|
|
the rendered text does not carry the width to answer."
|
|
(let ((text (plist-get node :text)))
|
|
(and (eq (plist-get node :kind) 'atom)
|
|
(stringp text)
|
|
(string-match-p "\\`-?[0-9]+\\'" text)
|
|
(string-to-number text))))
|
|
|
|
(defun flan-inspect--binary (n)
|
|
"N in base two, grouped in fours."
|
|
(let ((bits "") (n n))
|
|
(if (zerop n)
|
|
"0"
|
|
(while (> n 0)
|
|
(setq bits (concat (number-to-string (logand n 1)) bits)
|
|
n (ash n -1)))
|
|
;; Nibbles, because a mask is read in nibbles. Pad to a multiple of four
|
|
;; so the groups line up with the hex beside them.
|
|
(let ((pad (% (- 4 (% (length bits) 4)) 4)))
|
|
(setq bits (concat (make-string pad ?0) bits)))
|
|
(let ((out nil) (i 0))
|
|
(while (< i (length bits))
|
|
(push (substring bits i (min (+ i 4) (length bits))) out)
|
|
(setq i (+ i 4)))
|
|
(string-join (nreverse out) "_")))))
|
|
|
|
(defun flan-inspect--detail (node)
|
|
"The other bases NODE reads in, as a string, or nil.
|
|
A negative number is shown as the 64-bit two's complement it is in memory, and
|
|
says so: the rendered value carries no width, so 64 is the only one that can be
|
|
stated honestly — every Flan integer is rendered through i64."
|
|
(let ((n (flan-inspect--integer node)))
|
|
(when n
|
|
(if (>= n 0)
|
|
(format "0x%X 0b%s" n (flan-inspect--binary n))
|
|
(let ((two (logand n #xFFFFFFFFFFFFFFFF)))
|
|
(format "0x%X 0b%s (two's complement, 64-bit)"
|
|
two (flan-inspect--binary two)))))))
|
|
|
|
(defun flan-inspect--summary (node)
|
|
"One line for NODE, as it appears beside its label."
|
|
(pcase (plist-get node :kind)
|
|
('struct (format "(%s …%s)" (plist-get node :type)
|
|
(let ((n (length (plist-get node :children))))
|
|
(format " %d field%s" n (if (= n 1) "" "s")))))
|
|
('seq (plist-get node :text))
|
|
('option (format "(some …)"))
|
|
(_ (plist-get node :text))))
|
|
|
|
(defun flan-inspect--render (root path node stack &optional declared)
|
|
"Draw NODE, reached by ROOT walked by PATH, with STACK behind it.
|
|
DECLARED is the type the daemon named, when it named one."
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert (propertize (flan-inspect--root-label root path)
|
|
'face 'font-lock-function-name-face)
|
|
"\n")
|
|
;; The declared type wins over the one read back out of the rendering,
|
|
;; because it is the better fact and only one root can supply it: the slot
|
|
;; root is walking `Tast.fn.slots\=' and knows `i64\=' where the rendering says
|
|
;; only `7\='. An expression root has nothing but the rendering.
|
|
(insert (propertize
|
|
(if declared
|
|
(format "%s\n" declared)
|
|
(pcase (plist-get node :kind)
|
|
('struct (format "a %s\n" (plist-get node :type)))
|
|
('seq (format "%s\n" (plist-get node :text)))
|
|
('option "an option\n")
|
|
('ptr "a pointer — never followed\n")
|
|
(_ (format "%s\n" (plist-get node :text)))))
|
|
'face 'font-lock-type-face))
|
|
;; The other bases, under the value rather than beside it: this is the line
|
|
;; someone opened the inspector on a number *for*, and it is long.
|
|
(let ((detail (flan-inspect--detail node)))
|
|
(when detail (insert (propertize (concat detail "\n") 'face 'shadow))))
|
|
;; The stack made visible. CIDER keeps it and does not show it; here it is
|
|
;; the difference between a value and *which* value, and the thing that was
|
|
;; typed at the root is often several steps back by now.
|
|
(when stack
|
|
(insert (propertize
|
|
(concat " via "
|
|
(string-join
|
|
(reverse (mapcar (lambda (e)
|
|
(flan-inspect--root-label
|
|
(car e) (cadr e)))
|
|
stack))
|
|
" > ")
|
|
" > here\n")
|
|
'face 'shadow)))
|
|
(insert "\n")
|
|
(let ((kids (plist-get node :children)))
|
|
(cond
|
|
(kids
|
|
(insert (propertize (if (eq (plist-get node :kind) 'seq)
|
|
"--- Elements:\n" "--- Fields:\n")
|
|
'face 'font-lock-comment-face))
|
|
(let ((w (apply #'max 4 (mapcar (lambda (c) (length (flan-inspect--label c))) kids))))
|
|
(dolist (c kids)
|
|
(let* ((label (flan-inspect--label c))
|
|
(child (cdr c))
|
|
(step (if (integerp (car c)) (list :index (car c))
|
|
(list :field (car c))))
|
|
(start (point)))
|
|
(insert (format " %s%s " label
|
|
(make-string (- w (length label)) ?\s)))
|
|
(insert (flan-inspect--summary child))
|
|
;; A numeric field carries its other bases here, where the field
|
|
;; list is read, rather than only when it is opened on its own —
|
|
;; and a leaf cannot be opened on its own at all.
|
|
(let ((detail (flan-inspect--detail child)))
|
|
(when detail
|
|
(insert (propertize (concat " " detail) 'face 'shadow))))
|
|
(insert "\n")
|
|
(add-text-properties
|
|
start (point)
|
|
(list 'flan-inspect-step step
|
|
'flan-inspect-node child
|
|
'mouse-face 'highlight)))))
|
|
(when (plist-get node :truncated)
|
|
(insert (propertize
|
|
" ... the renderer stopped at its span bound of 8; the rest was not written\n"
|
|
'face 'font-lock-warning-face))))
|
|
(t
|
|
(insert (propertize
|
|
(format "Nothing to go into: %s\n"
|
|
(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
|
|
(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))))
|
|
|
|
;;; The commands
|
|
|
|
(defun flan-inspect--value (root path)
|
|
"Ask the program what ROOT walked by PATH holds.
|
|
Returns (RENDERED . TYPE), TYPE nil when the reply did not name one. Signals
|
|
if the program refuses — and it is allowed to: a slot root over a frame whose
|
|
body was redefined is refused by the same fingerprint the locals listing is
|
|
refused by, and answering from somewhere else instead is the bug this second
|
|
root exists to fix."
|
|
(let ((r (pcase root
|
|
(`(:expr ,_)
|
|
(funcall flan-inspect-request-function
|
|
(list :op "eval-expr"
|
|
:code (flan-inspect--root-label root path)
|
|
:file "<inspect>")))
|
|
(`(:slot ,frame ,slot ,_name)
|
|
(funcall flan-inspect-request-function
|
|
;; `:path\=' is omitted rather than sent empty, because
|
|
;; Emacs cannot print an empty list as anything but
|
|
;; `nil\=', which is a symbol on the wire and not a list.
|
|
;; A missing `:path\=' is the slot itself, which is what
|
|
;; an empty path means.
|
|
(append (list :op "inspect" :frame frame :slot slot)
|
|
(when path
|
|
(list :path
|
|
(mapcar #'flan-inspect-wire-step path))))))
|
|
(`(:addr ,addr ,ty)
|
|
(when path
|
|
;; Refused rather than dropped. A path with a step silently
|
|
;; gone would render a *different* value and say nothing,
|
|
;; which is the failure this whole buffer is built to avoid.
|
|
(user-error
|
|
"flan: an address root has no path; it renders the pointer, \
|
|
and whether that may be followed is the answer"))
|
|
(funcall flan-inspect-request-function
|
|
(append (list :op "at" :addr addr)
|
|
(when ty (list :type ty)))))
|
|
(_ (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")))
|
|
(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."
|
|
(let ((answer (flan-inspect--value root path))
|
|
(buf (get-buffer-create flan-inspect-buffer)))
|
|
(with-current-buffer buf
|
|
(unless (derived-mode-p 'flan-inspect-mode) (flan-inspect-mode))
|
|
(setq flan-inspect--root root)
|
|
(setq flan-inspect--path path)
|
|
(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)
|
|
buf))
|
|
|
|
;;;###autoload
|
|
(defun flan-inspect (expr)
|
|
"Inspect the value of EXPR in the running program.
|
|
Interactively, the expression before point, or one you type.
|
|
|
|
This is the expression root: EXPR is evaluated where the evaluator stands, so
|
|
it works on a running program but cannot say which frame it means. `i\=' in the
|
|
break buffer uses `flan-inspect-slot\=' for a local, for exactly that reason."
|
|
(interactive
|
|
(list (read-string "Inspect: "
|
|
(ignore-errors
|
|
(buffer-substring-no-properties
|
|
(save-excursion (backward-sexp) (point)) (point))))))
|
|
;; A new root, and therefore an empty stack. That is the whole of why `l\='
|
|
;; cannot walk out of one root into another: there is never an entry from a
|
|
;; different root left underneath it.
|
|
(flan-inspect--show (list :expr expr) nil nil))
|
|
|
|
;;;###autoload
|
|
(defun flan-inspect-slot (frame slot name)
|
|
"Inspect slot SLOT of stopped FRAME, which is called NAME.
|
|
The slot root. SLOT is an index and not a name, because a name is not an
|
|
identifier: two slots of one frame can share one, and a slot the daemon
|
|
refused is not in the listing at all, so neither the name nor the position in
|
|
the listing picks one out. The index is what `locals\=' puts on every line for
|
|
this."
|
|
(flan-inspect--show (list :slot frame slot name) nil nil))
|
|
|
|
(defvar flan-inspect-address-history nil
|
|
"Addresses `flan-inspect-address\=' has been given, most recent first.")
|
|
|
|
;;;###autoload
|
|
(defun flan-inspect-address (addr &optional type)
|
|
"Show what is at ADDR in the stopped program, as TYPE.
|
|
|
|
The address root. ADDR is a number — `#x7f…\=', or decimal — of the kind a
|
|
debugger, a valgrind report or a C shim\='s printf hands you, and which nothing
|
|
inside Flan will make for you: there is no integer-to-pointer cast in the
|
|
language, deliberately.
|
|
|
|
TYPE is optional, and leaving it out is the interesting half. A dev build
|
|
records the type at every allocation, so the registry already knows what was
|
|
put there and the daemon resolves that recorded name back to a type. Naming
|
|
one instead overrides it — for reading half a struct, or an element the table
|
|
recorded under a container\='s name — and the reply still carries what the
|
|
allocator wrote down, so the disagreement is never silent.
|
|
|
|
Refused while the program is running: whether an address is still live is
|
|
exactly what a running program is changing."
|
|
(interactive
|
|
(list (read-number "Address: "
|
|
(car (mapcar #'string-to-number
|
|
flan-inspect-address-history)))
|
|
(let ((s (read-string "As type (empty for what was recorded): ")))
|
|
(and (not (string-empty-p s)) s))))
|
|
(add-to-history 'flan-inspect-address-history (number-to-string addr))
|
|
(flan-inspect--show (list :addr addr type) nil nil))
|
|
|
|
(defun flan-inspect-into ()
|
|
"Go into the field or element at point.
|
|
Extends the path under the root this buffer already has; it never replaces the
|
|
root, which is what makes a mixed stack unconstructible."
|
|
(interactive)
|
|
(let ((step (get-text-property (point) 'flan-inspect-step))
|
|
(node (get-text-property (point) 'flan-inspect-node)))
|
|
(unless step (user-error "flan: nothing to inspect on this line"))
|
|
(let ((why (flan-inspect-refusal node flan-inspect--root)))
|
|
(when why (user-error "flan: %s" why)))
|
|
;; A data type case's field, under an expression root. This is a refusal of
|
|
;; the *parent* and not of the value at point, which is why it is here and
|
|
;; not in `flan-inspect-refusal\=': a struct field that happens to hold a
|
|
;; data type is reached by an ordinary accessor and must stay enterable;
|
|
;; it is a field *of the data type itself* that has no accessor. `(match ...)\=' is
|
|
;; how a data type is opened in the language, and it binds names rather than
|
|
;; producing a value to send, so there is nothing to build here. The
|
|
;; renderer wrote the head as `Type.case\=', which is the one type spelling
|
|
;; with a dot in it — a package qualifies with a slash.
|
|
(let ((ty (plist-get flan-inspect--node :type)))
|
|
(when (and (not (eq (car-safe flan-inspect--root) :slot))
|
|
(stringp ty)
|
|
(string-match-p "\\." ty))
|
|
(user-error
|
|
"flan: %s"
|
|
(concat "a data type case's field: it is reached by (match ...) in the "
|
|
"language, not by an accessor, so there is no expression to "
|
|
"send. `i' on a local in the break buffer roots at the frame's "
|
|
"slot instead, and that root steps into it by offset"))))
|
|
;; The line carries the step that names the field; what the wire needs
|
|
;; beyond the name is the type it is a field *of*, and that is this
|
|
;; buffer's own node — the parent of the one at point. A data type's payload
|
|
;; sits at an offset that depends on the case, so `Type.case\=' has to
|
|
;; travel with the name. An option's payload has no name at all and is
|
|
;; the symbol `some\='.
|
|
(let* ((step (if (eq (plist-get flan-inspect--node :kind) 'option)
|
|
(list :some)
|
|
(pcase step
|
|
(`(:field ,name)
|
|
(list :field name (plist-get flan-inspect--node :type)))
|
|
(_ step))))
|
|
(path (append flan-inspect--path (list step)))
|
|
(stack (cons (cons flan-inspect--root
|
|
(cons flan-inspect--path (point)))
|
|
flan-inspect--stack)))
|
|
(flan-inspect--show flan-inspect--root path stack))))
|
|
|
|
(defun flan-inspect-pop ()
|
|
"Back to the value you came from, at the line you left.
|
|
The entry restored carries its own root, so this cannot land on a root other
|
|
than the one it was pushed under."
|
|
(interactive)
|
|
(unless flan-inspect--stack
|
|
(user-error "flan: this is the root; there is nothing behind it"))
|
|
(let* ((top (car flan-inspect--stack))
|
|
(rest (cdr flan-inspect--stack)))
|
|
(flan-inspect--show (car top) (cadr top) rest)
|
|
(with-current-buffer flan-inspect-buffer
|
|
(goto-char (min (cddr top) (point-max))))))
|
|
|
|
(defun flan-inspect-refresh ()
|
|
"Read the same root and path again.
|
|
Deliberately a key rather than a timer: an expression root runs in the
|
|
program, and a root with an effect in it would fire once a second forever. A
|
|
slot root has no effect to repeat, but it can be refused — the program may
|
|
have resumed, or the frame's body may have been redefined — and a refusal
|
|
someone asked for reads very differently from one a timer produced."
|
|
(interactive)
|
|
(unless flan-inspect--root (user-error "flan: nothing is being inspected"))
|
|
(let ((p (point)))
|
|
(flan-inspect--show flan-inspect--root flan-inspect--path
|
|
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
|
|
by hand: a field line has the property on all of it, so `next-single-...'
|
|
from the middle of one finds the *end* of the line you are already on, and
|
|
forward and backward then disagree about where a field begins."
|
|
(let ((out nil) (p (point-min)))
|
|
(while (< p (point-max))
|
|
;; A new field begins where the property's *value* changes, not where the
|
|
;; property appears: field lines are contiguous, so the last character of
|
|
;; one carries a step just as the first character of the next does.
|
|
(when (and (get-text-property p 'flan-inspect-step)
|
|
(or (= p (point-min))
|
|
(not (equal (get-text-property p 'flan-inspect-step)
|
|
(get-text-property (1- p) 'flan-inspect-step)))))
|
|
(push p out))
|
|
(setq p (1+ p)))
|
|
(nreverse out)))
|
|
|
|
(defun flan-inspect-next (&optional n)
|
|
"Move to the next inspectable line. With N, that many.
|
|
Wraps, as CIDER's does: a list you have walked off the end of should come
|
|
back round rather than stop dead."
|
|
(interactive "p")
|
|
(let ((fields (flan-inspect--fields)))
|
|
(unless fields (user-error "flan: there is nothing to move between"))
|
|
(dotimes (_ (or n 1))
|
|
(goto-char (or (seq-find (lambda (p) (> p (point))) fields)
|
|
(car fields))))))
|
|
|
|
(defun flan-inspect-previous (&optional n)
|
|
"Move to the previous inspectable line. With N, that many.
|
|
Wraps too — the same list, walked the other way, and an asymmetry here is
|
|
the kind of thing nobody reports and everybody notices."
|
|
(interactive "p")
|
|
(let ((fields (flan-inspect--fields)))
|
|
(unless fields (user-error "flan: there is nothing to move between"))
|
|
(dotimes (_ (or n 1))
|
|
(goto-char (or (seq-find (lambda (p) (< p (point))) (reverse fields))
|
|
(car (last fields)))))))
|
|
|
|
(defvar flan-inspect-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
;; CIDER's, and the same letters mean the same things: someone who has used
|
|
;; one should not have to learn the other.
|
|
(define-key map (kbd "RET") #'flan-inspect-into)
|
|
(define-key map [mouse-1] #'flan-inspect-into)
|
|
(define-key map "l" #'flan-inspect-pop)
|
|
(define-key map "g" #'flan-inspect-refresh)
|
|
(define-key map (kbd "TAB") #'flan-inspect-next)
|
|
(define-key map "n" #'flan-inspect-next)
|
|
(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'.")
|
|
|
|
(define-derived-mode flan-inspect-mode special-mode "flan-inspect"
|
|
"Look at a value in the running Flan program."
|
|
(setq buffer-read-only t)
|
|
(setq-local truncate-lines t))
|
|
|
|
(provide 'flan-inspect)
|
|
;;; flan-inspect.el ends here
|