From 4d29e52dbe6d70d740433d1458396dff25bc0e3b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 20:31:18 +0700 Subject: [PATCH] The inspector's stack carries a root, so `i' names the frame it is looking at MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `i' on a local sent the local's *name* to be evaluated, and an expression is evaluated where the evaluator stands. That is the right frame only when the frame is the innermost one; 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 and nothing saying the two disagree. The daemon verb for the fix landed already. What was missing was the state layer under it: `flan-inspect--expr' held a bare expression, so there was nowhere to put a frame. It is `flan-inspect--root' and `flan-inspect--path' now — `(:expr E)' or `(:slot FRAME SLOT NAME)', plus the steps walked from it — and a stack entry is `(ROOT PATH . POINT)'. RET appends a step, `l' restores a pair it pushed. Every step is still a fresh request, so the view is never stale. `l' cannot cross between the two roots, and that is structural rather than a rule someone has to keep: RET only ever extends the path under the root the buffer already has, and `flan-inspect' and `flan-inspect-slot' both start with an empty stack, so a mixed stack cannot be built at all. It stays true if a third rooting mode is added. The break buffer hands over the frame and the slot *index*, which is the fourth element `locals' now puts on each line. A name does not identify a slot: two slots of one frame can share one, and a refused slot is not in the listing, so its position is not an identifier either. A global still goes in by name, because a global's name really is an expression that means the same thing wherever it is evaluated — the loaded thunk binds to the program's own storage through the dynamic linker. Two smaller things the wire needed. A field step carries the type it was read out of, because a union's payload is at an offset that depends on the case and only the renderer knows which case the value is in — so `Union.case.field', which is the head the renderer wrote with the field appended. And an empty path is sent by omission: Emacs prints an empty list as `nil', which is a symbol on the wire, so the daemon now reads that as no path rather than refusing it as a step. --- emacs/flan-cnr.el | 39 +++++-- emacs/flan-inspect.el | 177 +++++++++++++++++++++++------- emacs/flan-inspect.elc | Bin 19147 -> 0 bytes emacs/test-flan-cider.el | 228 ++++++++++++++++++++++++++++++++++++--- lib/dev.ml | 5 + 5 files changed, 384 insertions(+), 65 deletions(-) delete mode 100644 emacs/flan-inspect.elc diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 953cf79..73e645f 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -47,6 +47,7 @@ (declare-function flan-dev--request "flan-dev" (form)) (declare-function flan-inspect "flan-inspect" (expr)) +(declare-function flan-inspect-slot "flan-inspect" (frame slot name)) (defgroup flan-cnr nil "The conditions and restarts buffer." @@ -257,9 +258,19 @@ its use, because it is a fact about the prelude.") (insert (format " %s %s = %s\n" (propertize (nth 1 l) 'face 'font-lock-type-face) (nth 0 l) (nth 2 l))) - (add-text-properties start (point) - (list 'flan-cnr-inspect (nth 0 l) - 'mouse-face 'highlight))))))))))) + ;; The slot's *index*, which is the fourth element the + ;; `locals\=' reply now puts on each line, and not its name. + ;; A name does not identify a slot: two slots of one frame + ;; can share one, and a refused slot is absent from this + ;; list, so the position in it is not an identifier + ;; either. Sending the name is precisely the old bug — + ;; the name was evaluated as an expression wherever the + ;; evaluator stood, which is the right frame only when + ;; this is the innermost one. + (add-text-properties + start (point) + (list 'flan-cnr-inspect (list :slot i (nth 3 l) (nth 0 l)) + 'mouse-face 'highlight))))))))))) (insert "\n")) (defun flan-cnr--insert-globals (state) @@ -307,7 +318,7 @@ puts the likely culprit on top." ;; global exactly as it reaches a local: a global *is* an ;; expression in the source, which is what the inspector needs. (add-text-properties start (point) - (list 'flan-cnr-inspect (nth 0 g) + (list 'flan-cnr-inspect (list :expr (nth 0 g)) 'mouse-face 'highlight))))) (dolist (r refused) (insert (format " %s%s\n" @@ -430,10 +441,19 @@ puts the likely culprit on top." (forward-line (1- line))))) (defun flan-cnr-inspect () - "Open the inspector on the thing at point." + "Open the inspector on the thing at point. + +A local and a global reach it by different roots, and that is the fix rather +than an inconsistency. A global is reached by *name*: the loaded thunk binds +to the program's own storage through the dynamic linker, so its name is an +expression that means the same thing wherever it is evaluated. A local is +not — it is storage in one frame, and its name evaluated anywhere else may +find a global, another binding of the same name, or nothing. So a local goes +in by frame and slot index, which is what the listing above it is already +drawn from." (interactive) - (let ((expr (get-text-property (point) 'flan-cnr-inspect))) - (unless expr + (let ((root (get-text-property (point) 'flan-cnr-inspect))) + (unless root ;; Two different misses, and saying the wrong one sends someone looking ;; for a missing feature when they are one keystroke away. Being *on* a ;; frame is the common case — the frame line is what the eye lands on — @@ -443,7 +463,10 @@ puts the likely culprit on top." "flan: this is the frame's own line; TAB opens it, then i on a local" "flan: point is not on a local or a global — TAB opens a frame, i inspects a local in it or a global below"))) (require 'flan-inspect) - (flan-inspect expr))) + (pcase root + (`(:slot ,frame ,slot ,name) (flan-inspect-slot frame slot name)) + (`(:expr ,expr) (flan-inspect expr)) + (_ (user-error "flan: this line carries no root the inspector knows"))))) (defun flan-cnr-refresh () "Ask the program again what it is offering." diff --git a/emacs/flan-inspect.el b/emacs/flan-inspect.el index 9d2a666..2a68846 100644 --- a/emacs/flan-inspect.el +++ b/emacs/flan-inspect.el @@ -360,10 +360,25 @@ root, which is the older and the more limited of the two." ;;; Drawing it +(defvar-local flan-inspect--root nil + "What this buffer's walk starts from. +Either `(:expr EXPR)\=' or `(:slot FRAME SLOT NAME)\='.") +(defvar-local flan-inspect--path nil + "The steps walked from `flan-inspect--root\=', outermost first. +Together with the root this is the whole of where the buffer is. It is a +path rather than a remembered value because nothing here can retain a Flan +value: every step is a fresh request, which is what keeps the view current.") (defvar-local flan-inspect--stack nil - "Where we have been: a list of (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.") + "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. @@ -436,18 +451,27 @@ stated honestly — every Flan integer is rendered through i64." ('option (format "(some …)")) (_ (plist-get node :text)))) -(defun flan-inspect--render (expr node stack) - "Draw NODE, reached by EXPR, with STACK behind it." +(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 expr 'face 'font-lock-function-name-face) "\n") + (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 - (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)))) + (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. @@ -459,7 +483,12 @@ stated honestly — every Flan integer is rendered through i64." (when stack (insert (propertize (concat " via " - (string-join (reverse (mapcar #'car stack)) " > ") + (string-join + (reverse (mapcar (lambda (e) + (flan-inspect--root-label + (car e) (cadr e))) + stack)) + " > ") " > here\n") 'face 'shadow))) (insert "\n") @@ -497,7 +526,8 @@ stated honestly — every Flan integer is rendered through i64." 'face 'font-lock-warning-face)))) (t (insert (propertize - (format "Nothing to go into: %s\n" (flan-inspect-refusal node)) + (format "Nothing to go into: %s\n" + (flan-inspect-refusal node root)) 'face 'font-lock-comment-face))))) (insert "\n") (insert (propertize @@ -507,70 +537,135 @@ stated honestly — every Flan integer is rendered through i64." ;;; 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 "")))) +(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 ""))) + (`(:slot ,frame ,slot ,_name) + (funcall flan-inspect-request-function + ;; `:path\=' is omitted rather than sent empty, because + ;; Emacs cannot print an empty list as anything but + ;; `nil\=', which is a symbol on the wire and not a list. + ;; A missing `:path\=' is the slot itself, which is what + ;; an empty path means. + (append (list :op "inspect" :frame frame :slot slot) + (when path + (list :path + (mapcar #'flan-inspect-wire-step path)))))) + (_ (user-error "flan: %S is not a root this inspector knows" root))))) (unless (equal (plist-get r :status) "ok") (user-error "flan: %s" (or (plist-get r :message) "refused"))) - (or (plist-get r :value) - (user-error "flan: the program answered without a value for %s" expr)))) + (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 (expr &optional stack) - "Render EXPR in the inspector buffer, with STACK behind it." - (let ((value (flan-inspect--value expr)) +(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--expr expr) - (setq flan-inspect--node (flan-inspect-parse value)) + (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 expr flan-inspect--node 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." +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)))))) - (flan-inspect--show expr nil)) + ;; A new root, and therefore an empty stack. That is the whole of why `l\=' + ;; cannot walk out of one root into another: there is never an entry from a + ;; different root left underneath it. + (flan-inspect--show (list :expr expr) nil nil)) + +;;;###autoload +(defun flan-inspect-slot (frame slot name) + "Inspect slot SLOT of stopped FRAME, which is called NAME. +The slot root. SLOT is an index and not a name, because a name is not an +identifier: two slots of one frame can share one, and a slot the daemon +refused is not in the listing at all, so neither the name nor the position in +the listing picks one out. The index is what `locals\=' puts on every line for +this." + (flan-inspect--show (list :slot frame slot name) nil nil)) (defun flan-inspect-into () - "Go into the field or element at point." + "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))) + (let ((why (flan-inspect-refusal node flan-inspect--root))) (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)))) + ;; 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." + "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) rest) + (flan-inspect--show (car top) (cadr top) rest) (with-current-buffer flan-inspect-buffer - (goto-char (min (cdr top) (point-max)))))) + (goto-char (min (cddr 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." + "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--expr (user-error "flan: nothing is being inspected")) + (unless flan-inspect--root (user-error "flan: nothing is being inspected")) (let ((p (point))) - (flan-inspect--show flan-inspect--expr flan-inspect--stack) + (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 () diff --git a/emacs/flan-inspect.elc b/emacs/flan-inspect.elc deleted file mode 100644 index 1dde00429d655daa618917dcfc58603d6a2600af..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 19147 zcmc&+i*g&+c?LiVmf&&P#M2~ho#Y6#Oi~fpy#XL8Ur0&RW#UMR#Mo{GrCb6F5*2`j zcbB4=G&6aKK0_a@Ptx!E&pC@-f?}k$Go2AdVE62~{MYZlEN}09bN82(N~Ll8_HA`H zp3Fw$XdqukQ?)k<`>A>zCFv-hD&N`gHrkHdJRN1nDjbhhJj+It(VxN$BhrmVqp`B% zZL05%qa;$5CEE!KDH5-r8O#Rni|3if;iGDbV?6>Iv-?NisI+`BI6iGB2pXu=%N#gzjh^Rpo9YEA3yP>T`az{9he_*=>Yt=pJi&JR<1mR@M@f7# zQ*r{sWi=g*Rr7K9dUOPV025w^W3Yz@1FKG^!kGIwva-x=s_j`44M%TOvp7);*XPrp zUpQxA>5;>e;Sk&$o=k;>{7s=$D=!>FH+`_?&EjJ>n=h5C)>b}K8_IRN>o3jc&Ca^o z&dz2aK$hSrFV*IHV{H%(v3TjsEhB=he8E+jA53l8dv<;=SYKb+aXr;&tPQ8?xq7q? z_F~d-JPK2#A2hUVwbECkSu34E2ylkB8{ib4>((B82M+lkSE|*A;IZ?S{vVabok|S{ z>v&7GdR-5DRJpSBaQO}|E}MHI*BE@ILVB2c7|_9e-|;yQZehVo9?R9{O3(ALbjPXQ zuVEEY1wRnMUP;%E!}Pe7iSZD_0Nt3Kz-+{`GnGO6vrw&VdCF@mJk$2p*Ku|G6>UKX z&4EBgZ?cza%gTe}dYUI&mM4c$ES1HtB4`Zwunjg%PbP;^0z0B!MQ5jRGPtD_@ zvn=^)Rl$=SeDN686Q4<<_c`|T2$t8L8^`2vmX=mVxOCT5X?a^ms;`N}utc z^vOVkPx(o#>(c$&zCENC^428GpfSy_V7l}PWy4K{Z9{=V_$kZ({ES`45&m}!{|{cM zZ`HRi^}%kbTn7(ctZIJ;sYsF#?jeCVq~j6%!+R(rq}3iCOs8@P1?0Erqt?k@kH_@t zAJpr;CI#Tia{Yq`|3Y^Eih9I{gyr>0y?%xA5`4*~I1u9e=gZphem+S6w!aA;X zsyq0xu!OTXV`*zi6E^%68GI z(D1{=3Q%bsMb-vrX{SRKL!gFn0-;gO8v_-Mqe(Q)ZlpKTCj3#esharE)aYRn8!(kb z8hQY$4AeBv)M+xxA_$z!9MYO^_m4;80S3aYwXH5~d7E0!+D4bws6gt^|Ml1Z{L8vl zskJo5m2dHlN>!A-wfC_s(1jC#sFIk`z$|M6^GRi?U|>Ee8ki-p8U{v~NB^L8?+@S) z%r^zY$PgirU$578DLEy$1Fjb#kK@*_?cBNB^T5e!{i@!;ca{1F+=1(f$bBa}aJ=s; zRpB+~zOt;PeyL_WQ(9SG;v>F1l3JI9D}ijcpgNz6;izAQ6pH55uV7)(9E|K5UGZBk$HPw;8m`Oh}SU~N_Ku+SC8|%U5v8_>hUXQ+UHa<1V)%c>h=0HedwO= z2NiA#Lp%Wt7{W_+Sq>TlgAP-OF;z?~7La;CLidLC4{;Wp#^~;~Dm1cQ2f3)n@Ul== zo(7{mdvG)K1FDs%d4LI^TylVa1dVvKf|~Pb&&RyE^Tzq@tiGKU>yexSf9_Q+_4K6o zs+M#j6CNE=hZ^lr<$bTs|6Lbn5%=Ei_NHwV)3&2d9dImv2 znp&$hYHU7{YtT)rko1AB=L?j`=n7TPQQ{!!73a1>TZ!h^O(HWY(_Fiu)7E!*?H~}H z-gLB1Gh#6IVW4rhVoVYb0W-x^r9e!unT@x8t8-viU-x()A9 zt7*Yl(lY)rg@9T}X_8>%zE-OmpsH4E@?DUf!?B&^B~C!Cb-MGO?k z7`;I-m`bt%&p>eyLO$Q$d&(@r2;uME_fMZ~GcyPe5d5 z2l{>N3lrczeQpMP&c#x?(bMp(LE1-1l*m<0=05KYlNcEciI=!}In5;$=6PDALat>{ zn{5!)-;oH0PQqvs3?wy48_KULU_}7zWJdpTKH6wxt^NUVE<>A6jeP5tpV-cy$gg8i zuxXhK_q!|;0NtINMWzzAzoVLI?kPmH+X#)KH_$bzm_b8p8#hvQBV7mlS%X0H%V3>R zx?|KJ@C=*@Hnnts(`3ehiJSpwW(rxS@fgg^EI@`BT|)R%q&g6-LYl02TT2A`2#ysd{2U9_+K4qpm< z#5GCwz{6=q~<2*^?*xQ1S6Afa}9E^>latA*}%OcZ}*q@-he<94&>=WTBY!gY6ZAl!T+P zHL{$HQ>-He3V}Ak+a-e8qNQq$!^3E7Z9-M#>`>(HLThkPsgI7V5T3l0znveOZa z)5|7Y(5xRL@5snUdq*5xXt0~pplmy|-TwNV@j$AAqp2p?!EaZe39Y!PMcxjmZ{vLD{ms~LF-j>nFHUSj1ZpHl)D8Q2Ng;1`!A)tGn z6l=E~B*idx1xjg=PdjkhqLkjIi{iqW5(JC1JcHoFyvjhY4JS=TjfSxOOx$lYM1xHx zliDO&NsXo+$J4o^&rV~b#`OA#xsjPZNkh01t=x^9bAWPFAVjHzU@U-mf0P@ZOo$T( zY7&LO+_VJqryJZyA;{+4c#N`wR15e`V*W8oE1bg2jQtrqBFFz+haKTq@r0My5OWN% zAHGIzbTqC8@0!&bm489;ap-#dUh``RMq5M#ajuBS;vEqlN+2PB=gavc1o@)V<~Lmu zzhfK|HI9Rr9`Un8miY}DgoPXQf5epY2uTNB@2Kx4h=Q?Y;>B~MVkOlq$;<)r>wpV5 z)MV*`0CpYOTFKwe!?z|fZaN^7O4Kw)AqOB-vo_Dn^y8B;%TPeC05HU~lUa7gwNIjH zKiZ}sK(gpTVw?3r!dD%|@E2K(cu~v}pVaIHZl8r`<2W2_Ymkf_G@s2ODfJ1n!uH6j zEVn?kq~cUqX^yP1Sc*K-2JjM)5-T&~7!?!it`0HFE9=H6rl@mimEp#)n{a^iQp%zZ z%wq_R(}gjvPvv5*On{Vx7^93-P_r1{qC`%QZJI3BR1otp9*^TwYGS14Vs#Cb9FU9n zKYy5eJ&R8gR@cHY)SG0;0KtdR25WnR7)Q^OVxn+%s}Txx&@Gk>4`!(5WUC6mUUN<$ zyxo%C00F-}q*+Ag{KI|{cbgBDCwB4}MPH?19NR|PSk zIV*@P9yyLrnK?v70vSlG4bI}+5d7P;oJPvDh~uzAY9J-d4W`Hn25w`)S5q<&6H=0q z#*7l+b(^W^Ahjd58dQ-Yt2s5V~}<@O45vFQPj;AigCd3VgHqQ01fB5-7R?dl^y8$e#r#uGZ?sr!;>C3 z8YiBFucDSMGPd-PmR6GUB|5J5mb##hfFMtyF3R@Fr99ev8tLylqVe z^o7%JI&{9MwtHOxvv(gp`sSW!j=)!gP)Yx7b>M8QiugbbOgfsCr8nlHwswrZwb+7W zHWC(lNI@MyA9WC2x@DG0p}c*_WM0;QXN@ItRtFcuu2odmKq~Y6+h!@sgE#S_<+>QojZRREY-cbA`yp?O>7CJ8cpjIX^7*im5av#X2iI^5D zVH5J3ZdVt6JOnND}^3zxzvF29-GoZLNZ_GbnC`{%?BU2Xk~!GN+L1ZNXbZD z7!01MQ*m!VTCGMIt-=K8n1E+mn-fply4 zn%8RxK3Mw&fk-J9>hK*<4^K-i&8a;Ago8c=oj=$Q_|5t-P+oIMo=0&2Lp0vb3wOn*Uhuq+$g~SkPfDo`L z)nN#;j5JaZdgzi#H(1@J!JI~Hhk?V>TcrJ^w-FVlesqEs^pH%49q6M6OBVx;DFyo{ z=qgIiM5!8Sc!tO05|pwDe`?f7P!PJMpi<)hI{_EuIx#H;loDTH3JBB=qXrx%LyTiw zPuY1ykVIT|rqQNVGE6a7<70IG9HBd;6TG9U4x$W6kdjzJwIojkS<|5`L{ute|DYul zdQ0I8mapr)C8Uya*b(h!w9%d4)^fR+c($8I?bcXh=gp1pm2wW5_$m1ua6mN23e9E^ zbh<&{bp5Wg)o!~TR8yPtr%hH(ddi3fbSs? zBftQdAxUmpWN|<5NZa&eGFi}hZ3eZ5Be2)e-8?w}@;S@+55(t3)>lDT=(FSwKv{Xx zb+pX@gIHyU=F?2L9vA|OTei^BBBT?)rzda&Fqc7{SYdnb|0;w7k~8(T0C+0r>>4mE z>e-Sw)+M+?=!PtfhApM?x&gns^o?gF%WU-?Y7gWn9aFx#hu%fQGaY0}E|72)aE7gr z&-Zul{)UkWdwuexv*1~Y)#ZLE>38=sGphh?8!{N5!W9`aqf9ZNo*rhpP{lKbxJAgl5 zB<-9W?RFIlwL4ryO6DDqv;)z>H)wjNQ{UAa3wQ|BkVq%USqIzT2|h8z>yUsTODEvw zI1VIZ$)A*^@O8jC%vQgS=gI`s0-W;);~}=CJx7P@n2vUSG(8@{XG)($%{FW6V0IJe>$!?XdNYp)vkyFwKJRTh#kMUFN z-5@E^^QZ)g87P$iESB;`==KFDv+1JE+h#B_AS`DWqQ9~XoQBf#ZiM+U5UM0;@~q;v zk-O5SZC1GXY;PavRoe8G8UxuPfufEeC`07=j+NTqz4OmgfLO$CY6iuMUXO58rG7x* zH_EV+mrSdg7HT9M^1hVa^pzaIG<#DGq=avy-CH@N1X-S=?#@)ZPTb4pA{+A1k6z|3 zb?j_J35`DUCKQ4kSR()(8Zvl_c{C%ji*%UHLB>w2y!}lxNYp zM1$A4X`jJ(URXe%3w`0+s1i0K>{T*DumaN34_QT1YV!-j0kn@63=zRONZpK)|ATZT zttd%AMCp|$Q!xo%BS^y|%%Dj&z$Hx%Gl;<7GC+sdK>PDI7W7zhMluu@xS~;MQ==b5 zJVlE!yt64^qiixmN&0yuc}dP48{1O5|U;93{1 z&IvvSC!DTeqop5%Urz1%Pii0IgS*_DURi<5-~+D5Xr6FlkyR!OSW*w2zAIl6JuhF< z`Nr}!O;hxJ+T39upfN*wEJ_ds4q6lBo?7KMC*)e$%;;{L^2`Po4o2w=i5fHgJlt@- zO<#9Sv(fBPA=Rw6gdD3tQo}_1MuriOjm9IUZt(&Nb~#44Nk$ivZif-X1j58zzJ#|7 zC6O(XRI>?IF4xqOwFlFr0=3AF7NcWE=ktCc7f=sfau>Y{gLynxWB@RV2*U|P77o@A zdQGz1Lqw@%2C944@Sj1ubqGyEscqQkHPNtjQvhk<%@>ornZ`wjKqCpOizz@Ly;WVH zM0D~%mvV%BI#&wqG8t9YQiOmefqhZ(5#)_QDgD-pcYp)Y8sU`u2xC;G(EmM!o-nK|J2-sD$q7j=tTwGtFTp95AIyMLw(TQdl!(OJTJ?lNvl(&i>~pkJnAiu zanW$Wky#IA3<=T_pcj%1jF8WT=DDMyE@-P)(h4qnk+xEb=FM|1kSBUPDOE^_w>#<% z{TwJwDc9;jS z;Ye~#3|Vz|@W&j~mQH0zUb<%N)FMH3J;szGQH2xW09^$^Ev@s|^c;0X+2*Nf7b%Y* zCzIPX9pfaDRLTnWAUq03D6ij(#v{C-0s|*`XuPCSs*2+ky3xdz{t8dCh-STsF+jH( z%-7*fG1d_!tOgp2kYz@jB}^7lB|80#3J{Z7K=sJB;pH1VM9TzRdx=(AICG9g60Qh~ zs9o)=*R;YUy{UFI@HlVf&|CH7-I!)M1123J)qZ51Y6Kr%n!&KhzRBeVh$M3sAu5%$ zBpgv9?Y=sBXY@*5RiXs5nuc-$T+l}24%80~2CwCn1120NpnJ*^bY?PpB2UHFBUysv z7QrcoRcN@x`;bR?gApxJd^3_|JZIcIKD=SU$9G|p1Ru$G$pnWAU` zu#`lQ9H4B-6C;~^>xa=1$aaYgwd9CtZk(M6hSeQ>N1OX=D!h3)ig?gprPpyIrqE!t zOLsA__8h|{cGeJ7k2X1QwB@6eWU}5GuP|5r4(9izvVClB(B0IHZ0@F~ehY3}V<$-d zynFzGf5$}DW4e7ryC5UPN8D~ z(eNrRcK(i>5UuC18hO_S@r^UZZ>E$uP*s+84kd*l?100)06AKTxX2_^vT?f*8!_C3@Hk6Z@cXw?k%9bHu6*GteQ3H(cs}rT+ZXP z_uw=nB$k9jZtj^A0k+rd>rf838RlyW8@b4CnPjM9%un+D`*7y7ZdQj(oe)*4DLxC zFqt<(qKV&D0jQXYq@!+tDRl6liVPGGPO~m#S!9ob&$f)=5dI%Tm%_RaA`Y=10>j{%F_Hve=^!5~@2MlH2UxX+r_lXv;$p}<#_5IST^BAam+)K6&-LQM zjw~z<>>S9n5`RhyQ`xw%jP;*#Ia&Byev%t~%#6@XZ-MB>C(leNlH)aQ7urE_PnsjI}x;hAqwSpBVXg-&3O80HP zeLKc8l#bur6=M9&XNSgel+t=BQY7#_RK=nap3D8o0NVSv0vu6Kn*_4rB$CoaDHvGK zu+;rAzIi|4CH(l*AfJD*Kzt{KgMy%MSt)3LC{j$&>vlfGf5@GRG}4pyhPWy4*>6h# zLm5+21-(sq^Z1Gel8fdEkt;9w2-kF8Ja|_5=trM&JU-!SM{fP-)4OJMuglfBBh+kV zE$5@3ehPu@{`434A1C$mKW@|g=_l*>4)5eMiz1>sh?w{knbo#$68>A9==7;vWmRv{ zOp7sJl8VNiHuCo${6b zNkU1|y{B>ngx!hOk^HF)Xj(FnMfs-~UNE*eqE7kSTCa05kjWwW!*L)qc)Qr2{_;1^T B2Iv3) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 50390e3..da9db11 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -213,12 +213,15 @@ (message "\nthe inspector buffer") (defun test-flan--inspect (expr rendered) - "Draw EXPR's RENDERED value in a temp buffer and return it, live." + "Draw EXPR's RENDERED value in a temp buffer and return it, live. +The expression root, which is what most of the block below is about: the +rooting the buffer has always had, and the one that still works on a running +program." (let ((flan-inspect-request-function (lambda (_) (list :status "ok" :value rendered))) (flan-inspect-buffer " *test-inspect*")) (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) - (save-window-excursion (flan-inspect--show expr nil)))) + (save-window-excursion (flan-inspect--show (list :expr expr) nil)))) (let* ((buf (test-flan--inspect "b" "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})")) @@ -284,7 +287,7 @@ (flan-inspect-buffer " *test-inspect*")) (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) (save-window-excursion - (flan-inspect--show "b" nil) + (flan-inspect--show '(:expr "b") nil) (with-current-buffer " *test-inspect*" (goto-char (point-min)) (flan-inspect-next) (flan-inspect-next) ; :pos @@ -329,6 +332,180 @@ (string-match-p "span bound of 8" text))) +;;; The slot root + +(message "\nthe slot root: a frame and a slot index") + +;; The other rooting mode, and the reason it exists: an expression is +;; evaluated where the evaluator stands, so a local's *name* names the right +;; storage only on the innermost frame. This root names the frame. + +(defvar test-flan--asked nil + "Every request the last slot-root fixture sent, newest first.") + +(defun test-flan--slot (frame slot name replies body) + "Open the slot root on FRAME/SLOT/NAME and run BODY in its buffer. +REPLIES answers each request. BODY runs *inside* the binding of +`flan-inspect-request-function', which is not optional here: RET and `l' are +further requests, so a helper that returned the buffer and let the binding +unwind would send the next one to a daemon that is not there." + (setq test-flan--asked nil) + (let ((flan-inspect-request-function + (lambda (form) (push form test-flan--asked) (funcall replies form))) + (flan-inspect-buffer " *test-inspect*")) + (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*")) + (save-window-excursion + (with-current-buffer (flan-inspect-slot frame slot name) + (funcall body))))) + +;; The header names the frame, which is the whole of what the expression root +;; could not say, and the type comes from the reply rather than being read +;; back out of the rendering — a rendering of `7' does not carry `i64'. +(test-flan--slot + 1 3 "b" + (lambda (_) (list :status "ok" :type "Blob" + :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})")) + (lambda () + (let ((text (buffer-string))) + (test-flan--check "the slot root names the frame in the header" + (string-match-p "\\`b \\[frame 1\\]\n" text)) + (test-flan--check "and the daemon's type is what is shown" + (string-match-p "\nBlob\n" text))) + (test-flan--check "it asks the inspect op, not eval-expr" + (equal (plist-get (car test-flan--asked) :op) "inspect")) + (test-flan--check "with the frame and the slot index it was given" + (and (= 1 (plist-get (car test-flan--asked) :frame)) + (= 3 (plist-get (car test-flan--asked) :slot)))) + ;; An empty path is sent by *omission*: Emacs prints an empty list as + ;; `nil', which is a symbol on the wire and would be refused as a step. + (test-flan--check "and no :path at all for the slot itself" + (null (plist-get (car test-flan--asked) :path))))) + +;; Going in extends the path. The root does not change, and that is what +;; makes `l' unable to cross: every entry on the stack was pushed with the +;; root it belongs to, so `l' can only ever restore a pair it built. +(test-flan--slot + 1 3 "b" + (lambda (form) + (if (equal (plist-get form :path) '("pos")) + (list :status "ok" :type "V" :value "(V {.x 1.5 .y 0})") + (list :status "ok" :type "Blob" + :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) (flan-inspect-next) ; .pos + (flan-inspect-into) + (test-flan--check "RET sends a path step, not an expression" + (equal (plist-get (car test-flan--asked) :path) '("pos"))) + (test-flan--check "the header walks with it" + (string-match-p "\\`b \\[frame 1\\]\\.pos\n" (buffer-string))) + (test-flan--check "with the frame's own root behind it in the trail" + (string-match-p "via b \\[frame 1\\] > here" (buffer-string))) + (flan-inspect-pop) + (test-flan--check "l shortens the path back to the root" + (null (plist-get (car test-flan--asked) :path))) + (test-flan--check "and the root never changed under it" + (seq-every-p (lambda (f) (equal (plist-get f :op) "inspect")) + test-flan--asked)) + (test-flan--check "so nothing was ever evaluated as an expression" + (not (seq-some (lambda (f) (plist-get f :code)) + test-flan--asked))) + (test-flan--check "and popping at the root refuses, as for an expression" + (string-match-p + "nothing behind it" + (or (test-flan--caught #'flan-inspect-pop) ""))))) + +;; An option's payload: the one thing the slot root reaches and the expression +;; root cannot, because Flan has no accessor form that names it. So the +;; refusal is the *root's* and not the value's, and it has to be asked with +;; the root in hand. +(test-flan--check "an expression root refuses an option's payload" + (string-match-p + "no accessor form" + (or (flan-inspect-refusal (flan-inspect-parse "(some 3)") + '(:expr "o")) + ""))) +(test-flan--check "a slot root does not" + (null (flan-inspect-refusal (flan-inspect-parse "(some 3)") + '(:slot 0 1 "o")))) + +(test-flan--slot + 0 2 "o" + (lambda (form) + (if (plist-get form :path) + (list :status "ok" :type "V" :value "(V {.x 1 .y 2})") + (list :status "ok" :type "(Option V)" :value "(some (V {.x 1 .y 2}))"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (flan-inspect-into) + ;; The payload has no name, so the step is the symbol `some' and not a + ;; field called "some". + (test-flan--check "RET into an option sends the symbol some" + (equal (plist-get (car test-flan--asked) :path) '(some))) + (test-flan--check "and the trail says so" + (string-match-p "\\`o \\[frame 0\\]\\.some\n" (buffer-string))))) + +;; A union case's field. The payload sits at an offset that depends on which +;; case the value is in, and only the renderer knows which it currently holds +;; — it wrote the head `Shape.circle'. So the case travels with the name. +(test-flan--check "a union field carries its case on the wire" + (equal (flan-inspect-wire-step '(:field "r" "Shape.circle")) + "Shape.circle.r")) +(test-flan--check "a struct field does not" + (equal (flan-inspect-wire-step '(:field "x" "V")) "x")) +(test-flan--check "an element is its number" + (equal (flan-inspect-wire-step '(:index 2)) 2)) + +(test-flan--slot + 0 1 "s" + (lambda (form) + (if (plist-get form :path) + (list :status "ok" :type "V" :value "(V {.x 1 .y 2})") + (list :status "ok" :type "Shape" + :value "(Shape.circle {.at (V {.x 1 .y 2})})"))) + (lambda () + (goto-char (point-min)) + (flan-inspect-next) + (flan-inspect-into) + (test-flan--check "RET into a union field names the case it is in" + (equal (plist-get (car test-flan--asked) :path) + '("Shape.circle.at"))))) + +;; The daemon is allowed to refuse — a program that resumed, or a frame whose +;; body was redefined since it was entered — and the refusal has to reach the +;; person rather than being answered from somewhere else. Being answered from +;; somewhere else is the bug this root exists to fix, so it is asserted. +(let ((flan-inspect-request-function + (lambda (_) + (list :status "error" + :message "look's body was redefined since that frame was entered"))) + (flan-inspect-buffer " *test-inspect*")) + (test-flan--check "a refused slot root says why, and shows nothing" + (string-match-p + "redefined" + (or (test-flan--caught + (lambda () (flan-inspect-slot 0 1 "p"))) + "")))) + +;; And the structural claim about `l' from the other side: a new root always +;; starts a fresh stack, so there is never an entry of another kind left +;; underneath for `l' to land on. +(let ((flan-inspect-request-function + (lambda (form) (if (equal (plist-get form :op) "inspect") + (list :status "ok" :type "i32" :value "7") + (list :status "ok" :value "9")))) + (flan-inspect-buffer " *test-inspect*")) + (save-window-excursion + (flan-inspect-slot 1 3 "b") + (flan-inspect "g") + (with-current-buffer " *test-inspect*" + (test-flan--check "a new root drops the stack it did not build" + (null flan-inspect--stack)) + (test-flan--check "and l has nothing to cross back into" + (string-match-p + "nothing behind it" + (or (test-flan--caught #'flan-inspect-pop) "")))))) ;;; Restarts: which of them can be taken @@ -458,8 +635,11 @@ :restarts '("retry") :stack (list (list :fn "sim/settle" :loc "sand.flan:42:3" :fetched t - :locals '(("i" "i32" "7") - ("b" "Blob" "(Blob {.id 7})"))) + ;; Four elements now: the fourth is + ;; the slot's index, which is what `i' + ;; hands to the inspector. + :locals '(("i" "i32" "7" 0) + ("b" "Blob" "(Blob {.id 7})" 1))) (list :fn "sim/step" :loc "sand.flan:60:1" :fetched t :locals nil)))) (buf (test-flan--cnr state)) @@ -494,25 +674,41 @@ (test-flan--check "and TAB again closes it" (not (string-match-p "i32 i = 7" (buffer-string)))))) -;; The two buffers meet: `i' on a local opens the inspector on its name, which -;; is an expression the program can be handed. +;; The two buffers meet, and this is the fixture the bug lived in. `i' used +;; to send the local's *name* to be evaluated, which resolves wherever the +;; evaluator stands: right on the innermost frame by luck, and on any other +;; frame a global, another binding of the same name, or nothing — with the +;; listing right above it showing the frame's own storage and nothing saying +;; the two disagree. It sends the frame and the slot index now. (let ((asked nil)) (let ((flan-inspect-request-function - (lambda (form) (push (plist-get form :code) asked) - (list :status "ok" :value "(Blob {.id 7})"))) + (lambda (form) (push form asked) + (list :status "ok" :type "Blob" :value "(Blob {.id 7})"))) (flan-inspect-buffer " *test-inspect*")) (with-current-buffer (test-flan--cnr (list :condition "Missing" :restarts '("retry") - :stack (list (list :fn "f" :fetched t - :locals '(("b" "Blob" "…")))))) + :stack (list (list :fn "g" :fetched t + :locals '(("b" "Blob" "…" 4))) + (list :fn "f" :fetched t + :locals '(("b" "Blob" "…" 2)))))) (goto-char (point-min)) - (search-forward " 0: > f") + (search-forward " 1: > f") (flan-cnr-toggle-frame) (goto-char (point-min)) + (search-forward " 1: v f") (search-forward "Blob b") (save-window-excursion (flan-cnr-inspect)) - (test-flan--check "`i' on a local inspects it by name" - (equal (car asked) "b"))))) + (test-flan--check "`i' on a local inspects it by frame and slot" + (equal (plist-get (car asked) :op) "inspect")) + ;; The outer frame, and its own slot index — the two facts a name cannot + ;; carry. Frame 1 has a `b' and so does frame 0; sending "b" would have + ;; reached whichever one the evaluator stands in. + (test-flan--check "naming the frame the listing was drawn from" + (= 1 (plist-get (car asked) :frame))) + (test-flan--check "and the slot index that frame's listing gave" + (= 2 (plist-get (car asked) :slot))) + (test-flan--check "nothing is evaluated as an expression" + (null (plist-get (car asked) :code)))))) ;; `flan-cnr-show' refuses a running program by name rather than opening an ;; empty buffer. @@ -635,10 +831,10 @@ ;; inspector is built on. (with-current-buffer buf (goto-char (point-min)) - (test-flan--check "and a global line is inspectable" + (test-flan--check "and a global line is inspectable, by expression" (progn (search-forward "pressure") (equal (get-text-property (point) 'flan-cnr-inspect) - "pressure"))))) + '(:expr "pressure")))))) ;; Empty is a claim, not a gap: the section is the union of what the stack ;; reaches, so nothing in it means the state is all in the locals. diff --git a/lib/dev.ml b/lib/dev.ml index aac36ce..b4a7ee9 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -1625,6 +1625,11 @@ let handle t req = "a :path step is a string for a field, an integer for an element, or `some' for an option's payload")) (Ok []) l |> Result.map List.rev + (* Emacs prints an empty list as [nil], because it has no other + spelling for one. Taking it is cheaper than making every client + in that language special-case the empty path, and [nil] is not a + step under any other reading. *) + | Some { Form.v = Form.Sym "nil"; _ } -> Ok [] | Some _ -> Error "inspect's :path is a list" | None -> Ok [] in