Joseph Ferano
d9404bb34a
`-dev-` was in every Emacs symbol this client owns and meant nothing to anyone typing one: the daemon is `flan dev` at a shell, but from inside Emacs there is no other kind of connection to distinguish it from. `M-x flan-dev` is now `M-x flan`, `flan-dev-quit` is `flan-quit`, the private prefix `flan-dev--` is `flan--`, and every defcustom follows — ninety-odd symbols, with the two files renamed to emacs/flan.el and emacs/test-flan.el so the file names say the same thing as the symbols in them. No aliases. Renaming a defcustom breaks a config that names it and there is no way around that; the repo has no precedent for softening one, and an alias left behind is what keeps a rename from finishing. MANUAL.md says the old names are gone and how to fix a config, which is the whole of the migration path. Three strings are not symbols and keep their spelling: `.flan-dev.sock`, which bin/main.ml writes and which a renamed variable searching for a renamed file would simply never find; and the two buffer names `*flan-dev*` and ` *flan-dev*`, which name the `flan dev` subcommand's own output rather than anything in elisp. `flan dev` with a space is the CLI and is untouched everywhere. The entry point also stops asking a question it already has the answer to. From a buffer visiting a .flan file it starts that file; from anywhere else it reads one from the minibuffer as before; `C-u` reads one either way, which is how you start a second program without leaving the first. The current buffer is still the only source of the default — the bug where a previous project won over the buffer you were in was fixed by removing `flan--file` from that position, and nothing here puts it back. Four checks on the `interactive' form, evaluated on its own rather than by calling the command, because calling it would build and launch a program and the question is only which file the form arrives at and whether it had to ask. A fifth asserts that nothing answers to the old names. test/test_emacs.ml loads the test file by path and test/test_session.ml names the client file in a comment, so the rename reaches those two lines; nothing else outside emacs/ and the docs moved. Verified by byte-compiling every file clean and by `dune test` and `@page`.
836 lines
41 KiB
EmacsLisp
836 lines
41 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 '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.")
|
|
|
|
(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))))))
|
|
(`(: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")))
|
|
(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))
|
|
|
|
(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))))))
|
|
|
|
(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
|