Joseph Ferano
306fc88094
The capability lists were written before the code held the line they claim. Under an expression root, RET on a field of a union built `(.at s)' and sent it, and the checker refused it — "a union's fields belong to a case ... they are reached by (match ...)". A refusal from the far end of a socket is exactly what this buffer's own comment says not to do: every refusal is by name, here, with the reason, because RET working on some lines and erroring on others teaches nothing about the language. It is a refusal of the *parent* and not of the value at point, which is why it is not in `flan-inspect-refusal': a struct field that merely holds a union is an ordinary accessor and has to stay enterable. It is a field of the union itself that cannot be written. The two cases are one test each. The slot root steps into it by offset and is unaffected, which is the difference the manual now claims and the tests now show. `lib/dev.ml' cited DISCUSS.md item 1 as a hole; item 1 is the answer now, so it cites BUILT.md instead. And the item 1 stub is two sentences and a pointer — everything else in it is in BUILT.md verbatim, and DISCUSS.md's own header says nothing in it is a decision.
754 lines
36 KiB
EmacsLisp
754 lines
36 KiB
EmacsLisp
;;; flan-inspect.el --- Navigate a running program's values -*- lexical-binding: t; -*-
|
|
|
|
;; `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 union 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 'seq)
|
|
(require 'subr-x)
|
|
|
|
(declare-function flan-dev--request "flan-dev" (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-dev--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-dev.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 union'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)' or `(:slot FRAME SLOT NAME)'. 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.
|
|
|
|
(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 "")))
|
|
(_ "?")))
|
|
|
|
;;; 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
|
|
(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.
|
|
Either `(:expr EXPR)\=' or `(:slot FRAME SLOT NAME)\='.")
|
|
(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.")
|
|
|
|
(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")
|
|
(insert (propertize
|
|
"RET inspect 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))))))
|
|
(_ (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))))
|
|
|
|
(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--node (flan-inspect-parse (car answer)))
|
|
(setq flan-inspect--type (cdr answer))
|
|
(setq flan-inspect--stack stack)
|
|
(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))
|
|
|
|
(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 union 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
|
|
;; union is reached by an ordinary accessor and must stay enterable; it is
|
|
;; a field *of the union itself* that has no accessor. `(match ...)\=' is
|
|
;; how a union 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 `Union.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 union 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 union's payload
|
|
;; sits at an offset that depends on the case, so `Union.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))))))
|
|
|
|
(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)
|
|
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
|