From aab6c28450aea2203e45f1d63150bb83536e5cff Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 17:46:35 +0700 Subject: [PATCH 1/5] Show a rejection where it is, on the line it is actually on MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit An error that only reaches the echo area is gone the moment you type, and the location was the useful half of it. So the client draws an overlay at the `:loc` the daemon sent, with the message beside the code, and clears it the next time that buffer's evaluation is accepted — a marker left behind after a fix is a lie about the running program. Two things had to be right first, and neither was. The column in a `:loc` is a *byte* offset: lib/reader.ml walks the source a byte at a time and OCaml strings are bytes. The old code did `forward-char` with it, which is the same mistake as counting a frame's length in characters, in a different place — one accented character earlier on the line puts the marker as many columns to the right. It goes through `byte-to-position` from the line's start now, and is clamped to the end of the line, which the old code also needed: a column past a short line walked into the next one and pointed at innocent code. And the daemon numbers lines from the start of what it was *sent*, so `C-c C-c` on a defn halfway down a buffer came back saying line 1. Every overlay would have sat on the file's first line. The fix is leading newlines: the reader skips them, and the reply's line numbers are then the buffer's own. No protocol change, and nothing the daemon has to know. Marking the error must not itself signal — the error the caller is owed is the daemon's, and losing it to a bad location would report the wrong thing. --- emacs/flan-dev.el | 138 ++++++++++++++++++++++++++++++++++++----- emacs/test-flan-dev.el | 59 ++++++++++++++++++ 2 files changed, 182 insertions(+), 15 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index d5c8736..f30d28b 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -23,6 +23,7 @@ ;;; Code: (require 'subr-x) +(require 'seq) (defgroup flan-dev nil "Talking to a running Flan program." @@ -173,6 +174,97 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (if (plist-get r :alive) "running" "exited") (length (plist-get r :fns)) (length (plist-get r :globals))))) +;;; Where an error is + +;; A reply's :loc is "file:line:col", and the column is a *byte* offset into +;; the line: the reader walks the source a byte at a time (lib/reader.ml), and +;; OCaml strings are bytes. Emacs counts characters, so the same rule the +;; framing has applies here — one non-ASCII character earlier on the line puts +;; the marker as many columns to the right as that character has bytes. Going +;; through `byte-to-position' from the line's start is the whole fix, and +;; `forward-char' would also have walked into the next line on a column past +;; the end of a short one. + +(defun flan-dev--parse-loc (loc) + "Split LOC, a \"file:line:col\" string, into (FILE LINE COL), or nil." + (when (and (stringp loc) + (string-match "\\`\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)\\'" loc)) + (list (match-string 1 loc) + (string-to-number (match-string 2 loc)) + (string-to-number (match-string 3 loc))))) + +(defun flan-dev--position (line col) + "Position of LINE and byte-column COL in the current buffer." + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (let* ((bol (point)) + (eol (line-end-position)) + (want (+ (position-bytes bol) (max 0 (1- col)))) + (p (and (<= want (position-bytes eol)) (byte-to-position want)))) + ;; Clamped rather than trusted: a column past the end of the line is a + ;; location for something the reader wanted and did not find, and + ;; overshooting into the next line would point at innocent code. + (min (or p eol) eol)))) + +(defun flan-dev--buffer-visiting (file) + "The live buffer visiting FILE, or nil. +Compared with `file-equal-p', so a symlinked or relative path still matches." + (seq-find (lambda (b) + (let ((n (buffer-local-value 'buffer-file-name b))) + (and n (file-exists-p file) (file-equal-p n file)))) + (buffer-list))) + +;;; Error overlays + +;; An error is shown where it is rather than only in the echo area, because the +;; echo area is gone the moment you type and the location is the useful half of +;; the message. It is cleared when the next evaluation of that buffer is +;; accepted: an overlay left behind after a fix is a lie about the program, and +;; a stale one is worse than none. + +(defface flan-dev-error-face + '((t :inherit error :underline (:style wave))) + "Face for the text an evaluation was rejected at." + :group 'flan-dev) + +(defface flan-dev-error-message-face + '((t :inherit error :height 0.9)) + "Face for the message shown beside a rejected form." + :group 'flan-dev) + +(defun flan-dev-clear-errors (&optional buffer) + "Remove Flan error overlays from BUFFER, or from the current buffer." + (interactive) + (with-current-buffer (or buffer (current-buffer)) + (remove-overlays (point-min) (point-max) 'flan-dev-error t))) + +(defun flan-dev--show-error (loc msg) + "Mark MSG at LOC, if LOC names a file some buffer is visiting. +Returns non-nil when it put an overlay somewhere." + (let ((parts (flan-dev--parse-loc loc))) + (when parts + (let ((buf (flan-dev--buffer-visiting (nth 0 parts)))) + (when buf + (with-current-buffer buf + (flan-dev-clear-errors buf) + (let* ((beg (flan-dev--position (nth 1 parts) (nth 2 parts))) + (end (save-excursion (goto-char beg) (line-end-position))) + (ov (make-overlay beg end buf t nil))) + (overlay-put ov 'flan-dev-error t) + (overlay-put ov 'face 'flan-dev-error-face) + (overlay-put ov 'help-echo msg) + (overlay-put ov 'evaporate nil) + (overlay-put ov 'priority 100) + (overlay-put ov 'after-string + (propertize (concat " " msg) + 'face 'flan-dev-error-message-face)) + ;; Point goes there too, but only in the buffer being looked at: + ;; moving point in a buffer nobody is showing is a surprise the + ;; next time it is visited. + (when (eq buf (current-buffer)) (goto-char beg)) + t))))))) + ;;; Evaluating (defun flan-dev--report (reply what) @@ -182,6 +274,8 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (names (plist-get reply :names)) (note (plist-get reply :note)) (value (plist-get reply :value))) + ;; Accepted, so whatever the last rejection marked is no longer true. + (flan-dev-clear-errors) (when flan-dev-echo-result (if value ;; An expression's value, rendered inside the running program — @@ -195,18 +289,14 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (if fns (string-join fns ", ") (if names (string-join names ", ") what)) (or (plist-get reply :ms) 0)))))) - ;; The daemon reports where, so put point there when it is this buffer. + ;; The daemon reports where, so mark it there. This must not itself + ;; signal: the error the caller is owed is the daemon's, and losing it to a + ;; bad location would report the wrong thing entirely. (let ((loc (plist-get reply :loc)) (msg (plist-get reply :message))) - (when (and loc (string-match "\\`\\(.*\\):\\([0-9]+\\):\\([0-9]+\\)\\'" loc)) - (let ((file (match-string 1 loc)) - (line (string-to-number (match-string 2 loc))) - (col (string-to-number (match-string 3 loc)))) - (when (and buffer-file-name (file-equal-p file buffer-file-name)) - (goto-char (point-min)) - (forward-line (1- line)) - (forward-char (max 0 (1- col)))))) - (user-error "flan: %s" (or msg "rejected"))))) + (ignore-errors (flan-dev--show-error loc (or msg "rejected"))) + (user-error "flan: %s%s" (or msg "rejected") + (if loc (format " (%s)" loc) ""))))) (defun flan-dev--eval (code what) "Send CODE to the running program. WHAT names it for the echo area." @@ -217,19 +307,37 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (list :op "eval" :code code :file (or buffer-file-name ""))) what)) -(defun flan-dev--defun-at-point () - "The text of the top-level form containing or preceding point." +(defun flan-dev--text (start end) + "The buffer text from START to END, on the line it is actually written on. + +The daemon reads what it is sent starting at line 1, so a form taken from the +middle of a buffer comes back with a location relative to the *snippet* — and +an error overlay drawn from that sits on line 1 of the file, pointing at +whatever happens to be there. Leading newlines are the whole fix: the reader +skips them, and the line numbers in the reply are then the buffer's own. The +columns already were, because a top-level form starts at column 1." + (concat (make-string (1- (line-number-at-pos start)) ?\n) + (buffer-substring-no-properties start end))) + +(defun flan-dev--defun-bounds () + "Bounds of the top-level form containing or preceding point, as (START . END)." (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) - (buffer-substring-no-properties (point) end)))) + (cons (point) end)))) + +(defun flan-dev--defun-at-point () + "The text of the top-level form containing or preceding point." + (let ((b (flan-dev--defun-bounds))) + (buffer-substring-no-properties (car b) (cdr b)))) ;;;###autoload (defun flan-eval-defun () "Recompile the top-level form at point and install it in the running program." (interactive) - (flan-dev--eval (flan-dev--defun-at-point) "form")) + (let ((b (flan-dev--defun-bounds))) + (flan-dev--eval (flan-dev--text (car b) (cdr b)) "form"))) ;;;###autoload (defun flan-eval-buffer () @@ -256,7 +364,7 @@ arrive in the same load or the first refers to storage that does not exist." (defun flan-eval-region (start end) "Recompile the top-level forms between START and END." (interactive "r") - (flan-dev--eval (buffer-substring-no-properties start end) "region")) + (flan-dev--eval (flan-dev--text start end) "region")) (provide 'flan-dev) ;;; flan-dev.el ends here diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index ab9dce3..abf3712 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -63,6 +63,65 @@ (test-flan--check "a form that does not check is reported" (and raised (string-match-p "unknown name" raised)))) + ;; The :loc column is a *byte* offset — lib/reader.ml walks the source a byte + ;; at a time — and Emacs counts characters. Same rule as the framing, a + ;; different place to get it wrong, and it shows up only for someone whose + ;; comments or identifiers are not ASCII. + (with-temp-buffer + (insert ";; héllo\n(defn wörld [] i64 nonsense)\n") + (let ((want (save-excursion + (goto-char (point-min)) + (search-forward "nonsense") + (match-beginning 0))) + (eol (save-excursion (goto-char (point-min)) (line-end-position)))) + (test-flan--check "a byte column lands on the right character" + (= (flan-dev--position + 2 (1+ (string-bytes "(defn wörld [] i64 "))) + want)) + (test-flan--check "a column past the end of a line is clamped to it" + (= (flan-dev--position 1 500) eol)))) + + ;; A rejected form is marked where it is, not only in the echo area. The + ;; daemon numbers lines from the start of what it was sent, so a form taken + ;; from the middle of a buffer only lands on the right line because the + ;; client pads it back into place before sending. + (goto-char (point-min)) + (search-forward "(defn step") + (goto-char (match-beginning 0)) + (let ((defn-line (line-number-at-pos))) + (save-excursion + (search-forward "(+ ticks 41)") + (replace-match "(+ ticks nonsense)")) + (ignore-errors (flan-eval-defun)) + (let ((ovs (seq-filter (lambda (o) (overlay-get o 'flan-dev-error)) + (overlays-in (point-min) (point-max))))) + (test-flan--check "a rejected form gets exactly one error overlay" + (= 1 (length ovs))) + (test-flan--check "the overlay is at the form, not at line 1" + (and ovs (>= (line-number-at-pos (overlay-start (car ovs))) + defn-line))) + (test-flan--check "the overlay carries the daemon's reason" + (and ovs + (string-match-p + "unknown name" + (or (overlay-get (car ovs) 'help-echo) "")))) + (test-flan--check "and shows it beside the code" + (and ovs + (string-match-p + "unknown name" + (or (overlay-get (car ovs) 'after-string) ""))))) + ;; ...and it goes away when the next evaluation is accepted. A marker left + ;; behind after a fix is a lie about the running program. Point moved to + ;; the error, which is the point of all this, so start the search over. + (goto-char (point-min)) + (search-forward "(+ ticks nonsense)") + (replace-match "(+ ticks 41)") + (search-backward "(defn step") + (flan-eval-defun) + (test-flan--check "an accepted evaluation clears it" + (null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error)) + (overlays-in (point-min) (point-max)))))) + ;; The session is not poisoned by that: a good form still lands. (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") From 12f99702b410fd546db6d099bfea18ef1758938d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 17:48:06 +0700 Subject: [PATCH 2/5] Say in the modeline whether there is a program, and reconnect to one MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Whether a program is on the other end is the one fact worth a permanent place on screen, because every command in the client is a lie without it. Until now it was discovered by something failing, which is the worst moment to learn it. Three states, not two. `off' is never connected; `lost' is a daemon that has gone away, which is the ordinary case rather than an error — `flan dev' ends when its program does, and a program under development exits all the time. So `lost' is reconnected from, on the socket it was on, the next time anything is sent. The reconnect is strictly *before* a send and never after one. A connection that dies mid-request might have died after the daemon took the request and ran it; resending would install a definition twice, or evaluate a side-effecting expression twice. That case now reports what happened and says it was not resent, rather than silently doing it again. A socket that is not there is refused by name with the path, and a deliberate `flan-disconnect' forgets the socket, so the next command says "not connected" instead of quietly reopening what was just closed. --- emacs/flan-dev.el | 111 +++++++++++++++++++++++++++++++++++------ emacs/test-flan-dev.el | 34 +++++++++++++ 2 files changed, 131 insertions(+), 14 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index f30d28b..70eec52 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -24,6 +24,7 @@ (require 'subr-x) (require 'seq) +(require 'pcase) (defgroup flan-dev nil "Talking to a running Flan program." @@ -73,7 +74,16 @@ (accept-process-output proc 0.05)) (goto-char (point-min)) (unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t) - (error "flan dev: no reply")) + ;; Deliberately not retried. If the daemon took the request and died + ;; before replying, the evaluation may well have happened — sending it + ;; again would install it twice, or run a side-effecting expression + ;; twice. Reconnecting happens before a send, never after one. + (if (process-live-p proc) + (error "flan dev: no reply in 30s from %s" + (abbreviate-file-name (or flan-dev--socket "the daemon"))) + (error + "flan dev: the daemon on %s closed the connection; not resent, because it may already have run" + (abbreviate-file-name (or flan-dev--socket "?"))))) (let* ((n (string-to-number (match-string 1))) (body-start (point))) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) @@ -120,11 +130,50 @@ flan-dev-socket-name))) (and dir (expand-file-name flan-dev-socket-name dir)))) +(defun flan-dev--open (socket) + "Open a connection to SOCKET and make it the current one." + (when (process-live-p flan-dev--connection) + (delete-process flan-dev--connection)) + (let ((buf (get-buffer-create " *flan-dev*"))) + ;; Unibyte, because the framing counts bytes and this buffer is where they + ;; are counted. + (with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil)) + (setq flan-dev--connection + (make-network-process + :name "flan-dev" :buffer buf :family 'local :service socket + :coding 'binary :noquery t)) + (setq flan-dev--socket socket)) + (force-mode-line-update t) + flan-dev--connection) + +;; A daemon restarted while Emacs was not looking is the ordinary case, not an +;; exceptional one: `flan dev' ends when its program does, and a program under +;; development exits all the time. So a dead connection is reopened on the +;; socket it was on rather than reported — but only *before* a request goes +;; out. Reconnecting after one has been sent and lost would be a retry, and a +;; retry of `eval-expr' runs the expression a second time. (defun flan-dev--live-connection () - "The open connection, or signal an error saying how to get one." - (unless (and flan-dev--connection - (process-live-p flan-dev--connection)) - (error "Not connected: M-x flan-connect, or start `flan dev program.flan'")) + "The open connection, reconnecting if the daemon has been restarted." + (unless (process-live-p flan-dev--connection) + (cond + ((null flan-dev--socket) + (error "Not connected: M-x flan-connect, or start `flan dev program.flan'")) + ((not (file-exists-p flan-dev--socket)) + (setq flan-dev--connection nil) + (force-mode-line-update t) + (error "flan dev: nothing is listening on %s; start `flan dev program.flan' again" + (abbreviate-file-name flan-dev--socket))) + (t + (condition-case err + (progn (flan-dev--open flan-dev--socket) + (message "flan dev: reconnected to %s" + (abbreviate-file-name flan-dev--socket))) + (error + (setq flan-dev--connection nil) + (force-mode-line-update t) + (error "flan dev: cannot reconnect to %s: %s" + (abbreviate-file-name flan-dev--socket) + (error-message-string err))))))) flan-dev--connection) ;;;###autoload @@ -135,15 +184,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (list (or (flan-dev--find-socket) (read-file-name "flan dev socket: ")))) (unless socket (user-error "No %s found above this buffer" flan-dev-socket-name)) - (when (process-live-p flan-dev--connection) - (delete-process flan-dev--connection)) - (let ((buf (get-buffer-create " *flan-dev*"))) - (with-current-buffer buf (erase-buffer) (set-buffer-multibyte nil)) - (setq flan-dev--connection - (make-network-process - :name "flan-dev" :buffer buf :family 'local :service socket - :coding 'binary :noquery t)) - (setq flan-dev--socket socket)) + (flan-dev--open socket) (let ((r (flan-dev--request '(:op "describe")))) (message "flan dev: connected to %s (%d functions, %d globals)" (abbreviate-file-name socket) @@ -157,8 +198,50 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (ignore-errors (flan-dev--request '(:op "close"))) (delete-process flan-dev--connection)) (setq flan-dev--connection nil) + ;; Forgotten, not kept: this was a deliberate disconnect, so the next + ;; request should say so rather than quietly reopening what was just closed. + (setq flan-dev--socket nil) + (force-mode-line-update t) (message "flan dev: disconnected")) +;;; The modeline + +;; Whether there is a program on the other end is the one thing worth a +;; permanent place on screen, because every other command in here is a lie +;; without it. Before this it was discovered by a command failing. + +(defface flan-dev-live-face '((t :inherit success)) + "Face for the modeline indicator when a program is connected." + :group 'flan-dev) + +(defface flan-dev-lost-face '((t :inherit warning)) + "Face for the modeline indicator when the daemon has gone away." + :group 'flan-dev) + +(defun flan-dev-state () + "Whether a program is connected: `live', `lost', or `off'. +`lost' means there was one and the daemon is gone — a restart away, not a +mistake, so it is distinguished from never having connected." + (cond ((process-live-p flan-dev--connection) 'live) + (flan-dev--socket 'lost) + (t 'off))) + +(defun flan-dev-mode-line () + "The Flan connection indicator, for `mode-line-misc-info'." + (when (derived-mode-p 'flan-mode 'flan-repl-mode) + (pcase (flan-dev-state) + ('live (propertize " flan:live" 'face 'flan-dev-live-face + 'help-echo (format "Connected to %s" flan-dev--socket))) + ('lost (propertize " flan:lost" 'face 'flan-dev-lost-face + 'help-echo + (format "%s has gone away; the next command reconnects" + flan-dev--socket))) + (_ (propertize " flan:off" 'face 'shadow + 'help-echo "Not connected (C-c C-z)"))))) + +;; Appended rather than prepended: this is the least urgent thing in the line. +(add-to-list 'mode-line-misc-info '(:eval (flan-dev-mode-line)) t) + ;;;###autoload (defun flan-show-output () "Show the running program's output, after collecting anything pending." diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index abf3712..6f67a80 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -31,8 +31,42 @@ (setq buffer-read-only nil) (test-flan--check "flan-mode is on for a .flan file" (eq major-mode 'flan-mode)) + (test-flan--check "the modeline says so before connecting" + (and (eq (flan-dev-state) 'off) + (string-match-p "off" (flan-dev-mode-line)))) + (flan-connect socket) (test-flan--check "connected" (process-live-p flan-dev--connection)) + (test-flan--check "the modeline says a program is there" + (and (eq (flan-dev-state) 'live) + (string-match-p "live" (flan-dev-mode-line)))) + (test-flan--check "and says nothing in a buffer that is not Flan's" + (with-temp-buffer (null (flan-dev-mode-line)))) + + ;; A daemon restarted while Emacs was not looking is the ordinary case. The + ;; socket outlives this connection, so dropping the process and asking again + ;; is the same situation the client meets after a restart, and it must come + ;; back rather than fail. + (delete-process flan-dev--connection) + (test-flan--check "a dead connection reads as lost, not as never-connected" + (and (eq (flan-dev-state) 'lost) + (string-match-p "lost" (flan-dev-mode-line)))) + (let ((r (flan-dev--request '(:op "describe")))) + (test-flan--check "the next request reconnects on its own" + (and (process-live-p flan-dev--connection) + (member "step" (plist-get r :fns))))) + + ;; But a socket nobody is listening on is refused by name, rather than + ;; retried forever or reported as some other failure. + (let ((flan-dev--connection nil) + (flan-dev--socket "/nonexistent/flan-dev-not-here.sock") + (raised nil)) + (condition-case err (flan-dev--request '(:op "describe")) + (error (setq raised (error-message-string err)))) + (test-flan--check "a socket that is gone is refused by name" + (and raised + (string-match-p "flan-dev-not-here.sock" raised) + (string-match-p "nothing is listening" raised)))) (let ((r (flan-dev--request '(:op "describe")))) (test-flan--check "describe lists the program's functions" From 9e7eba14794347aa0acd0d4e326c00a462015633 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 17:50:00 +0700 Subject: [PATCH 3/5] Say what landed and what it cost, and flash the form it came from MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit An install that reports nothing is indistinguishable from one that failed silently, which is the one thing this loop cannot afford: the whole promise is that the running program now has the body you just wrote. The names come from the reply rather than from what was typed, because the daemon is the one that knows which of them it installed — a `defvar' the program already had is not among them, and the reply already says so with `:note'. That case now reads "nothing to install" instead of quoting a build time for a build that did not happen. `:fns` and `:names' are reported separately for the same reason: a buffer of five functions and two vars should not report as five of anything. A long list is counted and then sampled rather than truncated, since an echo area cut off in the middle of the tenth name tells you neither how many there were nor which. And the region that was sent is flashed, which answers a question the echo area cannot: `beginning-of-defun' may well have found a different form from the one you thought point was in. --- emacs/flan-dev.el | 72 +++++++++++++++++++++++++++++++----------- emacs/test-flan-dev.el | 45 +++++++++++++++++++++++--- 2 files changed, 95 insertions(+), 22 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 70eec52..2abd000 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -25,6 +25,7 @@ (require 'subr-x) (require 'seq) (require 'pcase) +(require 'pulse) (defgroup flan-dev nil "Talking to a running Flan program." @@ -36,9 +37,15 @@ :type 'string) (defcustom flan-dev-echo-result t - "Whether a successful evaluation reports in the echo area." + "Whether an accepted evaluation reports in the echo area. +Turning this off makes a successful evaluation indistinguishable from one +that quietly did nothing, which is why it is on." :type 'boolean) +(defcustom flan-dev-names-shown 4 + "How many installed names to name before falling back to counting them." + :type 'integer) + (defcustom flan-dev-output-buffer "*flan-output*" "Buffer the running program's own output is appended to." :type 'string) @@ -350,6 +357,22 @@ Returns non-nil when it put an overlay somewhere." ;;; Evaluating +;; An install that says nothing is indistinguishable from one that failed +;; silently, so every accepted evaluation reports what landed in the running +;; program and what it cost. The names come from the reply rather than from +;; what was typed: the daemon is the one that knows which of them it installed, +;; and a `defvar' the program already had is not among them. + +(defun flan-dev--names-phrase (names fallback) + "NAMES as a phrase for the echo area, or FALLBACK when there are none. +Long lists are counted and then sampled: an echo area truncated in the middle +of the tenth name tells you neither how many there were nor which." + (cond + ((null names) fallback) + ((<= (length names) flan-dev-names-shown) (string-join names ", ")) + (t (format "%d names (%s, …)" (length names) + (string-join (seq-take names flan-dev-names-shown) ", "))))) + (defun flan-dev--report (reply what) "Report REPLY, describing WHAT was sent." (if (equal (plist-get reply :status) "ok") @@ -360,18 +383,25 @@ Returns non-nil when it put an overlay somewhere." ;; Accepted, so whatever the last rejection marked is no longer true. (flan-dev-clear-errors) (when flan-dev-echo-result - (if value - ;; An expression's value, rendered inside the running program — - ;; nothing was marshalled back, because nothing could be. - (message "=> %s" value) - (if note - ;; The daemon accepted it and had nothing to send. Say so rather - ;; than claiming an install that did not happen. - (message "%s: %s" (if names (string-join names ", ") what) note) - (message "%s installed in %.0fms" - (if fns (string-join fns ", ") - (if names (string-join names ", ") what)) - (or (plist-get reply :ms) 0)))))) + (cond + ;; An expression's value, rendered inside the running program — + ;; nothing was marshalled back, because nothing could be. + (value (message "=> %s" value)) + ;; The daemon accepted it and had nothing to send. Say so rather + ;; than claiming an install that did not happen. + (note (message "flan: %s — %s" + (flan-dev--names-phrase names what) note)) + (t + ;; `:fns' are the bodies that were installed and `:names' is + ;; everything the evaluation declared; a buffer of five functions + ;; and two vars should not report as "five". + (message "flan: %s installed in %.0f ms%s" + (flan-dev--names-phrase fns what) + (or (plist-get reply :ms) 0) + (let ((vars (seq-difference names fns))) + (if vars (format " (also %s)" + (flan-dev--names-phrase vars "")) + ""))))))) ;; The daemon reports where, so mark it there. This must not itself ;; signal: the error the caller is owed is the daemon's, and losing it to a ;; bad location would report the wrong thing entirely. @@ -381,14 +411,20 @@ Returns non-nil when it put an overlay somewhere." (user-error "flan: %s%s" (or msg "rejected") (if loc (format " (%s)" loc) ""))))) -(defun flan-dev--eval (code what) - "Send CODE to the running program. WHAT names it for the echo area." +(defun flan-dev--eval (code what &optional start end) + "Send CODE to the running program. WHAT names it for the echo area. +START and END, when given, are the region it came from, flashed on success." (flan-dev--report (flan-dev--request ;; buffer-file-name so an error points at the file being edited rather than ;; at the daemon's placeholder. (list :op "eval" :code code :file (or buffer-file-name ""))) - what)) + what) + ;; `flan-dev--report' signals on a rejection, so reaching here means it + ;; landed. Flashing the text that was sent answers "which form did that + ;; take?" — the question the echo area cannot, because point may be nowhere + ;; near the defn `beginning-of-defun' actually found. + (when (and start end) (pulse-momentary-highlight-region start end))) (defun flan-dev--text (start end) "The buffer text from START to END, on the line it is actually written on. @@ -420,7 +456,7 @@ columns already were, because a top-level form starts at column 1." "Recompile the top-level form at point and install it in the running program." (interactive) (let ((b (flan-dev--defun-bounds))) - (flan-dev--eval (flan-dev--text (car b) (cdr b)) "form"))) + (flan-dev--eval (flan-dev--text (car b) (cdr b)) "form" (car b) (cdr b)))) ;;;###autoload (defun flan-eval-buffer () @@ -447,7 +483,7 @@ arrive in the same load or the first refers to storage that does not exist." (defun flan-eval-region (start end) "Recompile the top-level forms between START and END." (interactive "r") - (flan-dev--eval (flan-dev--text start end) "region")) + (flan-dev--eval (flan-dev--text start end) "region" start end)) (provide 'flan-dev) ;;; flan-dev.el ends here diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 6f67a80..88728e0 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -16,6 +16,18 @@ (defvar test-flan--failures 0) +(defmacro test-flan--said (&rest body) + "Run BODY and return the last thing it put in the echo area. +`current-message' is nil under --batch, so the echo area is watched where it +is written instead — the real `message' call the real command makes." + `(let* ((said nil) + (probe (lambda (fmt &rest args) + (when fmt (setq said (apply #'format fmt args)))))) + (advice-add 'message :before probe) + (unwind-protect (progn ,@body) + (advice-remove 'message probe)) + said)) + (defun test-flan--check (name ok) (if ok (message " ok %s" name) (setq test-flan--failures (1+ test-flan--failures)) @@ -151,10 +163,35 @@ (search-forward "(+ ticks nonsense)") (replace-match "(+ ticks 41)") (search-backward "(defn step") - (flan-eval-defun) - (test-flan--check "an accepted evaluation clears it" - (null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error)) - (overlays-in (point-min) (point-max)))))) + ;; A silent success is indistinguishable from a silent failure, so an + ;; accepted evaluation says what landed in the running program and what it + ;; cost. The name comes from the *reply*: the daemon is the one that knows + ;; which names it installed. + (let ((said (test-flan--said (flan-eval-defun)))) + (test-flan--check "an accepted evaluation clears it" + (null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error)) + (overlays-in (point-min) (point-max))))) + (test-flan--check "and says which name landed" + (and said (string-match-p "\\_" said))) + (test-flan--check "and how long it took" + (and said (string-match-p "[0-9]+ ms" said))))) + + ;; A declaration the program already has installs nothing, and must say so + ;; rather than reporting a time for a build that did not happen. + (let ((said (test-flan--said + (flan-dev--eval "(defvar ticks i64)" "form")))) + (test-flan--check "an evaluation with nothing to install says so" + (and said (string-match-p "nothing to install" said) + (not (string-match-p "installed" said))))) + + ;; Many names are counted and sampled. An echo area truncated in the middle + ;; of the tenth name says neither how many there were nor which. + (test-flan--check "a long list of names is counted, not cut off" + (equal (flan-dev--names-phrase + '("a" "b" "c" "d" "e" "f") "fallback") + "6 names (a, b, c, d, …)")) + (test-flan--check "a short one is just named" + (equal (flan-dev--names-phrase '("a" "b") "fallback") "a, b")) ;; The session is not poisoned by that: a good form still lands. (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") From 7118d6106d30561fcab94dfdec9f4617cb426c6e Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 17:56:37 +0700 Subject: [PATCH 4/5] eldoc, completion and M-. off one cached reply MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit All three want the same three facts about a name — what it is, what it looks like, and where it was written — so the daemon answers all three in one `defs` reply and the client keeps the last one. `defs` is its own op rather than more fields on `describe`. `describe` is what an editor *polls*: it is how the program's output gets drained, and the existing tests ask it in loops. Signatures riding on that would be paid for every time anyone glanced at the output buffer. This is asked once on connect and again after each accepted install, which is exactly when the answer can have changed — so a `defn` typed a second ago completes. It is a cache rather than a request per keystroke because of where these are called from: eldoc fires on an idle timer and completion inside redisplay, and neither may block on a socket or signal. Three refusals rather than three guesses. A global has no location because `Tast.global` carries no `Loc`, and searching the buffer for "(defvar ticks" instead would find the wrong one in a program of several files. The prelude is a string inside the compiler, so its location names a file nobody can visit. A short name that could be several of the program's package-qualified ones is ambiguous, and picking would be a guess about which function you meant — a name that is the tail of exactly *one* is not a guess, and resolves. Functions the checker invented — a lifted handler-bind clause, which carries an `fparent` — are left out entirely: nobody wrote that name, so completing it is noise and jumping to it is meaningless. And the daemon now makes its own source path absolute before building, because every location it reports derives from it. `flan dev src/game.flan` from a project root answered `src/game.flan:12:7`, which an editor can only resolve by guessing what it was relative to. lib/dev.ml is the only compiler file touched: a `defs` op, its three list builders, and the one `realpath` in `start`. Nothing existing changed shape — `describe`, `eval` and `eval-expr` answer byte for byte what they did. --- NEXT.md | 48 +++++++++- emacs/flan-dev.el | 193 +++++++++++++++++++++++++++++++++++++++++ emacs/flan-repl.el | 4 + emacs/test-flan-dev.el | 100 +++++++++++++++++++++ lib/dev.ml | 65 ++++++++++++++ test/test_dev.ml | 40 +++++++++ 6 files changed, 448 insertions(+), 2 deletions(-) diff --git a/NEXT.md b/NEXT.md index 7d6f7e2..345fe2b 100644 --- a/NEXT.md +++ b/NEXT.md @@ -759,9 +759,26 @@ can sit on the same `Session` later; it should not have gated the editor. (:op "describe") → (:status "ok" :fns (…) :globals (…) :alive t) (:op "eval" :code "…" :file "/buf.flan") → (:status "ok" :names (…) :fns (…) :ms 19.0) → (:status "error" :message "…" :loc "/buf.flan:1:19") +(:op "defs") → (:status "ok" :defs ((name kind signature loc) …)) (:op "close") ``` +`defs` is its own op rather than more fields on `describe`, because `describe` +is what an editor *polls* — it is how the program's output is drained — and +signatures on that would be paid for every time anyone glanced at the output +buffer. It is asked once on connect and again after each accepted install. +Four strings an editor reads with `read` and nothing else: eldoc, completion +and find-definition want the same three facts about a name. `loc` is empty +where there is none to give, because only `Tast.fn` carries one — an editor +must refuse rather than go looking for the definition itself, which in a +program of several files finds the wrong one. Parameter *names* are not in the +Tast, so a signature is `step [i64 f32] i64`: types only. + +The daemon makes its own source path absolute before building, because every +location it reports derives from it. `flan dev src/game.flan` run from a +project root otherwise answered `src/game.flan:12:7`, which an editor can only +resolve by guessing which directory it was relative to. + An evaluation that declares nothing to install — a declaration the program already has, with no body and no new storage — is accepted and answered with `:note "nothing to install"` rather than by shipping an empty module. Building @@ -809,6 +826,20 @@ of the protocol choice: `prin1` writes a request and `read` reads a reply. | `C-c C-o` | the running program's own output, in `*flan-output*` | | `C-c C-r` | a prompt on the running program (`*flan-repl*`) | | `C-c C-d` | what the running program currently defines | +| `M-.` / `M-,` | where a name is written, through an `xref` backend | + +eldoc, `completion-at-point` and `M-.` all read one cached `defs` reply rather +than asking per keystroke: eldoc fires on an idle timer and completion inside +redisplay, and neither may block on a socket or signal. The cache is refreshed +at the two moments the answer can have changed — on connect, and after an +evaluation the daemon accepted — so a `defn` just installed completes at once. + +The modeline says whether there is a program on the other end, in three states. +`lost` is a daemon that has gone away, which is ordinary rather than an error — +`flan dev` ends when its program does — so the next request reconnects on the +socket it was on. Strictly *before* a send, never after one: a connection that +died mid-request may have died after the daemon ran what it was given, and +resending would install it twice or evaluate a side-effecting expression twice. `C-c C-k` sends one module rather than a form at a time on purpose: a `defvar` and the function that uses it have to arrive in the same load, or the first @@ -823,8 +854,21 @@ daemon for this reason: it is not the same claim as the daemon answering correctly, and a mistake in the framing, in `beginning-of-defun` over Flan's syntax table, or in the reply reader passes `test_dev.ml` and fails here. -An error comes back with a location and the client moves point to it when it is -this buffer. +An error comes back with a location and the client draws an overlay there, with +the message beside the code, cleared the next time that buffer's evaluation is +accepted. Two things had to be right first. **The column in a `:loc` is a byte +offset**, because the reader walks the source a byte at a time — the same rule +as the framing, in a different place, and `forward-char` with it put the marker +as many columns right as the line had non-ASCII characters before it. And the +daemon numbers lines from the start of what it was *sent*, so `C-c C-c` on a +defn halfway down a buffer answered line 1 and every overlay would have sat on +the file's first line; the client pads the form with leading newlines, which +the reader skips, so the reply's line numbers are the buffer's own. + +An accepted evaluation says which names landed and what the build cost, and +flashes the region that was sent. Silent success is indistinguishable from +silent failure, and `beginning-of-defun` may well have found a different form +from the one point looked like it was in. **The program's stdout is a pipe into the daemon**, and whatever it printed since the last reply rides along with the next one into `*flan-output*`. Having diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 2abd000..19c4b69 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -26,6 +26,9 @@ (require 'seq) (require 'pcase) (require 'pulse) +(require 'cl-lib) +(require 'xref) +(require 'eldoc) (defgroup flan-dev nil "Talking to a running Flan program." @@ -173,6 +176,9 @@ that quietly did nothing, which is why it is on." (t (condition-case err (progn (flan-dev--open flan-dev--socket) + ;; A restarted daemon is a rebuilt program: everything known + ;; about its names was about the last one. + (flan-dev--forget-defs) (message "flan dev: reconnected to %s" (abbreviate-file-name flan-dev--socket))) (error @@ -193,6 +199,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (unless socket (user-error "No %s found above this buffer" flan-dev-socket-name)) (flan-dev--open socket) (let ((r (flan-dev--request '(:op "describe")))) + (flan-dev-refresh-defs) (message "flan dev: connected to %s (%d functions, %d globals)" (abbreviate-file-name socket) (length (plist-get r :fns)) (length (plist-get r :globals)))) @@ -208,6 +215,7 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." ;; Forgotten, not kept: this was a deliberate disconnect, so the next ;; request should say so rather than quietly reopening what was just closed. (setq flan-dev--socket nil) + (flan-dev--forget-defs) (force-mode-line-update t) (message "flan dev: disconnected")) @@ -355,6 +363,188 @@ Returns non-nil when it put an overlay somewhere." (when (eq buf (current-buffer)) (goto-char beg)) t))))))) +;;; What the program defines + +;; eldoc, completion and find-definition all want the same three things about a +;; name — what it is, what it looks like, and where it was written — so the +;; daemon answers all three in one `defs' reply and this keeps the last one. +;; +;; It is a *cache* rather than a request per keystroke because of where these +;; are called from: eldoc fires on an idle timer and completion inside the +;; minibuffer's redisplay, and neither may block on a socket or signal. So +;; they read this and nothing else, and it is refreshed at the two moments the +;; answer can have changed — on connect, and after an evaluation the daemon +;; accepted. A freshly installed `defn' completes immediately; nothing else +;; can have appeared in between, because this editor is the only client. + +(defvar flan-dev--defs nil + "What the running program defines: a list of (NAME KIND SIGNATURE LOC). +LOC is the empty string where the daemon has none to give.") + +(defun flan-dev--forget-defs () + "Drop what is known about the program's names." + (setq flan-dev--defs nil)) + +(defun flan-dev-refresh-defs () + "Ask the running program what it defines, and remember it." + (interactive) + (setq flan-dev--defs (plist-get (flan-dev--request '(:op "defs")) :defs)) + (when (called-interactively-p 'interactive) + (message "flan: %d names" (length flan-dev--defs))) + flan-dev--defs) + +(defun flan-dev--lookup (name) + "The entry for NAME, or nil. + +A name is looked up exactly first. Failing that, a buffer inside a package +writes `settle' for what the program calls `sim/settle' — the alias is applied +from the file's own package, which this end does not know — so a name that is +the tail of exactly one program name resolves to it. Exactly one: several is +ambiguous and resolving it by picking would be a guess about which function +you meant." + (or (assoc name flan-dev--defs) + (let ((tail (concat "/" name))) + (let ((hits (seq-filter (lambda (d) (string-suffix-p tail (car d))) + flan-dev--defs))) + (and (= 1 (length hits)) (car hits)))))) + +(defun flan-dev--ambiguous (name) + "The entries whose name ends in NAME, when there is more than one." + (let ((hits (seq-filter (lambda (d) (string-suffix-p (concat "/" name) (car d))) + flan-dev--defs))) + (and (> (length hits) 1) hits))) + +;;; eldoc + +(defun flan-dev--enclosing-head () + "The symbol heading the innermost form point is inside, or nil." + (ignore-errors + (save-excursion + (let ((open (nth 1 (syntax-ppss)))) + (when open + (goto-char (1+ open)) + (and (looking-at "\\(?:\\sw\\|\\s_\\)+") (match-string-no-properties 0))))))) + +(defun flan-dev-eldoc-function (callback &rest _) + "Give CALLBACK the signature of the name at point, from the running program. +Falls back to the form point is inside, which is what you want while typing +its arguments. Reads the cache only: eldoc runs on a timer and must not +block on a socket or signal." + (let* ((name (or (thing-at-point 'symbol t) (flan-dev--enclosing-head))) + (d (and name (flan-dev--lookup name)))) + (when d + (funcall callback + (concat (propertize (nth 2 d) 'face 'font-lock-function-name-face) + (pcase (nth 1 d) + ("fn" "") + (k (concat " " k)))) + :thing (car d)) + t))) + +;;; Completion + +(defun flan-dev-completion-at-point () + "Complete the name at point against the running program's own names. +Nothing is offered when nothing is known — an empty table would look like +\"no such name\" rather than \"not connected\"." + (when flan-dev--defs + (let ((b (bounds-of-thing-at-point 'symbol))) + (when b + (list (car b) (cdr b) + (mapcar #'car flan-dev--defs) + :annotation-function + (lambda (n) (let ((d (assoc n flan-dev--defs))) + (and d (concat " " (nth 1 d))))) + :company-docsig + (lambda (n) (let ((d (assoc n flan-dev--defs))) (and d (nth 2 d)))) + ;; Not exclusive: dabbrev and the like still have something to + ;; say about a name the program has not been told about yet. + :exclusive 'no))))) + +;;; Finding a definition + +;; An xref backend rather than a command of its own, so M-. and M-, are what +;; they always are. Its refusals are by name: the daemon has no location for a +;; global, and the prelude is a string in the compiler rather than a file, and +;; both of those must say so instead of opening an empty buffer. + +(defun flan-dev-xref-backend () + "The xref backend for a buffer with a running Flan program behind it." + (and flan-dev--defs 'flan)) + +(cl-defmethod xref-backend-identifier-at-point ((_backend (eql flan))) + (thing-at-point 'symbol t)) + +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql flan))) + (mapcar #'car flan-dev--defs)) + +(cl-defmethod xref-backend-definitions ((_backend (eql flan)) identifier) + (let ((d (flan-dev--lookup identifier))) + (cond + ((null d) + (if-let ((hits (flan-dev--ambiguous identifier))) + (user-error "flan: %s could be %s; write the one you mean" + identifier (string-join (mapcar #'car hits) " or ")) + (user-error "flan: the running program defines no %s" identifier))) + ((equal (nth 3 d) "") + ;; Tast.global and Tast.extern carry no Loc, so there is nothing to go + ;; to. Guessing by searching for "(defvar ticks" would find the wrong + ;; one in a program of several files, which is worse than refusing. + (user-error "flan: %s is a %s, and the daemon reports no location for one" + (car d) (nth 1 d))) + (t + (let ((parts (flan-dev--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))))))))))))) + +;;; Wiring it into a buffer + +(defun flan-dev-setup () + "Give this buffer eldoc, completion and M-. against the running program. +Installed from here rather than from `flan-mode', which must keep working for +someone editing Flan with no program running and this file never loaded." + (add-hook 'completion-at-point-functions #'flan-dev-completion-at-point nil t) + (add-hook 'xref-backend-functions #'flan-dev-xref-backend nil t) + (add-hook 'eldoc-documentation-functions #'flan-dev-eldoc-function nil t) + (eldoc-mode 1)) + +(add-hook 'flan-mode-hook #'flan-dev-setup) + +;; Buffers that were already in flan-mode when this file loaded: the client is +;; autoloaded on first use, so by the time it arrives the file being edited has +;; long since had its mode hooks run. +(dolist (b (buffer-list)) + (with-current-buffer b + (when (derived-mode-p 'flan-mode) (flan-dev-setup)))) + ;;; Evaluating ;; An install that says nothing is indistinguishable from one that failed @@ -382,6 +572,9 @@ of the tenth name tells you neither how many there were nor which." (value (plist-get reply :value))) ;; Accepted, so whatever the last rejection marked is no longer true. (flan-dev-clear-errors) + ;; ...and a name that was just installed should complete, and have a + ;; signature, from this moment rather than from the next connect. + (when (or fns names) (ignore-errors (flan-dev-refresh-defs))) (when flan-dev-echo-result (cond ;; An expression's value, rendered inside the running program — diff --git a/emacs/flan-repl.el b/emacs/flan-repl.el index 340c09b..f66256a 100644 --- a/emacs/flan-repl.el +++ b/emacs/flan-repl.el @@ -56,6 +56,10 @@ (setq-local comint-input-sender #'flan-repl--send) ;; Nothing is echoed back by a process, because there is no process. (setq-local comint-process-echoes nil) + ;; The prompt gets completion, eldoc and M-. for the same names a buffer + ;; does, and against the same program: they read the client's cache, which + ;; is program-scoped, which is exactly what a prompt is. + (flan-dev-setup) (setq-local font-lock-defaults '(flan-font-lock-keywords))) (defun flan-repl--complete-p (text) diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 88728e0..cf2692c 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -193,6 +193,106 @@ is written instead — the real `message' call the real command makes." (test-flan--check "a short one is just named" (equal (flan-dev--names-phrase '("a" "b") "fallback") "a, b")) + ;; `defs' is what eldoc, completion and M-. all read. One op answering all + ;; three, cached, because eldoc fires on an idle timer and completion inside + ;; redisplay, and neither may block on a socket. + (test-flan--check "the program's names are known" + (assoc "step" flan-dev--defs)) + (test-flan--check "with a signature" + (equal (nth 2 (assoc "step" flan-dev--defs)) "step [] i64")) + (test-flan--check "a global is known, and says it is one" + (equal (nth 1 (assoc "ticks" flan-dev--defs)) "var")) + (test-flan--check "so is an imported package's extern" + (let ((d (assoc "agent/wait-raw" flan-dev--defs))) + (and d (equal (nth 1 d) "extern")))) + ;; `step' was last installed from this buffer, so that is where the daemon + ;; says it is — which is also the check that the client's line padding put it + ;; on the line it is really on rather than on line 1. + (test-flan--check "a fn carries where it is written" + (equal (nth 3 (assoc "step" flan-dev--defs)) + (format "%s:%d:7" buffer-file-name + (save-excursion + (goto-char (point-min)) + (search-forward "(defn step") + (line-number-at-pos))))) + + ;; eldoc: the signature of the name at point, and of the form point is + ;; inside, which is what you want while typing arguments. + (goto-char (point-min)) + (search-forward "(set ticks (step") + (let ((said nil)) + (test-flan--check "eldoc answers for the name at point" + (and (flan-dev-eldoc-function + (lambda (s &rest _) (setq said s))) + said (string-match-p "step \\[\\] i64" said)))) + (let ((said nil)) + (save-excursion + (goto-char (point-min)) + (search-forward "(set ticks (step)") + (backward-char 1) ; inside (step ...), not on the name + (flan-dev-eldoc-function (lambda (s &rest _) (setq said s)))) + (test-flan--check "and for the form point is inside" + (and said (string-match-p "step" said)))) + (let ((said nil)) + (with-temp-buffer + (insert "not-a-flan-name") + (flan-dev-eldoc-function (lambda (s &rest _) (setq said s)))) + (test-flan--check "and says nothing about a name the program has not got" + (null said))) + + ;; Completion: the running program's names, through `completion-at-point'. + (goto-char (point-min)) + (search-forward "(defn step") + (let* ((capf (flan-dev-completion-at-point)) + (table (nth 2 capf))) + (test-flan--check "completion offers the program's own names" + (member "step" (all-completions "ste" table))) + (test-flan--check "and the names an import brought in" + (member "agent/wait" (all-completions "agent/" table))) + (test-flan--check "and annotates each with what it is" + (equal (funcall (plist-get (nthcdr 3 capf) + :annotation-function) + "ticks") + " var"))) + + ;; M-. through xref, so it is the key it always is. + (let ((xs (xref-backend-definitions 'flan "step")) + (line (save-excursion (goto-char (point-min)) + (search-forward "(defn step") + (line-number-at-pos)))) + (test-flan--check "M-. finds where a function is written" + (and (= 1 (length xs)) + (let ((l (xref-item-location (car xs)))) + (and (file-equal-p (xref-location-group l) + buffer-file-name) + (= (xref-location-line l) line)))))) + + ;; And the two things it cannot do, refused by name with the reason rather + ;; than by opening an empty buffer. + (let ((raised nil)) + (condition-case err (xref-backend-definitions 'flan "ticks") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "M-. on a global refuses, saying why" + (and raised (string-match-p "ticks" raised) + (string-match-p "no location" raised)))) + (let ((raised nil)) + (condition-case err (xref-backend-definitions 'flan "print-line") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "M-. into the prelude refuses, saying why" + (and raised (string-match-p "prelude" raised) + (string-match-p "not a file on disk" raised)))) + (let ((raised nil)) + (condition-case err (xref-backend-definitions 'flan "no-such-name") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "and so does a name the program does not have" + (and raised (string-match-p "no no-such-name" raised)))) + + ;; A name installed now must complete now, not after the next connect. + (flan-dev--eval "(defn freshly-added [] i64 7)" "form") + (test-flan--check "a name just installed is known immediately" + (equal (nth 2 (assoc "freshly-added" flan-dev--defs)) + "freshly-added [] i64")) + ;; The session is not poisoned by that: a good form still lands. (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form") diff --git a/lib/dev.ml b/lib/dev.ml index b6ec136..7243853 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -236,6 +236,64 @@ let describe t = t.session.Session.program.Tast.globals); ":alive " ^ (if alive t then "t" else "nil") ] +(* [describe] answers what exists; this answers what each one *is*. Its own op + rather than more fields on [describe], because [describe] is polled — an + editor uses it to drain the program's output — and this is asked once on + connect and again after each install. Putting signatures on the poll would + pay for them every time anyone looked at the output buffer. + + One entry per name: (name kind signature loc). Four strings, so the editor + reads it with [read] and nothing here needs a new wire type. [loc] is empty + where there is none to give — only [Tast.fn] carries one — and an editor + that finds it empty must say so rather than guess a file. + + Parameter *names* are not in the Tast, so a signature shows types only. *) +let signature_of_fn (f : Tast.fn) = + Printf.sprintf "%s [%s] %s" f.Tast.name + (String.concat " " (List.map Types.to_string f.Tast.params)) + (Types.to_string f.Tast.ret) + +let entry ~name ~kind ~sign ~loc = + Wire.list [ Wire.quote name; Wire.quote kind; Wire.quote sign; Wire.quote loc ] + +let defs t = + let p = t.session.Session.program in + let fns = + List.filter_map + (fun (f : Tast.fn) -> + match f.Tast.fparent with + (* A handler-bind clause the checker lifted out. Nobody wrote this + name, so completing it is noise and jumping to it is meaningless. *) + | Some _ -> None + | None -> + Some + (entry ~name:f.Tast.name ~kind:"fn" ~sign:(signature_of_fn f) + ~loc:(Loc.to_string f.Tast.floc))) + p.Tast.fns + in + let globals = + List.map + (fun (g : Tast.global) -> + entry ~name:g.Tast.gname + ~kind:(if g.Tast.gconst then "const" else "var") + ~sign: + (Printf.sprintf "%s %s" g.Tast.gname (Types.to_string g.Tast.gty)) + ~loc:"") + p.Tast.globals + in + let externs = + List.map + (fun (e : Tast.extern) -> + entry ~name:e.Tast.ename ~kind:"extern" + ~sign: + (Printf.sprintf "%s [%s] %s" e.Tast.ename + (String.concat " " (List.map Types.to_string e.Tast.eparams)) + (Types.to_string e.Tast.eret)) + ~loc:"") + p.Tast.externs + in + ok [ ":defs " ^ Wire.list (fns @ globals @ externs) ] + let handle t req = match Wire.string_field req "op" with | Some "eval" -> @@ -255,6 +313,7 @@ let handle t req = eval_expr t ~code ~origin | None -> error "eval-expr needs :code") | Some "describe" -> describe t + | Some "defs" -> defs t | Some "close" -> ok [] | Some op -> error ("unknown op: " ^ op) | None -> error "no :op" @@ -286,6 +345,12 @@ let serve t fd = let start ~file ~sock = let t0 = Unix.gettimeofday () in + (* Absolute, because every location this daemon ever reports is derived from + it and an editor is not in this process's working directory. [flan dev + src/game.flan] run from a project root would otherwise send back + "src/game.flan:12:7", which the editor can only resolve by guessing which + directory it was relative to. *) + let file = try Unix.realpath file with Unix.Unix_error _ -> file in let session, l = Session.create ~file in let dir = Filename.concat (Filename.get_temp_dir_name ()) diff --git a/test/test_dev.ml b/test/test_dev.ml index 2376343..0b07b3e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -86,6 +86,46 @@ let () = let r = request c "(:op \"describe\")" in if status r <> "ok" then fail "describe: %s" (status r); + (* [defs] is its own op rather than more fields on [describe], because + [describe] is what an editor polls to drain the program's output. It + carries what eldoc, completion and find-definition each need: a kind, + a signature, and where the name is written where that is knowable. + An empty location is the honest answer for a global — Tast.global has + no Loc — and an editor is expected to refuse rather than guess. *) + let r = request c "(:op \"defs\")" in + if status r <> "ok" then fail "defs: %s" (status r); + (match Wire.field r "defs" with + | Some { Form.v = Form.List entries; _ } -> + let find name = + List.find_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List + ({ Form.v = Form.Str n; _ } + :: { Form.v = Form.Str kind; _ } + :: { Form.v = Form.Str sign; _ } + :: { Form.v = Form.Str loc; _ } :: []) + when String.equal n name -> Some (kind, sign, loc) + | _ -> None) + entries + in + (match find "step" with + | Some ("fn", "step [] i64", loc) when String.length loc > 0 -> + (* Absolute, because an editor is not in this process's working + directory and cannot resolve a relative one. *) + if loc.[0] <> '/' then fail "a fn's location is relative: %s" loc + | Some (k, s, l) -> fail "step is described as (%s, %s, %s)" k s l + | None -> fail "defs did not mention step"); + (match find "ticks" with + | Some ("var", "ticks i64", "") -> () + | Some (k, s, l) -> fail "ticks is described as (%s, %s, %s)" k s l + | None -> fail "defs did not mention ticks"); + (match find "agent/wait-raw" with + | Some ("extern", _, _) -> () + | Some (k, _, _) -> fail "an extern is described as %s" k + | None -> fail "defs did not mention an imported extern") + | _ -> fail "defs did not answer with a list"); + (* A form that does not check comes back as an error with a location, and must not disturb the session. *) let r = request c "(:op \"eval\" :code \"(defn step [] i64 nonsense)\" :file \"/tmp/buf.flan\")" in From 6f3ec2bb91b60e5c856d0aadf9fc04d545bd938d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 11 Sep 2026 17:58:34 +0700 Subject: [PATCH 5/5] Keep the indicator, eldoc and the cache to buffers that asked for them MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three things the first cut got wrong by being global when it had no business being. The modeline entry was added to `mode-line-misc-info' at load. It returns nil outside a Flan buffer, so it was invisible — but it was still evaluated on every redisplay of every buffer in the session, for someone who loads the client and then spends the afternoon in dired. It is installed buffer-locally by `flan-dev-setup' now, which already runs in exactly the buffers that want it. The `derived-mode-p' guard stays: cheap, and it keeps the function honest wherever it is called from. `flan-dev-setup' switched eldoc on. Contributing a documentation source is this file's business; whether eldoc runs at all is the user's, and turning it on overrules someone who has `global-eldoc-mode' off deliberately. It is on by default, so nearly everyone gets the same behaviour either way. And a reconnect forgot the name cache without asking for it again. An empty cache is honest but silent — eldoc goes quiet, M-. falls through to whatever else is registered, and nothing says why — until the next install happens to refill it. It refreshes straight after reconnecting, which is safe from there because the connection is live by that point and the request does not come back round through the same function. --- emacs/flan-dev.el | 22 +++++++++++++++++++--- emacs/test-flan-dev.el | 13 +++++++++++++ 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 19c4b69..51e1289 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -179,6 +179,12 @@ that quietly did nothing, which is why it is on." ;; A restarted daemon is a rebuilt program: everything known ;; about its names was about the last one. (flan-dev--forget-defs) + ;; And asked again straight away. An empty cache is honest + ;; but silent: eldoc would go quiet and M-. would fall through + ;; to some other backend until the next install happened to + ;; refill it. Safe to call from here — the connection is live + ;; by now, so it does not come back through this function. + (ignore-errors (flan-dev-refresh-defs)) (message "flan dev: reconnected to %s" (abbreviate-file-name flan-dev--socket))) (error @@ -254,8 +260,11 @@ mistake, so it is distinguished from never having connected." (_ (propertize " flan:off" 'face 'shadow 'help-echo "Not connected (C-c C-z)"))))) -;; Appended rather than prepended: this is the least urgent thing in the line. -(add-to-list 'mode-line-misc-info '(:eval (flan-dev-mode-line)) t) +;; Installed buffer-locally by `flan-dev-setup', not globally. A global entry +;; would evaluate on every redisplay of every buffer in the session — dired, +;; eshell, everything — to return nil, for someone who may never open a .flan +;; file at all. The `derived-mode-p' guard above stays anyway: cheap, and it +;; keeps the function honest wherever it is called from. ;;;###autoload (defun flan-show-output () @@ -533,8 +542,15 @@ Installed from here rather than from `flan-mode', which must keep working for someone editing Flan with no program running and this file never loaded." (add-hook 'completion-at-point-functions #'flan-dev-completion-at-point nil t) (add-hook 'xref-backend-functions #'flan-dev-xref-backend nil t) + ;; Registered, not switched on. Contributing a source is this file's + ;; business; whether eldoc runs at all is the user's, and turning it on for + ;; someone who has `global-eldoc-mode' off is overruling a decision they made + ;; on purpose. It is on by default, so this is what almost everyone gets. (add-hook 'eldoc-documentation-functions #'flan-dev-eldoc-function nil t) - (eldoc-mode 1)) + (unless (member '(:eval (flan-dev-mode-line)) mode-line-misc-info) + ;; Appended rather than prepended: the least urgent thing in the line. + (setq-local mode-line-misc-info + (append mode-line-misc-info '((:eval (flan-dev-mode-line))))))) (add-hook 'flan-mode-hook #'flan-dev-setup) diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index cf2692c..116f208 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -54,6 +54,14 @@ is written instead — the real `message' call the real command makes." (string-match-p "live" (flan-dev-mode-line)))) (test-flan--check "and says nothing in a buffer that is not Flan's" (with-temp-buffer (null (flan-dev-mode-line)))) + ;; Buffer-locally, so that someone who loads this and never opens a .flan + ;; file is not evaluating it on every redisplay of every buffer they have. + (test-flan--check "the indicator is in this buffer's modeline" + (member '(:eval (flan-dev-mode-line)) mode-line-misc-info)) + (test-flan--check "and not in everyone else's" + (with-temp-buffer + (not (member '(:eval (flan-dev-mode-line)) + mode-line-misc-info)))) ;; A daemon restarted while Emacs was not looking is the ordinary case. The ;; socket outlives this connection, so dropping the process and asking again @@ -67,6 +75,11 @@ is written instead — the real `message' call the real command makes." (test-flan--check "the next request reconnects on its own" (and (process-live-p flan-dev--connection) (member "step" (plist-get r :fns))))) + ;; ...and knows the program's names again. An empty cache after a reconnect + ;; is honest but silent: eldoc goes quiet and M-. falls through to another + ;; backend, with nothing said about why. + (test-flan--check "and knows the program's names again" + (assoc "step" flan-dev--defs)) ;; But a socket nobody is listening on is refused by name, rather than ;; retried forever or reported as some other failure.