The break buffer hides the prelude's frames and opens the source behind a frame

This commit is contained in:
Joseph Ferano 2026-09-25 07:04:56 +07:00
parent 9c0e659209
commit 2e58880160
5 changed files with 291 additions and 63 deletions

View File

@ -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 <prelude>: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 =<prelude>= 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,

View File

@ -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.

View File

@ -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 `<prelude>: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 "<prelude>:" 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, `<prelude>', 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)))

View File

@ -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 <prelude>; 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 <prelude>; 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

View File

@ -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 "<prelude>: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 +<prelude>: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 "<prelude>, 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