Joseph Ferano
a9c0c3e9bf
Three follow-ups to the registry reader. The agent's "reg types" handler held its four row buffers as statics. The lock argument for that was right — request_lock is held across the whole of handle_line from both entry points — but the BSS was not: 8KB in every build this package is linked into, including a release build of a game that imports the agent and never writes a row. That is flan_dev.c's own argument against a fixed table at a thirty-second of the size. Malloc'd and freed per request, like the watch handler beside it. A followed pointer parses as an opaque node, so the inspector refused it with "no structure for this type" — false and unhelpful at once. It has structure, it is drawn, and the reason you cannot step in is that the step would start from the pointee. Said that way instead. And the three new commands have elisp tests: the address root's wire, that a path is refused rather than dropped, the listing's rows and totals, the overflow warning, and a build with no registry refusing rather than showing an empty table that reads like a program holding nothing.
817 lines
40 KiB
EmacsLisp
817 lines
40 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)', `(: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 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
|