diff --git a/TODO.org b/TODO.org index 1937ad1c..422648a4 100644 --- a/TODO.org +++ b/TODO.org @@ -1797,9 +1797,12 @@ its slots in scope. The slots are already on the frame and already readable (=flan_dev_frame_slot=); what is missing is checking an expression against that frame's names and types. -** TODO The stack lists prelude frames -=0: pause :151:7= is the breakpoint the author wrote, not a step in -their program. Prelude frames want hiding by default, with a key to show them. +** DONE The stack lists prelude frames +CLOSED: [2026-09-25] +A frame whose location is == is hidden by default, and a line in its +place counts the hidden run; =P= shows them. A hidden frame keeps its index, +because =locals= and the inspector are asked by it. Rules out renumbering the +visible frames. ** TODO There is no stepper =(pause)= stops and offers restarts, frames, locals and the inspector, but @@ -1832,10 +1835,13 @@ calls to the same function from one caller are indistinguishable in the stack. Wants the caller storing its call site into the frame before the call, which is a field and a store on every dev-build call. -** TODO The condition buffer cannot jump to the source -It prints the source line and carets for the stop (=flan-cnr.el:197=) and lists -frames, but no key opens the file at that line. Wants RET-on-a-frame, or =M-.=, -and =next-error= over the frame list. +** DONE The condition buffer cannot jump to the source +CLOSED: [2026-09-25] +RET (and =v=) on a frame or on the stop's =at= line opens the file there; TAB +alone folds a frame's locals. The buffer is a =next-error= buffer, made current +when it opens, so =M-g M-n= walks the stop and then each frame with a file. +Refusals — the prelude, a relative path, a missing file — are one function +shared with =M-.=. ** TODO loop's bindings should be sequential, like let's =check_loop= (=lib/check.ml:4741=) checks every initialiser before binding any, diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 0ab2ecb5..703315ec 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -343,11 +343,13 @@ Keys in that buffer: | Key | Does | |---|---| -| `RET` | take the restart at point | +| `RET` | take the restart at point; on a frame or on the `at` line, visit the source | | `0`–`9` | take that restart by number | | `TAB` / `n` | next restart | | `S-TAB` / `p` | previous | | `f` | fold a stack frame open or closed | +| `v` | visit the source of the frame at point | +| `P` | show or hide the prelude's frames | | `i` | inspect the local or global at point | | `a` | abort | | `g` | read the program again | @@ -377,6 +379,17 @@ takeable only when the program itself was already stopped — abandon the evaluation and the program's own break comes back with them on offer. If the program was running, abandon and call the code again. +**The stack.** Frames are numbered innermost first. A frame of a prelude +function — `pause` is one, so every breakpoint has one — is hidden, and a line +in its place says how many were hidden; `P` shows them. A hidden frame keeps +its number, so the numbers either side of it have a gap. + +A frame's location is where its function is written, and the `at` line under +the condition is the expression that stopped. `RET` on either opens that file +at that line. `next-error` (`M-g M-n`) walks the same list from any buffer +while the program is stopped: the stop first, then each frame outward, skipping +frames that have no file. + **`C-c C-M-b`** is the same choice as a quick one-key prompt, when you already know which restart you want and do not need the buffer. diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 72b3dbcd..c132f264 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -51,8 +51,9 @@ ;; expand in place, TAB to fold, everything reachable from the keyboard, ;; `q' to go. What was not taken from it is the cause chain — CIDER walks ;; `ex-cause' because a JVM exception wraps another one, and a Flan condition -;; wraps nothing — and its filters, which exist because a JVM backtrace is -;; mostly frames nobody wrote. +;; wraps nothing. Of its filters one was taken: the prelude's frames are +;; hidden until `P' shows them, because `(pause)' is itself a prelude function +;; and its frame is the breakpoint, not a step of the program. ;; ;; Everything this buffer cannot fill in is drawn as a section that says so, by ;; name, with what it would take. A missing section is indistinguishable from @@ -65,6 +66,7 @@ (require 'subr-x) (declare-function flan--request "flan" (form)) +(declare-function flan-visit-loc "flan" (loc subject)) (declare-function flan-inspect "flan-inspect" (expr)) (declare-function flan-inspect-slot "flan-inspect" (frame slot name)) @@ -147,6 +149,10 @@ so does a list long enough to have been truncated." "The plist this buffer was last drawn from.") (defvar-local flan-cnr--open nil "Indices of the frames whose locals are showing.") +(defvar-local flan-cnr--show-prelude nil + "Whether the stack section draws the prelude's own frames. +Nil by default: a prelude frame is library code the program called, most +often `pause' itself, and `P' shows them.") (defun flan-cnr--unavailable (key) (propertize (concat " not available — " (flan-cnr--why key) "\n") @@ -193,7 +199,8 @@ The frame lines below say where each call was; this is the only record of the indexing or the division itself, so it sits directly under the headline." (let ((site (plist-get state :site))) (when site - (insert (propertize (format "at %s\n" site) 'face 'shadow)) + (insert (propertize (format "at %s\n" site) 'face 'shadow + 'flan-cnr-loc site 'mouse-face 'highlight)) (let ((source (plist-get state :source)) (lc (flan-cnr--site-line-col site))) (when (and source lc) @@ -362,26 +369,61 @@ indexing or the division itself, so it sits directly under the headline." (list 'flan-cnr-abort t 'mouse-face 'highlight)))) (insert "\n")) +(defun flan-cnr--prelude-frame-p (fr) + "Whether FR is a frame of a prelude function. +The prelude is compiled into every program and its functions report their +location as `:LINE:COL'. `(pause)' is one: the frame it pushes is the +breakpoint the program's author wrote, not a step of the program." + (let ((loc (plist-get fr :loc))) + (and (stringp loc) (string-prefix-p ":" loc)))) + +(defun flan-cnr--insert-hidden (n) + "The line standing in for N consecutive prelude frames that are hidden." + (let ((start (point))) + (insert (propertize + (format " %d prelude frame%s hidden — P shows %s\n" + n (if (= n 1) "" "s") (if (= n 1) "it" "them")) + 'face 'shadow)) + (add-text-properties start (point) + (list 'flan-cnr-hidden t 'mouse-face 'highlight)))) + (defun flan-cnr--insert-stack (state) - (flan-cnr--section "Stack (innermost first) — TAB folds a frame's locals:") + (flan-cnr--section + "Stack (innermost first) — RET visits a frame's source, TAB folds its locals:") (let ((frames (plist-get state :stack))) (if (null frames) (insert (flan-cnr--unavailable 'stack)) - (let ((i -1)) + (let ((i -1) (hidden 0)) (dolist (fr frames) (setq i (1+ i)) - (let ((start (point)) - (open (memq i flan-cnr--open))) - (insert (format " %2d: %s %s%s\n" i - (if open "v" ">") - (propertize (or (plist-get fr :fn) "?") - 'face 'font-lock-function-name-face) - (if (plist-get fr :loc) - (propertize (format " %s" (plist-get fr :loc)) - 'face 'shadow) - ""))) - (add-text-properties start (point) - (list 'flan-cnr-frame i 'mouse-face 'highlight))) + ;; A hidden frame keeps its number. The index is what `locals' and + ;; the inspector are asked by, so the frames either side of a hidden + ;; run are numbered with a gap, and the line in the gap says why. + (if (and (not flan-cnr--show-prelude) (flan-cnr--prelude-frame-p fr)) + (setq hidden (1+ hidden)) + (when (> hidden 0) + (flan-cnr--insert-hidden hidden) + (setq hidden 0)) + (flan-cnr--insert-frame i fr))) + (when (> hidden 0) (flan-cnr--insert-hidden hidden))))) + (insert "\n")) + +(defun flan-cnr--insert-frame (i fr) + "Draw frame I, FR, and its locals when it is open." + (let ((start (point)) + (open (memq i flan-cnr--open))) + (insert (format " %2d: %s %s%s\n" i + (if open "v" ">") + (propertize (or (plist-get fr :fn) "?") + 'face 'font-lock-function-name-face) + (if (plist-get fr :loc) + (propertize (format " %s" (plist-get fr :loc)) + 'face 'shadow) + ""))) + (add-text-properties start (point) + (append (list 'flan-cnr-frame i 'mouse-face 'highlight) + (when (plist-get fr :loc) + (list 'flan-cnr-loc (plist-get fr :loc)))))) ;; Collapsed by default. A stopped program has as many locals as it ;; has frames, and all of them at once is the backtrace problem again ;; one level down. @@ -413,8 +455,7 @@ indexing or the division itself, so it sits directly under the headline." (add-text-properties start (point) (list 'flan-cnr-inspect (list :slot i (nth 3 l) (nth 0 l)) - 'mouse-face 'highlight))))))))))) - (insert "\n")) + 'mouse-face 'highlight)))))))) (defun flan-cnr--insert-globals (state) "Draw the globals the stopped stack reaches. @@ -493,7 +534,7 @@ puts the likely culprit on top." ;; an entry is annotated with have to be on screen above it to read. (flan-cnr--insert-globals state) (insert (propertize - "RET/0-9 take a abort TAB fold a frame i inspect g refresh q quit\n" + "RET/0-9 take RET on a frame visits it TAB fold P prelude frames i inspect a abort g refresh q quit\n" 'face 'shadow)) (goto-char (point-min)) ;; Point starts on the restart that abandons the evaluation, when there is @@ -535,9 +576,77 @@ puts the likely culprit on top." ((get-text-property (point) 'flan-cnr-restart) (flan-cnr--invoke (get-text-property (point) 'flan-cnr-index) (get-text-property (point) 'flan-cnr-restart))) - ((get-text-property (point) 'flan-cnr-frame) (flan-cnr-toggle-frame)) + ((get-text-property (point) 'flan-cnr-hidden) (flan-cnr-toggle-prelude)) + ((or (get-text-property (point) 'flan-cnr-frame) + (get-text-property (point) 'flan-cnr-loc)) + (flan-cnr-visit)) (t (user-error "flan: nothing to take on this line")))) +(defun flan-cnr--loc-subject (pos) + "What the location at POS is the location of, for a refusal." + (let ((i (get-text-property pos 'flan-cnr-frame))) + (if i + (format "frame %d, %s," i + (or (plist-get (nth i (plist-get flan-cnr--state :stack)) :fn) + "?")) + "the stop"))) + +(defun flan-cnr-visit () + "Visit the source of the frame, or of the stop, on this line. +A frame's location is where its function is written; the stop's is the +expression that stopped." + (interactive) + (let ((loc (get-text-property (point) 'flan-cnr-loc))) + (unless loc + (user-error + (if (get-text-property (point) 'flan-cnr-frame) + "flan: this frame has no location; the program did not report one" + "flan: point is not on a frame or on the stop"))) + (flan-visit-loc loc (flan-cnr--loc-subject (point))))) + +(defun flan-cnr-toggle-prelude () + "Show or hide the prelude's frames in the stack section." + (interactive) + (setq flan-cnr--show-prelude (not flan-cnr--show-prelude)) + (let ((line (line-number-at-pos))) + (flan-cnr--render flan-cnr--state) + (goto-char (point-min)) + (forward-line (1- line))) + (message "flan: prelude frames %s" + (if flan-cnr--show-prelude "shown" "hidden"))) + +(defun flan-cnr--visitable-line-p (pos) + "Whether the line at POS carries a location `next-error' can visit. +A location in angle brackets, `', names no file, so the walk steps +over it rather than stopping on a refusal." + (let ((loc (get-text-property pos 'flan-cnr-loc))) + (and loc (not (string-prefix-p "<" loc))))) + +(defun flan-cnr-next-error (&optional n reset) + "The break buffer's `next-error-function': walk the stop and its frames. +Moves N lines that carry a visitable location, from the top when RESET, and +visits the source of the one it lands on." + (setq n (or n 1)) + (let ((dir (if (< n 0) -1 1)) + (left (abs n)) + (found nil)) + (save-excursion + (if reset (goto-char (point-min)) (beginning-of-line)) + ;; From the top, the first step lands on the first location rather than + ;; the second; and a count of zero means the line point is on. + (when (and (or reset (zerop left)) (flan-cnr--visitable-line-p (point))) + (setq left (max 0 (1- left)) found (point))) + (while (and (> left 0) (zerop (forward-line dir)) (not (eobp))) + (when (flan-cnr--visitable-line-p (point)) + (setq left (1- left) found (point))))) + (when (or (> left 0) (null found)) + (user-error "flan: no more frames with a source location")) + (goto-char found) + (let ((win (get-buffer-window (current-buffer)))) + (when win (set-window-point win found))) + (flan-visit-loc (get-text-property found 'flan-cnr-loc) + (flan-cnr--loc-subject found)))) + (defun flan-cnr--invoke (index name) "Take restart INDEX, named NAME. By index, because the index is the identity — two frames can offer `retry' @@ -668,6 +777,7 @@ drawn from." (get-text-property pos 'flan-cnr-shadowed) (get-text-property pos 'flan-cnr-abort) (get-text-property pos 'flan-cnr-frame) + (get-text-property pos 'flan-cnr-hidden) (get-text-property pos 'flan-cnr-inspect))) (defun flan-cnr-tab () @@ -691,6 +801,8 @@ anyone who would rather TAB always moved." (define-key map "n" #'flan-cnr-next) (define-key map "p" #'flan-cnr-previous) (define-key map "f" #'flan-cnr-toggle-frame) + (define-key map "v" #'flan-cnr-visit) + (define-key map "P" #'flan-cnr-toggle-prelude) (define-key map "i" #'flan-cnr-inspect) (define-key map "a" #'flan-cnr-abort) (define-key map "g" #'flan-cnr-refresh) @@ -704,7 +816,10 @@ anyone who would rather TAB always moved." (define-derived-mode flan-cnr-mode special-mode "flan-break" "What a stopped Flan program is offering." - (setq buffer-read-only t)) + (setq buffer-read-only t) + ;; `next-error' walks the stop and then the frames, innermost first, the way + ;; it walks a compiler's messages. + (setq-local next-error-function #'flan-cnr-next-error)) (defun flan-cnr-state-from-reply (reply &optional fields stack globals) "The buffer's state, out of a `break' REPLY. @@ -914,7 +1029,11 @@ walk from a running program." (flan-cnr-condition-fields (plist-get r :condition)) (flan-cnr-backtrace) - (flan-cnr-globals)))) + (flan-cnr-globals))) + ;; So `M-g M-n' from the source buffer walks this stack rather than + ;; the last compilation's errors, for as long as the program is + ;; stopped here. + (setq next-error-last-buffer buf)) (pop-to-buffer buf) buf))) diff --git a/emacs/flan.el b/emacs/flan.el index ffbfd0b9..72a4dae4 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -1317,6 +1317,41 @@ than being told so." (string-to-number (match-string 2 loc)) (string-to-number (match-string 3 loc))))) +(defun flan--visitable-loc (loc subject) + "LOC as (FILE LINE COL) when FILE can be visited, or a `user-error'. +SUBJECT names what LOC is the location of, for the refusal. One set of +refusals for every place that jumps to a location the daemon sent: M-. on a +definition, and RET on a frame or on the stop in the break buffer." + (let ((parts (flan--parse-loc loc))) + (cond + ((null parts) + (user-error "flan: the daemon gave %s an unreadable location: %s" + subject loc)) + ((string-match-p "\\`<.*>\\'" (nth 0 parts)) + ;; The prelude is a string inside the compiler (lib/prelude.ml) and + ;; names itself ; anything in angle brackets is a placeholder + ;; the frontend made up, not a path. + (user-error "flan: %s is defined in %s, which is not a file on disk" + subject (nth 0 parts))) + ((not (file-name-absolute-p (nth 0 parts))) + ;; The daemon makes its own source path absolute, so anything relative + ;; arriving here came from somewhere that did not, and the directory it + ;; is relative to is the daemon's, not this one's. + (user-error "flan: %s is at %s, relative to a directory this end does not know" + subject (nth 0 parts))) + ((not (file-exists-p (nth 0 parts))) + (user-error "flan: %s is defined in %s, which is not a file on disk" + subject (nth 0 parts))) + (t parts)))) + +(defun flan-visit-loc (loc subject) + "Visit LOC in another window, refusing by `flan--visitable-loc's rules. +Returns the buffer visited." + (let ((parts (flan--visitable-loc loc subject))) + (find-file-other-window (nth 0 parts)) + (goto-char (flan--position (nth 1 parts) (nth 2 parts))) + (current-buffer))) + (defun flan--position (line col) "Position of LINE and byte-column COL in the current buffer." (save-excursion @@ -2136,37 +2171,15 @@ in this program; C-c C-v describes it" (car d))) (user-error "flan: %s is a %s, and the daemon reports no location for one" (car d) (nth 1 d))) (t - (let ((parts (flan--parse-loc (nth 3 d)))) - (cond - ((null parts) - (user-error "flan: the daemon gave %s an unreadable location: %s" - (car d) (nth 3 d))) - ((string-match-p "\\`<.*>\\'" (nth 0 parts)) - ;; The prelude is a string inside the compiler (lib/prelude.ml) and - ;; names itself ; anything in angle brackets is a - ;; placeholder the frontend made up, not a path. - (user-error "flan: %s is defined in %s, which is not a file on disk" - (car d) (nth 0 parts))) - ((not (file-name-absolute-p (nth 0 parts))) - ;; The daemon makes its own source path absolute, so anything - ;; relative arriving here came from somewhere that did not, and the - ;; directory it is relative to is the daemon's, not this one's. - (user-error "flan: %s is at %s, relative to a directory this end does not know" - (car d) (nth 0 parts))) - ((not (file-exists-p (nth 0 parts))) - ;; The prelude is a string inside the compiler (lib/prelude.ml), so - ;; its location names a file nobody can visit. - (user-error "flan: %s is defined in %s, which is not a file on disk" - (car d) (nth 0 parts))) - (t - (list (xref-make - (nth 2 d) - (xref-make-file-location - (nth 0 parts) (nth 1 parts) - ;; A byte column, like every other one the daemon sends, but - ;; a top-level definition starts at column 1 and anything - ;; indenting it is ASCII, so the two agree here. - (max 0 (1- (nth 2 parts))))))))))))) + (let ((parts (flan--visitable-loc (nth 3 d) (car d)))) + (list (xref-make + (nth 2 d) + (xref-make-file-location + (nth 0 parts) (nth 1 parts) + ;; A byte column, like every other one the daemon sends, but + ;; a top-level definition starts at column 1 and anything + ;; indenting it is ASCII, so the two agree here. + (max 0 (1- (nth 2 parts))))))))))) ;;; Documentation diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 730b5c27..2ed8a8a4 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -1028,7 +1028,8 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "the stack says the program is running, not that it is unbuilt" (string-match-p "Stack.*\n not available.*running" (substring text (string-match "--- Stack" text)))) - (test-flan--check "and the keys are shown" (string-match-p "TAB fold a frame" text))) + (test-flan--check "and the keys are shown" (and (string-match-p "TAB fold" text) + (string-match-p "P prelude frames" text)))) ;; A stopped program with nothing on offer between the error and the top. It ;; is a real state — spec-conditions §2's `error' with no `restart-case' above @@ -1229,6 +1230,82 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "and TAB again closes it" (not (string-match-p "i32 i = 7" (buffer-string)))))) +;; The prelude's frames, and the source behind a frame. `(pause)' is a prelude +;; function, so the innermost frame of every breakpoint is the prelude's own and +;; not a step of the program. It is hidden and keeps its number, because the +;; number is what `locals' and the inspector are asked by. +(let* ((dir (make-temp-file "flan-cnr-src" t)) + (src (expand-file-name "game.flan" dir))) + (with-temp-file src + (insert "(defn tick [] ()\n (pause))\n\n(defn main [] ()\n (tick))\n")) + (let* ((state (list :condition "Pause" :restarts '("continue") + :site (format "%s:2:3" src) :source " (pause))" + :stack (list (list :fn "pause" :loc ":151:7" + :fetched t :locals nil) + (list :fn "tick" :loc (format "%s:1:1" src) + :fetched t :locals nil) + (list :fn "main" :loc (format "%s:4:1" src) + :fetched t :locals nil)))) + (buf (test-flan--cnr state))) + (with-current-buffer buf + (setq flan-cnr--show-prelude nil) + (flan-cnr--render state) + (let ((text (buffer-string))) + (test-flan--check "a prelude frame is hidden to begin with" + (not (string-match-p "0: > pause" text))) + (test-flan--check "and a line in its place says so" + (string-match-p "1 prelude frame hidden — P shows it" text)) + (test-flan--check "the program's frames keep their numbers" + (and (string-match-p " 1: > tick" text) + (string-match-p " 2: > main" text)))) + (goto-char (point-min)) + (search-forward "prelude frame hidden") + (flan-cnr-take) + (test-flan--check "RET on that line shows the prelude frames" + (string-match-p " 0: > pause +:151:7" + (buffer-string))) + (goto-char (point-min)) + (search-forward " 0: > pause") + (let ((msg (test-flan--caught #'flan-cnr-visit))) + (test-flan--check "visiting a prelude frame refuses, naming the prelude" + (and msg (string-match-p ", which is not a file" msg)))) + (flan-cnr-toggle-prelude) + (test-flan--check "and P hides them again" + (not (string-match-p "0: > pause" (buffer-string)))) + ;; RET on a frame goes to where its function is written. + (goto-char (point-min)) + (search-forward " 2: > main") + (save-window-excursion + (let ((visited (progn (flan-cnr-take) (current-buffer)))) + (test-flan--check "RET on a frame visits its source" + (equal (buffer-file-name visited) src)) + (test-flan--check "at the frame's line" + (= (line-number-at-pos) 4)) + (kill-buffer visited))) + (test-flan--check "RET on a frame no longer folds it" + (not (memq 2 flan-cnr--open))) + ;; next-error: the stop first, then each frame with a file behind it. + (test-flan--check "the break buffer is a next-error buffer" + (eq next-error-function #'flan-cnr-next-error)) + (let ((lines nil)) + (save-window-excursion + (with-current-buffer buf + (goto-char (point-min)) + (dotimes (k 3) + (let ((b (flan-cnr-next-error 1 (zerop k)))) + (push (with-current-buffer b (line-number-at-pos)) lines) + (set-buffer buf))) + (test-flan--check "and past the last frame it says so" + (test-flan--caught + (lambda () (flan-cnr-next-error 1)))) + (flan-cnr-next-error -1) + (test-flan--check "and walks back" + (= (line-number-at-pos) 1)))) + (test-flan--check "next-error walks the stop, then tick, then main" + (equal (nreverse lines) '(2 1 4)))) + (let ((b (get-file-buffer src))) (when b (kill-buffer b)))) + (delete-directory dir t))) + ;; 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