Joseph Ferano
03d4460d72
OCaml side is done and builds. Emacs side is mid-edit and INCOMPLETE — see the handoff below. `dune build --root . @check` is green. `dune test --root .` was NOT run. The .el files were not byte-compiled and flan-inspect.el will not work as it stands: the state layer still speaks the old single-expression shape while the helpers above it have been rewritten for roots and paths. WHAT WORKS (daemon, lib/, in the parent commit and unchanged here) - `(:op "inspect" :frame N :slot I :path (...))` renders one value rooted at a stopped frame's slot address. `Session.render_slot` is `render_locals` with a path applied to the root before the walk and one line out instead of one per slot; no second walk was written and no backend change was needed. - A path step is a string for a struct field, an integer for an array or slice element, and the symbol `some` for an option's payload. A union case field is spelled `Union.case.field`, because the payload's offset depends on the case and only the renderer knows which case the value is in. - Every step that does not fit the type in hand is refused by name with the reason: a field the type does not have, an index past a fixed array's end, `some` on something that is not an option, a union field without its case. - The frame's identity IS checked, and not by a second copy: `Dev.stopped_frame` is one function now and `locals` and `inspect` both go through it — alive, stopped, frame exists, the frame is the program's and not a thunk's, the body is one this session holds, the slot count matches, and `Emit.slot_fingerprint` matches. `inspect` additionally refuses an unbound slot, for the listing's reason: a null address would fault on the stopped game thread. - The slot travels by INDEX, not by name. Two slots can share a name (`fresh_slot` only allocates) and a refused slot is not in the listing, so neither the name nor the position identifies one. `locals` now puts the slot index as a fourth element on each `:locals` entry. - `Dev.run_render_thunk` is one function; `locals`, `globals` and `inspect` share the build/deliver/wait/read tail. - `layout`'s "union values are milestone 6" is corrected. WHAT IS HALF-BUILT, AND EXACTLY WHERE IT STOPS `emacs/flan-inspect.el`. Done: the header comment explaining the two roots; `flan-inspect-step-expr` taking a 3-element `:field` step; `flan-inspect-wire-step`; `flan-inspect--root-label`; `flan-inspect-refusal` taking an optional ROOT and allowing an option's payload under a `:slot` root. NOT done, and this is the whole of what is left: 1. `flan-inspect--expr` / `flan-inspect--stack` still hold a bare expression. They must become `flan-inspect--root` (`(:expr EXPR)` or `(:slot FRAME SLOT NAME)`) plus `flan-inspect--path`, with stack entries of `(ROOT PATH . POINT)`. 2. `flan-inspect--value` must branch on the root: `eval-expr` with `(flan-inspect--root-label root path)` for `:expr`; for `:slot`, send `(:op "inspect" :frame F :slot S :path P)` with P built by `flan-inspect-wire-step` over the path, and take `:value` from the reply. 3. `flan-inspect--show`, `-into`, `-pop`, `-refresh` rewired to (ROOT PATH). `-into` must build a `:some` step when the node's kind is `option`, and put the parent node's `:type` as the third element of a `:field` step. 4. New entry point `flan-inspect-slot (frame slot name)`, kept separate from `flan-inspect (expr)` — `emacs/flan-mode.el` autoloads and binds the latter and that file is out of this lane. 5. `emacs/flan-cnr.el`: the `flan-cnr-inspect` text property must carry `(:slot FRAME SLOT NAME)` on a local line — the slot index is `(nth 3 l)` now — and `(:expr NAME)` on a global line, with `flan-cnr-inspect` dispatching to the right entry point. 6. `emacs/test-flan-cider.el`: the fixture at "`i' on a local inspects it by name" asserts the old behaviour and must be rewritten; the locals fixtures need a fourth element. 7. `test/test_dev.ml`: no coverage of the new op yet. The discriminating test to write first is a stack whose OUTER frame has a local whose name is also a global with a different value, asserting `inspect` answers the frame's value. A new `test/programs/dev-inspect.flan` is picked up by the existing glob. 8. `BUILT.md`, `emacs/MANUAL.md`, and striking the item from `NEXT.md`'s "Decided in discussion" and `DISCUSS.md` item 1 — none done. THE THREE ANSWERS THE TASK ASKED FOR - Navigation in the new mode: the daemon supports it fully — RET extends the path, `l` shortens it, and both are a fresh request, so the view is never stale. The Emacs half of that is item 3 above and is not wired. - `l` does not cross between the modes, 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 starts with an empty stack. A mixed stack cannot be constructed, so the question does not arise — and it stays answered if a third rooting mode is added. - What each mode cannot do that the other can. The expression root works on a RUNNING program and roots at anything you can write, a call included; it cannot name a frame, so it is the bug. The slot root names one frame and one slot and is exact; it reaches an option's payload and a union case's fields, which have offsets but no accessor in the surface language; it needs a stopped program, it is refused when the frame's body was redefined since it was entered, and it cannot root at an expression at all.
640 lines
30 KiB
EmacsLisp
640 lines
30 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--stack nil
|
|
"Where we have been: a list of (EXPR . POINT), innermost last-pushed first.")
|
|
(defvar-local flan-inspect--expr nil "The expression this buffer is showing.")
|
|
(defvar-local flan-inspect--node nil "Its parsed value.")
|
|
|
|
(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 (expr node stack)
|
|
"Draw NODE, reached by EXPR, with STACK behind it."
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert (propertize expr 'face 'font-lock-function-name-face) "\n")
|
|
(insert (propertize
|
|
(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 #'car 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))
|
|
'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 (expr)
|
|
"Ask the program for EXPR's value, rendered. Signals if it refuses."
|
|
(let ((r (funcall flan-inspect-request-function
|
|
(list :op "eval-expr" :code expr :file "<inspect>"))))
|
|
(unless (equal (plist-get r :status) "ok")
|
|
(user-error "flan: %s" (or (plist-get r :message) "refused")))
|
|
(or (plist-get r :value)
|
|
(user-error "flan: the program answered without a value for %s" expr))))
|
|
|
|
(defun flan-inspect--show (expr &optional stack)
|
|
"Render EXPR in the inspector buffer, with STACK behind it."
|
|
(let ((value (flan-inspect--value expr))
|
|
(buf (get-buffer-create flan-inspect-buffer)))
|
|
(with-current-buffer buf
|
|
(unless (derived-mode-p 'flan-inspect-mode) (flan-inspect-mode))
|
|
(setq flan-inspect--expr expr)
|
|
(setq flan-inspect--node (flan-inspect-parse value))
|
|
(setq flan-inspect--stack stack)
|
|
(flan-inspect--render expr flan-inspect--node stack))
|
|
(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."
|
|
(interactive
|
|
(list (read-string "Inspect: "
|
|
(ignore-errors
|
|
(buffer-substring-no-properties
|
|
(save-excursion (backward-sexp) (point)) (point))))))
|
|
(flan-inspect--show expr nil))
|
|
|
|
(defun flan-inspect-into ()
|
|
"Go into the field or element at point."
|
|
(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)))
|
|
(when why (user-error "flan: %s" why)))
|
|
(let ((expr (flan-inspect-step-expr flan-inspect--expr step))
|
|
(stack (cons (cons flan-inspect--expr (point)) flan-inspect--stack)))
|
|
(flan-inspect--show expr stack))))
|
|
|
|
(defun flan-inspect-pop ()
|
|
"Back to the value you came from, at the line you left."
|
|
(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) rest)
|
|
(with-current-buffer flan-inspect-buffer
|
|
(goto-char (min (cdr top) (point-max))))))
|
|
|
|
(defun flan-inspect-refresh ()
|
|
"Read the same expression again.
|
|
Deliberately a key rather than a timer: the expression runs in the program,
|
|
and a root with an effect in it would fire once a second forever."
|
|
(interactive)
|
|
(unless flan-inspect--expr (user-error "flan: nothing is being inspected"))
|
|
(let ((p (point)))
|
|
(flan-inspect--show flan-inspect--expr 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
|