From ac7d4a0e95382ce8ade94443292174e7048ba2a6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 04:56:25 +0700 Subject: [PATCH] The prompt numbers its choices, because a name could not say which now lists the restarts by position and sends the position, with the name alongside as the receipt the program checks. A restart below the evaluation the break is inside is shown marked rather than hidden: someone who can see a restart in their own source and not on this list has been told nothing, and the refusal carries the reason. --- emacs/flan-dev.el | 65 ++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 62 insertions(+), 3 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index fc612b6..68db5ab 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -609,12 +609,51 @@ every bit as connected and nothing like running." ;; first. `completing-read' over them is the natural shape: they are a closed ;; set the program computed, so require-match is exactly right. ;; +;; What is chosen is a *position* on that list, not a name. §4 says lookup +;; takes the first frame offering a name, so when two frames offer `retry' the +;; outer one is real, is on this list, and by name is unreachable — the old +;; prompt showed `retry' twice and sent the string either way, and the inner +;; frame took it silently. A position cannot be ambiguous, which is why SBCL +;; identifies restarts positionally too. So the candidates are numbered and +;; the number is what goes on the wire. +;; ;; `abort' is on the same list rather than on a separate key, because it is the ;; same decision: it is what you pick when none of the restarts is the answer. ;; It is last, and it is not the default. +(defun flan-dev--restart-candidates (restarts unreachable) + "Label each of RESTARTS by its position, marking those in UNREACHABLE. +An alist of label to index. The index leads the label because it is the +identity: two entries may read the same and mean different frames." + (let ((i -1)) + (mapcar (lambda (name) + (setq i (1+ i)) + (cons (format "%d. %s%s" i name + (if (memq i unreachable) + " (below this break; cannot be taken)" + "")) + i)) + restarts))) + +(defun flan-dev-restart-at (index name) + "Resume the stopped program at the restart at position INDEX. +NAME is sent with it and is not the lookup: the program checks it against +the name it holds at that position and refuses if the two have drifted +apart, so a prompt cannot take a different restart than the one it showed." + (let ((r (flan-dev--request (list :op "restart-at" :index index :name name)))) + (if (equal (plist-get r :status) "ok") + (progn + ;; Accepted, not resumed — see `flan-dev-restart'. + (setq flan-dev--stopped nil) + (force-mode-line-update t) + (message "flan: %s — %s" name (or (plist-get r :note) "accepted"))) + (user-error "flan: %s" (or (plist-get r :message) "refused"))))) + (defun flan-dev-restart (name) - "Resume the stopped program at the restart called NAME." + "Resume the stopped program at the restart called NAME. +The first frame offering NAME, which is §4's own rule and therefore cannot +reach a shadowed one. `flan-break' chooses by position instead; this is +here for a name known in advance." (interactive (list (completing-read "Restart: " (flan-dev-restarts) nil t))) (let ((r (flan-dev--request (list :op "restart" :name name)))) (if (equal (plist-get r :status) "ok") @@ -651,6 +690,17 @@ nothing left to serve once it has gone." (user-error "flan: %s" (or (plist-get r :message) "refused"))) (plist-get r :restarts))) +(defun flan-dev-unreachable-restarts () + "Positions on the restart list that cannot be chosen. +A restart below the evaluation a break is inside has nowhere for a transfer +to land — the thunk holds its own channel and drops it on return. They are +listed and marked rather than hidden, because someone who can see a restart +in their own source and not on this list has been told nothing." + (let ((r (flan-dev--request '(:op "break")))) + (unless (equal (plist-get r :status) "ok") + (user-error "flan: %s" (or (plist-get r :message) "refused"))) + (append (plist-get r :unreachable) nil))) + ;;;###autoload (defun flan-break () "Show what the stopped program is offering, and choose one. @@ -664,12 +714,21 @@ than being told so." (unless flan-dev--stopped (user-error "flan: the program is running; nothing is stopped")) (let* ((restarts (plist-get r :restarts)) + (unreachable (append (plist-get r :unreachable) nil)) + (table (flan-dev--restart-candidates restarts unreachable)) (choice (completing-read (format "flan: stopped on %s%s — " flan-dev--stopped (if restarts "" " (no restarts are active)")) - (append restarts '("abort")) nil t))) - (if (equal choice "abort") (flan-dev-abort) (flan-dev-restart choice))))) + (append (mapcar #'car table) '("abort")) nil t)) + (index (cdr (assoc choice table)))) + (cond + ((equal choice "abort") (flan-dev-abort)) + ;; `require-match' over a table this built, so a choice outside it is + ;; not something a person can type — but deriving the table wrongly + ;; should say so rather than put nil on the wire as an index. + ((null index) (user-error "flan: %s is not on the list" choice)) + (t (flan-dev-restart-at index (nth index restarts))))))) ;;;###autoload (defun flan-show-output ()