From b661cd788bd38e0da0951054723a652e0af01cde Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 04:14:47 +0700 Subject: [PATCH] The shape of a condition is not the same refusal as its contents MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Saying "the fields are not available" was under-claiming. A condition is a struct, and Tast.structs holds every struct's field names and types in the daemon, which owns the build — no running program is involved in answering what a Missing is made of. Only the values need the pointer the break loop was handed, and break_loop currently discards that pointer, so they are two different gaps with two different fixes on two different sides of the socket. The buffer now draws a field named and typed with its value refused, which is what tells you whether the field you were about to blame is even a field of this condition. Navigation backwards was not the same list walked the other way. Forward wrapped and backward stopped, and from the middle of a line the two disagreed about where a field begins — a field line carries the property on all of it, so a property-change walk from mid-line finds the end of the field you are already in. Both now go through one list of field starts. The mid-line case went red on the first try and the expectation was the thing that was wrong: landing on the current field's start is what CIDER does and is the less surprising of the two. --- emacs/flan-cnr.el | 41 ++++++++++++++++++------ emacs/flan-inspect.el | 53 ++++++++++++++++++++----------- emacs/test-flan-cider.el | 67 ++++++++++++++++++++++++++++++++++++++-- 3 files changed, 131 insertions(+), 30 deletions(-) diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index fb2ad90..525aaa8 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -69,8 +69,10 @@ from fixtures, and so `flan-dev.el' is named in one place.") ;; Each carries its status in the same three words the design uses. (defconst flan-cnr-unavailable - '((fields - . "the break loop is handed the condition as an opaque pointer and its class name; nothing at run time can render a value whose type it does not know, and the pointer never leaves the program [needs an agent verb: `condition', plus a daemon-built render thunk]") + '((layout + . "which struct the class name refers to [needs a daemon op: `layout'. The field names and types are in `Tast.structs', which the daemon holds because it owns the build — no running program is involved. It is the one piece of this buffer that is a day's work on one side of the socket]") + (value + . "the break loop is handed the condition as an opaque pointer, and `break_loop' currently discards it; nothing at run time can render a value whose type it does not know [needs an agent verb: `condition', to stash and hand back the pointer, and a daemon-built render thunk aimed at it]") (site . "a restart frame carries its name and the hash matching uses, and no location [needs a location in the restart frame, which the compiler must emit]") (params @@ -125,17 +127,33 @@ list already says it." 'face 'shadow))) (insert "\n") (flan-cnr--section "Condition fields:") + ;; Two refusals, not one, and keeping them apart is the point. The *shape* of + ;; a condition — its field names and their types — is in `Tast.structs', + ;; which the daemon holds because it owns the build; no running program is + ;; involved in answering it. Only the *values* need the pointer the break + ;; loop was handed. So a field can be named and typed while its value is + ;; refused, which is strictly more than saying nothing, and it is what tells + ;; you whether the :path you were about to blame is even a field of this + ;; condition. (let ((fields (plist-get state :fields))) (if (null fields) - (insert (flan-cnr--unavailable 'fields)) - (let ((w (apply #'max 4 (mapcar (lambda (f) (length (car f))) fields)))) + (insert (flan-cnr--unavailable 'layout)) + (let ((w (apply #'max 4 (mapcar (lambda (f) (length (nth 0 f))) fields))) + (tw (apply #'max 4 (mapcar (lambda (f) (length (or (nth 1 f) ""))) fields)))) (dolist (f fields) - (let ((start (point))) - (insert (format " :%s%s %s\n" (car f) - (make-string (- w (length (car f))) ?\s) - (cadr f))) + (let ((start (point)) + (name (nth 0 f)) (type (or (nth 1 f) "?")) (value (nth 2 f))) + (insert (format " :%s%s %s%s " name + (make-string (- w (length name)) ?\s) + (propertize type 'face 'font-lock-type-face) + (make-string (- tw (length type)) ?\s))) + (insert (if value value + (propertize (concat "value not available — " + (flan-cnr--why 'value)) + 'face 'font-lock-comment-face)) + "\n") (add-text-properties start (point) - (list 'flan-cnr-inspect (caddr f) + (list 'flan-cnr-inspect nil 'mouse-face 'highlight))))))) (insert "\n")) @@ -371,7 +389,10 @@ section saying why rather than leaving one out, and a section that is absent cannot be told from one that is empty." (list :condition (plist-get reply :condition) :restarts (plist-get reply :restarts) - :fields nil ; see `flan-cnr-unavailable' + ;; Both nil deliberately: `break' answers a class name and a list of + ;; restart names, and nothing else exists to put here yet. The renderer + ;; draws a section saying why rather than leaving one out. + :fields nil :stack nil :locals nil)) diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index 2b54992..74d1e48 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -386,29 +386,46 @@ and a root with an effect in it would fire once a second forever." (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." + "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") - (dotimes (_ (or n 1)) - (let ((p (next-single-property-change (point) 'flan-inspect-step))) - (while (and p (null (get-text-property p 'flan-inspect-step))) - (setq p (next-single-property-change p 'flan-inspect-step))) - (if p (goto-char p) - ;; Wrap, as CIDER's does: a list you have walked off the end of should - ;; come back round rather than stop dead. - (goto-char (point-min)) - (let ((q (next-single-property-change (point) 'flan-inspect-step))) - (when q (goto-char q))))))) + (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." + "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") - (dotimes (_ (or n 1)) - (let ((p (previous-single-property-change (point) 'flan-inspect-step))) - (while (and p (null (get-text-property p 'flan-inspect-step))) - (setq p (previous-single-property-change p 'flan-inspect-step))) - (when p (goto-char (or (previous-single-property-change (1+ p) 'flan-inspect-step) - 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))) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 54bdd13..7dfbfac 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -169,7 +169,37 @@ (flan-inspect-next) (test-flan--check "and walks to the third" (equal (get-text-property (point) 'flan-inspect-step) - '(:field "pos"))))) + '(:field "pos"))) + ;; Backwards is the same list walked the other way. It is tested because + ;; an asymmetry here is the kind of thing nobody reports and everybody + ;; notices — and because point lands mid-line after a search, where a + ;; property-change walk and a field walk disagree. + (flan-inspect-previous) + (test-flan--check "p comes back to the second" + (equal (get-text-property (point) 'flan-inspect-step) + '(:field "name"))) + ;; From the middle of a line, `p' goes to the start of the field point is + ;; *in*, which is CIDER's behaviour and the reason both commands go + ;; through one list of field starts: walking property changes from + ;; mid-line finds the end of the current field instead, and forward and + ;; backward then disagree about where a field begins. + (end-of-line) + (flan-inspect-previous) + (test-flan--check "from mid-line, p reaches this field's start" + (equal (get-text-property (point) 'flan-inspect-step) + '(:field "name"))) + (flan-inspect-previous) + (test-flan--check "and then the one before it" + (equal (get-text-property (point) 'flan-inspect-step) + '(:field "id"))) + (flan-inspect-previous) + (test-flan--check "p wraps to the last, as n wraps to the first" + (equal (get-text-property (point) 'flan-inspect-step) + '(:field "pos"))) + (flan-inspect-next) + (test-flan--check "and n wraps round from it" + (equal (get-text-property (point) 'flan-inspect-step) + '(:field "id"))))) ;; Going in sends a *different expression*, which is the entire adaptation. (let ((asked nil)) @@ -283,8 +313,10 @@ (string-match-p " 3: \\[abort\\]" text)) ;; The rule: nothing implemented is refused by name, with the reason. These ;; three sections exist and are empty, and each says what would fill it. + ;; The shape of a condition and the values in it are two different + ;; refusals, and with nothing at all the outer one is what shows. (test-flan--check "the condition's fields are refused, not omitted" - (string-match-p "Condition fields:\n not available.*opaque pointer" text)) + (string-match-p "Condition fields:\n not available.*Tast.structs" text)) (test-flan--check "the stack is refused, naming DWARF" (string-match-p "Stack.*\n not available.*DWARF" (substring text (string-match "--- Stack" text)))) @@ -402,6 +434,37 @@ ;; `flan-cnr-show' refuses a running program by name rather than opening an ;; empty buffer. +;; The layout without the values: what a `layout' op alone would buy. The +;; names and the types come out of Tast.structs, which the daemon holds +;; whether or not a program is running; only the values need the pointer the +;; break loop was handed. Drawing the two apart is strictly more than saying +;; nothing, and it is what tells you whether the field you were about to +;; blame is even a field of this condition. +(let ((text (with-current-buffer + (test-flan--cnr (list :condition "Missing" :restarts '("retry") + :fields '(("path" "string" nil) + ("tried" "i32" "3")))) + (buffer-string)))) + (test-flan--check "a field is named and typed even with no value" + (string-match-p ":path *string *value not available" text)) + (test-flan--check "and the missing value names the verb it needs" + (string-match-p "value not available.*agent verb: `condition'" text)) + (test-flan--check "a value that is there is simply shown" + (string-match-p ":tried *i32 *3" text))) + +;; Backwards through the buffer, for the same reason as in the inspector. +(with-current-buffer (test-flan--cnr + (list :condition "Missing" :restarts '("retry" "skip"))) + (goto-char (point-min)) + (search-forward "[abort]") + (beginning-of-line) + (flan-cnr-previous) + (test-flan--check "p from abort lands on the last restart" + (equal (get-text-property (point) 'flan-cnr-index) 1)) + (flan-cnr-next) + (test-flan--check "and n goes back to abort" + (get-text-property (point) 'flan-cnr-abort))) + (let ((flan-cnr-request-function (lambda (_) '(:status "ok" :restarts nil :stopped nil)))) (test-flan--check "a running program is refused, by name"