JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The daemon pushes the program's output and the watch table to an editor that asked for them, and every key a Flan buffer's own map binds is that buffer's under Evil

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 11:16:49 +07:00
parent bf827dc55b
commit f4725788c5
14 changed files with 759 additions and 397 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
TODO.org
View File

@ -1874,13 +1874,15 @@ Open: what migration does with a stored value that no longer fits a changed
slot type, and whether an untyped slot stays legal (it should — =dyn= is a type
and writing nothing should mean it).
** NEXT println takes up to a second to appear
Decided 2026-09-25: the daemon pushes program output on the editor's connection as it is written. Rules out a faster poll.
Output is drained by =flan--poll= at =flan-poll-interval=, 1.0s
(=emacs/flan.el:541=). A reply carries whatever was buffered when it was
composed, so anything the program prints after that waits for the next tick.
Polling faster costs a request a second for nothing most of the time; the
daemon pushing on its own connection is the other shape. Decide which.
** DONE println takes up to a second to appear
CLOSED: [2026-09-25]
The daemon pushes program output on a connection that asked for pushes
(=(:op "push" :on t)=), coalesced to at most one frame per 50ms, and the
watch table on the same channel at =flan-watch-interval=. Emacs reads every
frame in a process filter. The editor's watch timer and =flan-settle-hook=
are gone. The poll stays for the stop and park edges. Rules out a faster
poll and pushes to clients that did not ask for them. See docs/BUILT.md,
"Output and the watch table are pushed".
** NEXT set writes a class slot; put is for maps
Decided 2026-09-25: as written; one lane with typed slots.
@ -1931,11 +1933,14 @@ motion states in that mode; every other key, including what =special-mode-map=
binds, stays Evil's. The other special-mode buffers (inspect, watch, doc, disassembly,
diagnostics, lower) have the same exposure and are not changed.
** NEXT Evil takes the keys in the other Flan buffers
The inspect, watch, doc, disassembly, diagnostics and lower buffers get the break
buffer's treatment: the keys each binds itself go to Evil's normal and motion
states, and every other key stays Evil's. Bindings stay as close as possible
between Evil and Emacs states.
** DONE Evil takes the keys in the other Flan buffers
CLOSED: [2026-09-25]
=flan-evil-own-keys= (flan-mode.el) gives the keys a mode's own map binds to
Evil's normal and motion states; the break, inspect, watch, doc, disassembly,
diagnostics and lower buffers all call it. The doc, disassembly and watch
maps bind =q=, and the diagnostics map binds =RET= and =q=, so those keys are
the mode's own and behave the same under Evil. Every key a mode does not bind
itself, including the rest of =special-mode-map=, stays Evil's.
** NEXT Eval in the frame, from the break loop
Decided 2026-09-25: SLIME's eval-in-frame, as described.

72
docs/BUILT.md
View File

@ -2225,8 +2225,8 @@ So the state is learned **twice, deliberately**:
or `:stopped nil`. The likeliest instant for a program to stop is the one just after an evaluation — a body that now
errors — and that is a reply the client is already reading. Finding out a second later from a poll would mean finding
out *after* the echo area had said the evaluation was fine.
- **And a timer asks anyway**, once a second, with `describe` — the cheap op, which is also how the output pipe is
drained. A program that stops in a frame of its own game loop produces no reply at all, and folding state into replies
- **And a timer asks anyway**, once a second, with `describe` — the cheap op. (It used to be how the program's output
reached the editor as well; output is pushed now, below.) A program that stops in a frame of its own game loop produces no reply at all, and folding state into replies
that never come says nothing. The timer never *reconnects*: `flan--request` reopens a socket a restarted daemon left
behind, which is right for something a person did and wrong for a background poll, because it would quietly erase the
`lost` state that exists to be seen. It also skips while another request is in flight — `accept-process-output` runs
@ -2279,6 +2279,50 @@ state an editor has to cope with and the hardest one to arrange later. The Emacs
round, by installing a `step` that errors into a loop that calls it, fixes it while stopped, and then resumes: `C-x C-e`
answering while the program sits in the break loop is checked there against the real client, not only in OCaml.
### Output and the watch table are pushed
A `println` used to reach Emacs on the next reply, and when nobody was evaluating, the next reply was the one-second
poll's. Polling faster pays a request a second for nothing most of the time, so the daemon writes to the editor's
connection unasked instead.
`(:op "push" :on t)` turns it on for the connection that sends it; `flan--open` sends it on every connect. From then
on `serve` waits in `select` on the connection, the program's stdout pipe, and the next push's deadline, and sends two
kinds of frame without being asked:
```
(:push "output" :status "ok" :output "HELLO\n")
(:push "watch" :status "ok" :watch (("ticks" "412")) :overflow nil)
```
**Opt-in, because a client that does not know about pushes would read one as its reply.** `test_dev.ml` and every
other raw-socket client keep the one-reply-per-request protocol and never see a push frame.
**Output is coalesced on the daemon side.** The first bytes after a quiet spell wait 10ms for more, and no two output
pushes are closer than 50ms. A program printing every frame is twenty frames a second on the socket, not sixty or two
hundred, and a single line still arrives within 50ms. `capacity` still bounds what is buffered.
**A push never lands inside a reply.** `serve` is one thread, so nothing is pushed while a request is handled; what
the program prints meanwhile stays in `t.out`, `with_output` puts it on that request's reply and empties the buffer,
and it is not pushed a second time. The stdout pipe is also drained now while an editor sits idle, which it was not:
`Wire.recv` blocked, so an attached, quiet editor let the pipe fill until its next request. A push goes out only when
the socket is writable; an editor that has stopped reading holds pushes back rather than stalling the loop, and its
output waits in `t.out`.
**The watch table moved onto the same channel.** `watch-enable` with `:interval` arms a push of the table from the
same loop, sent every interval whether or not it changed, because ghost text is repainted from each one. The editor's watch timer, its in-flight flag and
`flan-settle-hook` — which existed only so the timer's unawaited reply could not be read by another request — are
gone, because nothing in Emacs sends without waiting any more. Whether a push resets the numeric window is decided
where the table is read: not while the program is stopped (see the accumulator section below).
**In Emacs a process filter reads every frame as it arrives.** A push is handled there — output into the daemon's
buffer and the REPL, the watch table through `flan-push-functions` — and a reply is queued on the process for
`flan--read-reply`. A reply at the head of the buffer with a push behind it is the case that needs the queue: leaving
replies in the buffer for the reader would hold the push behind them until the next request. A frame is recognised as
a push by its text beginning `(:push `, before it is read, so an unreadable push is dropped with a message rather than
queued as some request's error.
The poll stays, for the stop and park edges.
### `layout` — a type's fields, with no program involved
```
@ -6029,11 +6073,10 @@ name in the table came from one of these call sites by construction — and the
`syntax-ppss`) is what stops a call *written inside a string* being taken for one.
**One reply, two pictures.** Ghost text does not poll. It is painted from `flan-watch--absorb`, the same function
that paints the buffer, from the same reply, so the two cannot disagree and there is no second `:op "watch"` in
flight — the one-request invariant `flan-settle-hook` exists to keep. What had to change is that the **watch
buffer used to be the subscription**: killing it cancelled the timer and disarmed the table. That was right while it
was the only consumer and wrong the moment it was not, so arming and the timer now hang off
`flan-watch--consumers`, and only the last consumer out turns the lights off.
that paints the buffer, from the same push, so the two cannot disagree. What had to change is that the **watch
buffer used to be the subscription**: killing it disarmed the table. That was right while it was the only consumer and
wrong the moment it was not, so arming hangs off `flan-watch--consumers`, and only the last consumer out turns the
lights off.
**Overlays are replaced wholesale on every repaint**, never followed through edits. That is the entire answer to the
invalidation problem the earlier note called the work: a line that moved cannot strand an overlay, because no overlay
@ -6113,9 +6156,10 @@ the counter check.
cumulative until `reset-spies!` is called by hand. Cumulative is the wrong default for a frame loop: a `min` and a
`max` over a whole session reach the session's extremes within a few seconds of play and then never move again, so
the two most useful of the five go dead exactly when you start interacting with the thing you are debugging. This
tool exists to show you a number while you drag the mouse. So `flan-watch--tick` sends `:reset t` beside its read and
the displayed range is "since you last looked" — a fifth of a second, a dozen frames. A caller that wants the
cumulative numbers gets them by not resetting; the setting lives in the editor, not in the runtime.
tool exists to show you a number while you drag the mouse. So each push of the table resets after its read and the
displayed range is "since you last looked" — a fifth of a second, a dozen frames. A caller of the `watch` op that
wants the cumulative numbers gets them by not passing `:reset t`; the policy lives in the daemon's push, not in the
runtime.
**Reset is its own message, and it is not a side effect of reading.** A destructive read was the tempting shape and
is wrong: it makes *looking* change what is there, so anything that polls — a test's `await`, a second editor, a
@ -6137,10 +6181,10 @@ empty — which would make a reset visible in the very next tick instead of in t
sample. It is the wrong trade, because **a stopped program does not sample**. An epoch-aware reader would blank the
watch for as long as the program sat in a break loop, and reading the numbers from the moment you stopped is the
entire point of stopping. The lazy clear gives exactly the right answer there. What was actually wrong was narrower
and lives in the editor: `flan-watch--tick` was sending `:reset t` five times a second at a program that could not
answer it. So the reset is now guarded on `flan--stopped` — the read still goes out every tick, only the reset
field drops — and the runtime is untouched. That keeps the policy where the rest of this section already put it:
"since you last looked" is the editor's idea, not the table's. `watch_render_num`'s unreachable `n=0` arm is deleted
and was a reset sent five times a second at a program that could not answer it. So the reset is guarded on the
program being stopped — the table is still read and pushed, only the reset is skipped — and the runtime is untouched.
The guard was the editor's while the editor polled the table; it is `push_due`'s in `dev.ml` now that the daemon
pushes it, asked of the program with `status` at each push. `watch_render_num`'s unreachable `n=0` arm is deleted
rather than commented, since the only way to reach it is the epoch check that was just rejected, and dead code is an
invitation to add one.

17
emacs/MANUAL.md
View File

@ -291,8 +291,10 @@ that is what the program calls it.
form rides along on the reply and is inserted above the prompt — output
first, then the value, the way a terminal REPL reads. When a compile fails
the prompt gets one line, `1 error — see *flan-diagnostics*`, and the message
itself is in that buffer, which pops up. The daemon's buffer `*flan*` mirrors
all program output, so a println is never lost when no prompt is open.
itself is in that buffer, which pops up. What the program prints on its own,
between evaluations, is sent by the daemon as it is printed and appears at
once. The daemon's buffer `*flan*` mirrors all program output, so a println is
never lost when no prompt is open.
**Two clears.** `C-c C-o` removes what the last send produced — output, value
or error line — and leaves the transcript. `C-c M-o` erases the transcript
@ -744,9 +746,9 @@ The slot renders as `n=… min=… max=… last=… mean=…`, one line per
Two entry points rather than one so a program need not cast at the call site.
The write path does **no formatting** — a sample is a load, five compares and
the slot's seqlock — and the listener thread renders once per editor tick, which
the slot's seqlock — and the listener thread renders once per repaint, which
is the whole reason this exists rather than a second `watch-i64`. **The window is
since the editor's last tick**, not since the program started: a min and a max
since the last repaint**, not since the program started: a min and a max
over a whole session reach the session's extremes within seconds and then never
move again, so the two most useful of the five would go dead exactly when you
start playing. A whole number prints as one, because a spy on an array index
@ -792,11 +794,12 @@ your own entry points to names that do not start with `watch`, set
`flan-watch-ghost-call-regexp` — the Flan name is yours, and only the C symbol
behind it is fixed.
**When it updates.** On the same timer as the buffer, from the same reply, so
the two cannot disagree. As with the buffer, the interval decides how often the
**When it updates.** Each time the daemon sends the table, from the same frame
as the buffer, so the two cannot disagree. As with the buffer, the interval decides how often the
picture is repainted and not how fresh it is. Overlays are replaced wholesale
each repaint rather than followed through your edits, so a line you moved never
leaves one stranded, and a file you scroll to gets its values within a tick.
leaves one stranded, and a file you scroll to gets its values at the next
repaint.
Only buffers **shown in a window** are scanned, which is what keeps that cheap.
**One name, two call sites.** Both show it, and both say `one slot, 2 sites`.

20
emacs/flan-cnr.el
View File

@ -64,6 +64,7 @@
(require 'seq)
(require 'subr-x)
(require 'flan-mode)
(declare-function flan--request "flan" (form))
(declare-function flan-visit-loc "flan" (loc subject))
@ -832,22 +833,9 @@ anyone who would rather TAB always moved."
"Keys in `flan-cnr-mode'.")
;; Evil's normal state binds 0, the other digits and RET above any major
;; mode's map, so under Evil a digit moved point or started a count and took
;; nothing. The keys this file binds are given to Evil's normal and motion
;; states in this mode. Only those keys: `flan-cnr-mode-map' inherits
;; `special-mode-map', and making it an overriding map would carry h, SPC, <
;; and - over from there as well. Every key not listed stays Evil's.
(with-eval-after-load 'evil
(when (fboundp 'evil-define-key*)
;; Collected first, and without the parent's bindings, because
;; `evil-define-key*' writes into the map being walked.
(let ((own nil))
(map-keymap-internal (lambda (key def)
(when (commandp def) (push (cons key def) own)))
flan-cnr-mode-map)
(dolist (b own)
(evil-define-key* '(normal motion) flan-cnr-mode-map
(vector (car b)) (cdr b))))))
;; mode's map, so under Evil a digit would move point or start a count and
;; take nothing. See `flan-evil-own-keys'.
(flan-evil-own-keys 'flan-cnr-mode-map)
(define-derived-mode flan-cnr-mode special-mode "flan-break"
"What a stopped Flan program is offering."

3
emacs/flan-inspect.el
View File

@ -99,6 +99,7 @@
(require 'cl-lib)
(require 'seq)
(require 'subr-x)
(require 'flan-mode)
(declare-function flan--request "flan" (form))
@ -1280,6 +1281,8 @@ the kind of thing nobody reports and everybody notices."
map)
"Keys in `flan-inspect-mode'.")
(flan-evil-own-keys 'flan-inspect-mode-map)
(define-derived-mode flan-inspect-mode special-mode "flan-inspect"
"Look at a value in the running Flan program."
(setq buffer-read-only t)

2
emacs/flan-lower.el
View File

@ -571,6 +571,8 @@ that is felt."
map)
"Keys in `flan-lower-mode'.")
(flan-evil-own-keys 'flan-lower-mode-map)
(define-derived-mode flan-lower-mode special-mode "flan-lower"
"Every lowering of one Flan function, in foldable sections.

33
emacs/flan-mode.el
View File

@ -776,5 +776,38 @@ decision to `calculate-lisp-indent'."
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.flan\\'" . flan-mode))
;;; The other Flan buffers under Evil
;; Evil's normal state binds most single keys — the digits, RET, TAB, n, p, q,
;; g — above any major mode's map, so in a buffer of Flan's own a key its mode
;; binds would move point, start a count or record a macro instead. Each such
;; buffer's mode gives the keys its own map binds to Evil's normal and motion
;; states, so they do the same thing under Evil as without it. Only those
;; keys: the maps inherit `special-mode-map', and making one an overriding map
;; would carry h, SPC, < and - over from there as well. Every key a mode does
;; not bind itself stays Evil's.
(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings))
(defun flan-evil-own-keys (name)
"Give the keys the map named NAME binds itself to Evil's states.
Normal and motion. Takes effect when Evil is loaded, or at once if it
already is.
The map is passed by name because `eval-after-load' drops a function
`equal' to one it already holds, and two maps with the same bindings are
`equal': given the maps, only the first of them would be set up."
(with-eval-after-load 'evil
(when (fboundp 'evil-define-key*)
;; Collected first, and without the parent's bindings, because
;; `evil-define-key*' writes into the map being walked.
(let ((map (symbol-value name))
(own nil))
(map-keymap-internal (lambda (key def)
(when (commandp def) (push (cons key def) own)))
map)
(dolist (b own)
(evil-define-key* '(normal motion) map (vector (car b)) (cdr b)))))))
(provide 'flan-mode)
;;; flan-mode.el ends here

208
emacs/flan-watch.el
View File

@ -47,20 +47,20 @@
;; halves are cheap for opposite reasons, and two things fall out that a poll
;; could not have given:
;;
;; the values update at *frame rate* rather than at the timer's rate — the
;; timer only decides how often the picture is repainted, not how fresh it
;; is;
;; the values update at *frame rate* rather than at the repaint rate — the
;; interval only decides how often the picture is repainted, not how fresh
;; it is;
;;
;; and the last frame's values are still there while the program is
;; *stopped*. A break loop is precisely when no thunk can run at a frame
;; boundary, because there are no more frames, and precisely when you want to
;; see what the last one held.
;;
;; Also kept from the original, and for its stated reasons: the request is
;; **async**, because a synchronous call on a timer blocks Emacs's UI every
;; tick; and the paint is `replace-buffer-contents' rather than erase-and-
;; insert, because it diffs, so point and scroll survive a repaint instead of
;; being yanked to the top five times a second.
;; The daemon reads the table and sends it on the editor's connection, as it
;; sends the program's output, so Emacs never waits on a timer for it. The
;; paint is `replace-buffer-contents' rather than erase-and-insert, because it
;; diffs, so point and scroll survive a repaint instead of being yanked to the
;; top five times a second.
;;
;; What a program writes:
;;
@ -92,19 +92,17 @@
"Seconds between repaints.
This is the *repaint* rate, not the watch rate. The program writes its values
every frame whatever this is; all this decides is how often the picture is
refreshed, which is why a slow value here costs freshness and nothing else."
every frame whatever this is; all this decides is how often the daemon sends
the table, which is why a slow value here costs freshness and nothing else.
Taken when the table is armed, so a change applies from the next `flan-watch'."
:type 'number)
(defvar flan-watch--timer nil)
(defvar flan-watch--pending nil
"Non-nil while a watch request is out and its reply has not been read.")
(defvar flan-watch--rows nil
"The last table painted, as a list of (NAME . VALUE).")
(defvar flan-watch--consumers nil
"Which pictures of the table are currently wanted: `buffer', `ghost', or both.
There is one table, one arming message and one timer, and more than one way to
There is one table, one arming message and one push, and more than one way to
look at what they produce. Holding the subscription here rather than in the
watch buffer is what lets ghost text outlive that buffer being closed — the
original design made the buffer *be* the subscription, which was right when it
@ -183,12 +181,11 @@ was the only consumer and wrong the moment it was not.")
;; the string literal and not the head is what makes that safe: a name in the
;; table came from one of these call sites by construction.
;;
;; WHEN IT UPDATES. On the same timer, from the same reply. The two pictures
;; therefore cannot disagree — they are one table read, painted twice — and
;; there is no second `:op "watch"' in flight, which is the invariant
;; `flan-settle-hook' exists to keep. As with the buffer, the timer decides
;; how often the picture is repainted and not how fresh it is: the program
;; writes every frame regardless.
;; WHEN IT UPDATES. On the same push, from the same frame. The two pictures
;; therefore cannot disagree — they are one table read, painted twice. As
;; with the buffer, the push interval decides how often the picture is
;; repainted and not how fresh it is: the program writes every frame
;; regardless.
;;
;; Overlays are deleted and re-placed from scratch on every repaint rather than
;; being tracked across edits. That is the whole answer to the invalidation
@ -335,10 +332,10 @@ Guarded on the row's length so a short name cannot be claimed by accident."
(overlay-put ov 'flan-watch-ghost t)
(push ov flan-watch--ghost-overlays))))))))))
;;; The tick
;;; The push
(defun flan-watch--absorb (reply)
"Paint REPLY, a watch answer from the daemon."
"Paint REPLY, a watch table from the daemon."
(pcase (plist-get reply :status)
("ok"
(setq flan-watch--rows
@ -357,94 +354,72 @@ Guarded on the row's length so a short name cannot be claimed by accident."
(flan-watch--paint
(format "error:\n%s\n" (or (plist-get reply :message) "refused"))))))
(defun flan-watch--settle ()
"Collect an outstanding watch reply, blocking if it has not arrived.
;; The daemon sends the table on the connection every `flan-watch-interval'
;; while it is armed and has changed, the same way it sends the program's
;; output. Nothing here sends a request on a timer, so nothing here can leave
;; a reply in flight for another request to read.
;;
;; Each push closes the numeric slots' accumulation window, so their count,
;; range and mean are "since the last push" rather than since the program
;; started — except while the program is stopped, when the window is left open
;; and the numbers from the moment it stopped stay on the screen. The daemon
;; decides that, since it knows whether the program is stopped when it reads
;; the table.
Hung on `flan-settle-hook', so an ordinary request never reads the watch
timer's reply as its own. Blocking here is fine and blocking in the tick is
not: this runs inside something a person asked for, which already waits, and
what it waits for is a table read with nothing compiled behind it."
(when flan-watch--pending
(setq flan-watch--pending nil)
(when-let* ((proc flan--connection))
(when (process-live-p proc)
(ignore-errors (flan-watch--absorb (flan--read-reply proc)))))))
(defun flan-watch--on-push (kind frame)
"Paint FRAME when KIND says it is the watch table."
(when (and (equal kind "watch") flan-watch--consumers)
(flan-watch--absorb frame)))
(defun flan-watch--tick ()
"Collect the last reply if it has come, then ask again. Never blocks.
(defun flan-watch--on-connect ()
"Arm the table again on a new connection, if anything is watching.
A restarted daemon has a new program, and the new program's table is off."
(when flan-watch--consumers
(let ((r (ignore-errors (flan-watch--arm t))))
(unless (equal (plist-get r :status) "ok")
(flan-watch--paint
(format "error:\n%s\n"
(or (plist-get r :message) "the table could not be armed")))))))
Deliberately not `flan--request', which waits for its answer: a
synchronous call on a 0.2s timer stalls Emacs's UI every tick, and a timer is
the one caller that must not. So this takes whatever has already arrived and
sends the next question, leaving at most one request in flight — the invariant
`flan-settle-hook' exists to keep."
(cond
;; Killing the buffer cancels the buffer's half of the subscription, and
;; only that. When it was the only consumer this stops the timer and
;; disarms the table, so a program nobody is watching is back to paying a
;; load and a branch per watch call; when ghost text is also on, the table
;; stays armed and the ticks carry on feeding it.
((and (memq 'buffer flan-watch--consumers)
(not (get-buffer flan-watch-buffer)))
(flan-watch--drop 'buffer))
((not (process-live-p flan--connection))
(flan-watch--paint "error:\nnot connected to a running program\n")
(flan-watch-stop))
;; Something else owns the connection this instant — an evaluation is
;; mid-flight. Skipping is right: its `flan-settle-hook' has already
;; taken any reply of ours, and the next tick is 0.2s away.
(flan--busy nil)
(t
(when flan-watch--pending
;; Taken off the connection either way. `flan--extract-reply'
;; deletes a frame before it reads it, so a payload that will not read
;; has still been consumed — and a pending flag left standing after it
;; would wait for ever for a reply that is no longer in the buffer,
;; which stops the timer sending anything again. One bad reply costs
;; one tick, not the session.
(when-let* ((reply (condition-case nil
(flan--take-reply flan--connection)
(error (setq flan-watch--pending nil) nil))))
(setq flan-watch--pending nil)
(flan-watch--absorb reply)))
(unless flan-watch--pending
(condition-case nil
;; `:reset t' opens a new accumulation window for the numeric
;; slots, so their count, range and mean are "since the last tick"
;; rather than since the program started. That is the whole of the
;; accumulator decision as the editor sees it: a min and a max over
;; a session go dead within seconds of play, and this tool exists to
;; show a number while you drag the mouse. The reset happens after
;; the read, on the daemon's side, so this tick's numbers are the
;; last tick's window and nothing is lost between the two.
;;
;; Except while the program is stopped, when the read still happens
;; and the reset does not. A stopped program takes no samples, so
;; there is no window for a reset to close and none for it to open:
;; the runtime clears a slot lazily, on its next sample, which is
;; what keeps a paused program showing the numbers from the moment
;; you paused it — the whole reason to pause. Resetting anyway
;; would ask for a new window five times a second that nothing can
;; fill. The guard lives here rather than in the runtime because
;; "since you last looked" is the editor's policy, not the table's.
;; `flan--stopped' is the one place that state is tracked, and
;; `flan.el''s background poll keeps it current whether or not
;; anyone is evaluating.
(progn (flan--send flan--connection
(if flan--stopped
'(:op "watch")
'(:op "watch" :reset t)))
(setq flan-watch--pending t))
(error (flan-watch-stop)))))))
(defun flan-watch--on-disconnect ()
"Say that the table is no longer live."
(when flan-watch--consumers
(flan-watch--ghost-clear)
(flan-watch--paint "error:\nnot connected to a running program\n")))
(defun flan-watch--arm (on)
"Ask the daemon to arm the table and push it, or to disarm it when ON is nil."
(flan--request (if on
`(:op "watch-enable" :on t :interval ,flan-watch-interval)
'(:op "watch-enable" :on nil))))
;;; Commands
(defvar flan-watch-mode-map
(let ((map (make-sparse-keymap)))
;; As `flan-doc-mode-map'.
(define-key map "q" #'quit-window)
map)
"Keys in `flan-watch-mode'.")
(flan-evil-own-keys 'flan-watch-mode-map)
(define-derived-mode flan-watch-mode special-mode "flan-watch"
"Major mode for the pinned watch buffer."
(setq-local truncate-lines t))
(setq-local truncate-lines t)
;; Killing the buffer cancels the buffer's half of the subscription, and only
;; that. When it was the only consumer the table is disarmed, so a program
;; nobody is watching is back to paying a load and a branch per watch call;
;; when ghost text is also on, the table stays armed.
(add-hook 'kill-buffer-hook #'flan-watch--buffer-killed nil t))
(defun flan-watch--buffer-killed ()
"Drop the buffer consumer, the watch buffer being killed."
(when (memq 'buffer flan-watch--consumers)
(flan-watch--drop 'buffer)))
(defun flan-watch--subscribe (consumer)
"Arm the table for CONSUMER and make sure the shared timer is running.
"Arm the table for CONSUMER.
Arming is a message, not something the daemon infers. The program is the
writer, so it has to be told somebody is looking — and while nobody is, nothing
@ -453,15 +428,14 @@ debugging a load and a not-taken branch. It is sent once for the first
consumer: two of them looking at one table is still one table."
(flan--live-connection)
(unless flan-watch--consumers
(let ((r (flan--request '(:op "watch-enable" :on t))))
(let ((r (flan-watch--arm t)))
(unless (equal (plist-get r :status) "ok")
(user-error "flan: %s" (or (plist-get r :message) "watch refused")))))
(unless (memq consumer flan-watch--consumers)
(push consumer flan-watch--consumers))
(add-hook 'flan-settle-hook #'flan-watch--settle)
(when flan-watch--timer (cancel-timer flan-watch--timer))
(setq flan-watch--timer
(run-with-timer 0 flan-watch-interval #'flan-watch--tick)))
(add-hook 'flan-push-functions #'flan-watch--on-push)
(add-hook 'flan-connected-hook #'flan-watch--on-connect)
(add-hook 'flan-disconnected-hook #'flan-watch--on-disconnect))
(defun flan-watch--drop (consumer)
"Stop painting CONSUMER, and tear everything down if it was the last one."
@ -476,7 +450,7 @@ consumer: two of them looking at one table is still one table."
(flan-watch--subscribe 'buffer)
(with-current-buffer (get-buffer-create flan-watch-buffer)
(unless (eq major-mode 'flan-watch-mode) (flan-watch-mode)))
;; Painted before the first reply, rather than left blank until one arrives.
;; Painted before the first push, rather than left blank until one arrives.
;; An empty buffer is the same picture as a broken one, and the likeliest
;; reason for it here is the honest one — the program is not calling into the
;; table — which is worth saying in words rather than by showing nothing.
@ -510,21 +484,15 @@ Tears down both consumers. `flan-watch--drop' is the way to stop one of them."
;; `flan-watch--drop' and back into here.
(setq flan-watch-ghost-mode nil)
(flan-watch--ghost-clear)
(when flan-watch--timer
(cancel-timer flan-watch--timer)
(setq flan-watch--timer nil))
;; Settle before disarming, or the disarm request reads the tick's reply.
(flan-watch--settle)
(remove-hook 'flan-settle-hook #'flan-watch--settle)
;; Only on a connection that is already live, and this is the important half.
;; `flan--request' *reconnects* — which is right for something a person
;; did and wrong here, because this is also called from the tick, and the
;; reason the tick calls it is that the connection has gone. Reconnecting
;; from a timer would quietly erase the `lost' state that exists to be seen,
;; which `flan.el' already forbids for its own poll timer. And there is
;; nothing to disarm anyway: the table went with the program.
(remove-hook 'flan-push-functions #'flan-watch--on-push)
(remove-hook 'flan-connected-hook #'flan-watch--on-connect)
(remove-hook 'flan-disconnected-hook #'flan-watch--on-disconnect)
;; Only on a connection that is already live. `flan--request' reconnects,
;; which is right for something a person did and wrong here: there is
;; nothing to disarm when the connection has gone, because the table went
;; with the program.
(when (process-live-p flan--connection)
(ignore-errors (flan--request '(:op "watch-enable" :on nil)))))
(ignore-errors (flan-watch--arm nil))))
;;; What ghost text still cannot show

265
emacs/flan.el
View File

@ -244,44 +244,96 @@ to."
'utf-8 t)))
(process-send-string proc (format "%d\n%s" (length payload) payload))))
(defun flan--take-reply (proc)
"Read one complete framed message out of PROC's buffer, or return nil.
;; Two kinds of frame arrive on the connection. A reply answers the request
;; that is waiting for it. A push is sent without being asked for — the
;; program's output as it is printed, and the watch table while one is armed —
;; and is marked `:push' with its kind. The daemon sends pushes only to a
;; connection that asked for them (`flan--open' does), and never in the middle
;; of a reply.
;;
;; The process filter takes every complete frame off the head of the buffer as
;; it arrives: a push is handled there and then, which is what puts a
;; `println' on the screen as it happens, and a reply is queued on the process
;; for `flan--read-reply' to collect. The reader runs the same collection
;; itself before it looks, so frames that reached the buffer by some other way
;; than the filter are read the same.
Never waits. This is the half of `flan--read-reply' that does not block,
split out for the watch timer: a timer that called `accept-process-output'
would stall the UI every tick, which is exactly the mistake the Clojure
original left a comment about. See `flan-watch--tick'."
(defvar flan-push-functions nil
"Functions called with each push from the daemon other than output.
Each is called with two arguments, the kind as a string (\"watch\") and the
frame as a plist. Output is handled by `flan--append-output' directly.")
(defun flan--dispatch-push (frame)
"Handle FRAME, a push from the daemon.
Errors are reported and go no further: this runs inside a process filter,
where an error would stop the frames behind it from being read."
(with-demoted-errors "flan: a push from the daemon failed: %S"
(let ((kind (plist-get frame :push)))
(if (equal kind "output")
(flan--append-output (plist-get frame :output))
(run-hook-with-args 'flan-push-functions kind frame)))))
(defun flan--collect (proc)
"Take every complete frame off the head of PROC's buffer.
A push is dispatched; a reply is queued for `flan--take-reply'. A reply that
will not read is queued as its error, so the request that asked for it is the
one that signals."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(when (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
(let* ((n (string-to-number (match-string 1)))
(body-start (point)))
;; Present in full, or not yet — a partial body is not an error here,
;; it is the ordinary state between the send and the reply.
(when (>= (- (position-bytes (point-max)) (position-bytes body-start)) n)
(flan--extract-reply body-start n)))))))
(let (frame)
(while (setq frame (progn (goto-char (point-min))
(flan--next-frame)))
(let ((text (car frame)))
(if (string-prefix-p "(:push " text)
(condition-case nil
(flan--dispatch-push (car (read-from-string text)))
;; An unreadable push is a daemon bug, and it answers
;; nobody's request, so nothing is queued for it.
(error (message "flan: an unreadable push from the daemon was dropped")))
(process-put proc 'flan-replies
(append (process-get proc 'flan-replies)
(list (condition-case err
(cons 'ok (car (read-from-string text)))
(error (cons 'bad err)))))))))))))
(defun flan--extract-reply (body-start n)
"Read the N bytes at BODY-START as a reply and delete the frame.
Point is in the process buffer, and the frame is known to be complete.
(defun flan--next-frame ()
"Remove the complete frame at point-min and return (TEXT), or return nil.
Point is in a process buffer. The frame is deleted before anything reads it,
so a payload that will not read is consumed once rather than read again by
every request after it."
(when (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
(let* ((n (string-to-number (match-string 1)))
(body-start (point)))
;; Present in full, or not yet — a partial body is the ordinary state
;; between the first packet of a frame and its last.
(when (>= (- (position-bytes (point-max)) (position-bytes body-start)) n)
(let* ((end (byte-to-position (+ (position-bytes body-start) n)))
(text (decode-coding-string
(encode-coding-string (buffer-substring-no-properties
body-start end)
'utf-8 t)
'utf-8)))
(delete-region (point-min) end)
(list text))))))
The frame is deleted *before* it is read, which is the whole of the ordering
and the only reason this is worth a comment. A payload that will not read is
a bug at the other end, and the client's job is to report it once: reading
first would leave those bytes at the head of the buffer, so the next request
would read the same unreadable frame again, and every request after that —
one bad reply and the connection is wedged until Emacs is restarted.
Consuming it first costs the reply, which was lost anyway, and leaves the
stream in step for the request that follows."
(let* ((end (byte-to-position (+ (position-bytes body-start) n)))
(text (decode-coding-string
(encode-coding-string (buffer-substring-no-properties
body-start end)
'utf-8 t)
'utf-8)))
(delete-region (point-min) end)
(car (read-from-string text))))
(defun flan--filter (proc string)
"Append STRING to PROC's buffer and take off whatever frames are complete."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-max))
(insert string))
(flan--collect proc)))
(defun flan--take-reply (proc)
"The next reply PROC has sent, or nil if none has arrived. Never waits.
A reply that would not read signals here, having already been consumed."
(flan--collect proc)
(let ((q (process-get proc 'flan-replies)))
(when q
(process-put proc 'flan-replies (cdr q))
(pcase (car q)
(`(ok . ,reply) reply)
(`(bad . ,err) (signal (car err) (cdr err)))))))
(defun flan--no-reply (proc)
"Signal that PROC has not answered, saying which of the two silences it is.
@ -306,41 +358,33 @@ Reconnecting happens before a send, never after one."
(abbreviate-file-name (or flan--socket "?")))))
(defun flan--read-reply (proc)
"Block until PROC sends one complete framed message, and read it."
(with-current-buffer (process-buffer proc)
(let ((deadline (+ (float-time) flan-reply-timeout)))
;; The header first: digits up to a newline.
(while (and (not (save-excursion (goto-char (point-min))
(re-search-forward "\\`\\([0-9]+\\)\n" nil t)))
(< (float-time) deadline))
(accept-process-output proc 0.05))
(goto-char (point-min))
;; Nothing is erased here, and that is the difference between the two
;; deadlines. A header that has not arrived in full is a valid prefix
;; of a reply still on its way — throwing it away would turn a daemon
;; that is merely slow into a stream out of step by however much of the
;; count had landed.
(unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
(flan--no-reply proc))
(let* ((n (string-to-number (match-string 1)))
(body-start (point)))
(while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n)
(< (float-time) deadline))
(accept-process-output proc 0.05))
(if (>= (- (position-bytes (point-max)) (position-bytes body-start)) n)
(flan--extract-reply body-start n)
;; The body never came, so the count at the head of the buffer is a
;; promise about bytes that will never be made good: reading on from
;; here would take the *next* reply's header as this one's payload
;; and every request after it would be answered by the one before.
;; The frame is dead — drop it, and the connection is in step again
;; for whatever a person does next. Testing the condition again
;; rather than trusting the loop is the whole fix: falling through
;; to `flan--extract-reply' with a short buffer signals a
;; wrong-type error from `byte-to-position', which says nothing
;; about a timeout to whoever reads it.
(erase-buffer)
(flan--no-reply proc))))))
"Block until PROC sends a reply, and return it.
Pushes that arrive first are handled as they come."
(let ((deadline (+ (float-time) flan-reply-timeout))
(got nil) (reply nil))
(while (and (not got) (< (float-time) deadline))
(if (process-get proc 'flan-replies)
(setq reply (flan--take-reply proc) got t)
(flan--collect proc)
(unless (process-get proc 'flan-replies)
(accept-process-output proc 0.05))))
(unless got
(setq got (and (process-get proc 'flan-replies) t))
(when got (setq reply (flan--take-reply proc))))
(unless got
;; A header whose body never came is a promise about bytes that will
;; never be made good: reading on from here would take the *next*
;; reply's header as this one's payload, and every request after it
;; would be answered by the one before. The frame is dead, so it is
;; dropped. A header that has not arrived in full is left, being a
;; valid prefix of a frame still on its way.
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(goto-char (point-min))
(when (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
(erase-buffer))))
(flan--no-reply proc))
reply))
;; Written by `flan--append-output' when a REPL is open; defined in
;; flan-repl.el, which requires this file, so the reference here has to be a
@ -496,24 +540,6 @@ with it, and a rejected evaluation is a likely moment to *become* stopped."
(run-at-time 0 nil #'flan--auto-break))))
reply)
(defvar flan-settle-hook nil
"Run before anything is sent, against the connection as it stands.
The protocol is one reply per request on one connection, and that is the whole
reason this exists. Anything that sends without waiting — the watch timer is
the only such thing — leaves a reply in flight that the *next* request would
otherwise read as its own. So a sender-in-flight hangs a function here that
collects its own reply first, and the invariant holds: exactly one request
outstanding, and every reply consumed by whoever asked for it.
Before the connection is checked, not after, and that ordering is the point.
An outstanding reply belongs to the connection it was asked on; if the daemon
has been restarted under Emacs, that connection is gone and no reply is coming
on the new one. Running this first is what lets a hook see that for itself
and drop its pending flag, rather than sitting out a full
`flan-reply-timeout' waiting on a socket the question was never asked
down.")
(defun flan--request (form)
"Send FORM to the connected program and return its reply."
;; `flan--busy' first of all, and around the reconnect as well as around
@ -522,7 +548,6 @@ down.")
;; middle of that would be a second conversation on the connection this one
;; just opened.
(let ((flan--busy t))
(run-hooks 'flan-settle-hook)
(let ((proc (flan--live-connection)))
(flan--absorb (progn (flan--send proc form)
(flan--read-reply proc))))))
@ -563,18 +588,10 @@ Set to nil to leave the program's state to whatever replies happen to say."
(let ((proc flan--connection)
(flan--busy t))
(ignore-errors
;; The same settle every other sender does, and for the same reason.
;; `flan--busy' is not enough on its own: the watch timer leaves a
;; request in flight and *clears* nothing, deliberately — it binds no
;; busy flag, because it never waits — so a poll that checked only the
;; flag would send `describe' with the watch's reply still coming and
;; read that instead. The two would then stay swapped for the rest of
;; the session, each consumer answering the other's question, which is
;; exactly the interleaving `flan-settle-hook' exists to prevent.
(run-hooks 'flan-settle-hook)
;; `describe' rather than `break': it is the cheap op, it is what
;; drains the program's output, and the state is on every reply anyway.
;; Asking `break' would fetch restart names nobody is choosing from.
;; `describe' rather than `break': it is the cheap op, and the state
;; is on every reply anyway. Asking `break' would fetch restart names
;; nobody is choosing from. The program's output does not wait for
;; this; the daemon pushes it as it is printed.
(flan--send proc '(:op "describe"))
(flan--absorb (flan--read-reply proc))))))
@ -611,14 +628,37 @@ Set to nil to leave the program's state to whatever replies happen to say."
(setq flan--connection
(make-network-process
:name "flan" :buffer buf :family 'local :service socket
:coding 'binary :noquery t))
:coding 'binary :noquery t
:filter #'flan--filter :sentinel #'flan--sentinel))
(setq flan--socket socket))
(setq flan--stopped nil)
(setq flan--parked nil)
;; Output and the watch table come as they happen from here on. A daemon
;; that does not know the op refuses it and nothing else changes.
(let ((flan--busy t))
(ignore-errors
(flan--send flan--connection '(:op "push" :on t))
(flan--absorb (flan--read-reply flan--connection))))
(flan--start-polling)
(force-mode-line-update t)
(run-hooks 'flan-connected-hook)
flan--connection)
(defvar flan-connected-hook nil
"Run after a connection to a daemon is opened, including a reconnect.")
(defvar flan-disconnected-hook nil
"Run when the current connection to the daemon closes.")
(defun flan--sentinel (proc _event)
"Notice PROC closing, when it is the current connection."
;; nil is `flan-disconnect', which clears the connection before the
;; sentinel runs; a different live process is a reconnect that replaced it.
(when (and (or (eq proc flan--connection) (null flan--connection))
(not (process-live-p proc)))
(force-mode-line-update t)
(with-demoted-errors "flan: %S" (run-hooks 'flan-disconnected-hook))))
;; 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
@ -1497,9 +1537,15 @@ no longer wrong."
;; major-mode half, possible because the buffer is read-only.
(define-key map (kbd "n") #'compilation-next-error)
(define-key map (kbd "p") #'compilation-previous-error)
;; The minor mode's RET and `special-mode-map''s q, bound here as well so
;; that they are this mode's own keys and reach Evil's states.
(define-key map (kbd "RET") #'compile-goto-error)
(define-key map "q" #'quit-window)
map)
"Keymap for `flan-diagnostics-mode'.")
(flan-evil-own-keys 'flan-diagnostics-mode-map)
(define-derived-mode flan-diagnostics-mode special-mode "Flan-Diagnostics"
"Every message the compiler handed the editor, one navigable list.
`n' and `p' move between entries, RET goes to the line one names.
@ -2220,6 +2266,16 @@ in this program; C-c C-v describes it" (car d)))
(defvar flan-doc-buffer "*flan-doc*"
"Buffer `flan-doc' writes into.")
(defvar flan-doc-mode-map
(let ((map (make-sparse-keymap)))
;; `special-mode-map''s q, as this mode's own key so that it reaches
;; Evil's states; see `flan-evil-own-keys'.
(define-key map "q" #'quit-window)
map)
"Keys in `flan-doc-mode'.")
(flan-evil-own-keys 'flan-doc-mode-map)
(define-derived-mode flan-doc-mode special-mode "Flan-Doc"
"Mode for the buffer `flan-doc' writes.")
@ -2849,6 +2905,15 @@ does, until the same form is evaluated again without a prefix."
(defvar flan-disassembly-buffer "*flan-disassembly*"
"Buffer `flan-disassemble' writes into.")
(defvar flan-disassembly-mode-map
(let ((map (make-sparse-keymap)))
;; As `flan-doc-mode-map'.
(define-key map "q" #'quit-window)
map)
"Keys in `flan-disassembly-mode'.")
(flan-evil-own-keys 'flan-disassembly-mode-map)
(define-derived-mode flan-disassembly-mode special-mode "Flan-Disasm"
"Mode for the buffer `flan-disassemble' writes."
(setq-local truncate-lines t))

34
emacs/test-flan-cider.el
View File

@ -1912,7 +1912,39 @@ stopped program, which is the case where it should fire."
("<" . evil-shift-left)
("-" . evil-previous-line-first-non-blank)))
(test-flan--check (format "under Evil, %s is still Evil's" (car k))
(eq (key-binding (kbd (car k))) (cdr k)))))
(eq (key-binding (kbd (car k))) (cdr k))))
;; The other buffers of Flan's own: every key a mode's map binds
;; itself does what it does without Evil, and the keys it does not
;; bind stay Evil's.
(require 'flan-lower)
(require 'flan-watch)
(dolist (m '((flan-inspect-mode . flan-inspect-mode-map)
(flan-watch-mode . flan-watch-mode-map)
(flan-doc-mode . flan-doc-mode-map)
(flan-disassembly-mode . flan-disassembly-mode-map)
(flan-diagnostics-mode . flan-diagnostics-mode-map)
(flan-lower-mode . flan-lower-mode-map)))
(let ((b (get-buffer-create (format " *evil-%s*" (car m))))
(own nil))
(map-keymap-internal
(lambda (key def) (when (commandp def) (push (cons key def) own)))
(symbol-value (cdr m)))
(switch-to-buffer b)
(funcall (car m))
(evil-initialize-state)
(test-flan--check (format "%s binds keys of its own" (car m)) own)
(dolist (k own)
(test-flan--check
(format "under Evil, %s in %s is the mode's"
(key-description (vector (car k))) (car m))
(eq (key-binding (vector (car k))) (cdr k))))
(dolist (k '(("h" . evil-backward-char) ("SPC" . evil-forward-char)
("<" . evil-shift-left)
("-" . evil-previous-line-first-non-blank)))
(test-flan--check (format "under Evil, %s in %s is still Evil's"
(car k) (car m))
(eq (key-binding (kbd (car k))) (cdr k))))
(kill-buffer b))))
(evil-mode -1))))
(message "\n%d checks, %d failures" test-flan--ran test-flan--failures)

103
emacs/test-flan-watch.el
View File

@ -210,54 +210,67 @@ what bounds its cost; a `with-temp-buffer' would be scanned by nothing."
(test-flan--check "and the last consumer out disarms the table"
(and (null flan-watch--consumers) torn))))
;; --- The reset is guarded on the stop ------------------------------------
;; --- Pushes and replies on one connection ---------------------------------
;;
;; `flan-watch--tick' asks for "since you last looked" by sending `:reset t'
;; beside the read. A stopped program takes no samples, so there is no window
;; for a reset to close and none for it to open — and the runtime's lazy clear
;; is what keeps a paused program showing the numbers from the moment you
;; paused it. So the tick must drop `:reset' while stopped and keep reading.
;;
;; Asserted at the level the rest of this file works at: no daemon, no socket.
;; The tick is a function from `flan--stopped' to the form it puts on the
;; wire, and that is the whole claim, so `flan--send' and `process-live-p'
;; are stubs. What this cannot reach is the daemon actually honouring the
;; absent field; `test/test_dev.ml' drives a real program for that.
;; The daemon writes two kinds of frame: replies, and pushes it sends without
;; being asked — output as it is printed, the watch table while it is armed.
;; The filter handles a push as it arrives and queues a reply for whoever is
;; waiting. Frames are written into a pipe process's buffer by hand, split
;; mid-frame the way a socket may deliver them, so what is claimed is the
;; reader and not the daemon.
(defun test-flan-watch--tick-form (stopped)
"The form `flan-watch--tick' sends with the program STOPPED or not."
(let ((sent nil)
(flan--stopped stopped)
(flan--connection 'a-process)
(flan--busy nil)
(flan-watch--pending nil)
;; Not `buffer': that consumer checks for a live watch buffer first and
;; would drop the subscription instead of ticking.
(flan-watch--consumers '(ghost)))
(cl-letf (((symbol-function 'process-live-p) (lambda (_) t))
((symbol-function 'flan--take-reply) (lambda (_) nil))
((symbol-function 'flan--send)
(lambda (_proc form) (setq sent form))))
(flan-watch--tick)
(list sent flan-watch--pending))))
(defun test-flan-watch--frame (form)
"FORM framed as the daemon frames it."
(let ((payload (encode-coding-string (prin1-to-string form) 'utf-8 t)))
(format "%d\n%s" (length payload) payload)))
(let ((running (test-flan-watch--tick-form nil))
(stopped (test-flan-watch--tick-form "BoundsError")))
(test-flan--check
"a tick while the program runs asks for the window it is closing"
(equal (nth 0 running) '(:op "watch" :reset t)))
(test-flan--check
"a tick while the program is stopped sends no reset"
(null (plist-get (nth 0 stopped) :reset)))
;; Skipping the tick outright would be worse than resetting: the watch would
;; freeze at whatever it held when the program stopped, and a break loop is
;; exactly when the numbers are being read.
(test-flan--check
"but it still reads the table"
(equal (plist-get (nth 0 stopped) :op) "watch"))
(test-flan--check
"and still has a reply in flight, so the cycle survives the pause"
(and (nth 1 running) (nth 1 stopped))))
(let* ((buf (generate-new-buffer " *flan-push-test*"))
(proc (make-pipe-process :name "flan-push-test" :buffer buf
:noquery t))
(painted nil)
(appended nil)
(flan-watch--consumers '(ghost)))
(with-current-buffer buf (set-buffer-multibyte nil))
(unwind-protect
(cl-letf (((symbol-function 'flan-watch--absorb)
(lambda (r) (push r painted)))
((symbol-function 'flan--append-output)
(lambda (text) (push text appended))))
(let ((flan-push-functions '(flan-watch--on-push))
(stream
(concat
(test-flan-watch--frame '(:push "output" :status "ok"
:output "héllo\n"))
(test-flan-watch--frame '(:status "ok" :value "42"))
(test-flan-watch--frame '(:push "watch" :status "ok"
:watch (("ticks" "7"))
:overflow nil)))))
;; In three pieces, the first ending inside the first frame's body.
(flan--filter proc (substring stream 0 12))
(test-flan--check "a push is not handled before all of it has arrived"
(null appended))
(flan--filter proc (substring stream 12 40))
(flan--filter proc (substring stream 40))
(test-flan--check "an output push reaches the output as it arrives"
(equal appended
(list (decode-coding-string
(encode-coding-string "héllo\n" 'utf-8)
'utf-8))))
(test-flan--check "a watch push behind a reply is painted without waiting for the reply to be read"
(equal (plist-get (car painted) :watch)
'(("ticks" "7"))))
(test-flan--check "and the reply is kept for the request that asked"
(equal (flan--take-reply proc)
'(:status "ok" :value "42")))
(test-flan--check "and taken once"
(null (flan--take-reply proc)))
(let ((flan-watch--consumers nil))
(flan--filter proc (test-flan-watch--frame
'(:push "watch" :status "ok" :watch nil)))
(test-flan--check "a watch push with nothing watching paints nothing"
(= 1 (length painted))))))
(delete-process proc)
(kill-buffer buf)))
(provide 'test-flan-watch)
;;; test-flan-watch.el ends here

181
emacs/test-flan.el
View File

@ -536,13 +536,47 @@ already rely on it — so nothing here is a stand-in for the real thing."
;; The program's own output arrives on replies and lands in the daemon's
;; buffer — no REPL is open yet, and the log is the fallback that makes a
;; println never depend on one.
;;
;; And it arrives without anything being asked. The poll is stopped and no
;; request is sent while this waits, so the only way HELLO can reach the
;; buffer is the daemon pushing it.
(flan--eval "(defn step [] i64 (do (println \"HELLO\") ticks))" "form")
(let ((seen nil) (deadline (+ (float-time) 10)))
(while (and (not seen) (< (float-time) deadline))
(ignore-errors (flan--request '(:op "describe")))
(setq seen (with-current-buffer (get-buffer-create flan-daemon-buffer)
(string-match-p "HELLO" (buffer-string)))))
(test-flan--check "the program's output reaches the daemon's buffer" seen))
(flan--stop-polling)
(with-current-buffer (get-buffer-create flan-daemon-buffer)
(let ((inhibit-read-only t)) (erase-buffer)))
(let* ((pushes 0)
(count (lambda (frame)
(when (equal (plist-get frame :push) "output")
(setq pushes (1+ pushes)))))
(started (float-time))
(seen nil))
(advice-add 'flan--dispatch-push :before count)
(unwind-protect
(progn
(while (and (not seen) (< (float-time) (+ started 10)))
(accept-process-output flan--connection 0.01)
(setq seen (with-current-buffer flan-daemon-buffer
(string-match-p "HELLO" (buffer-string)))))
(let ((took (- (float-time) started)))
(test-flan--check "the program's output reaches the daemon's buffer" seen)
(test-flan--check
(format "without a request, in well under a second (%.3fs)" took)
(and seen (< took 0.3))))
;; The program prints every 5ms. Coalesced, a second of that is at
;; most one push per 50ms, not two hundred.
(setq pushes 0)
(let ((until (+ (float-time) 1.0)))
(while (< (float-time) until)
(accept-process-output flan--connection 0.02)))
(test-flan--check
(format "a burst of output is coalesced (%d pushes in 1s)" pushes)
(<= 5 pushes 25)))
(advice-remove 'flan--dispatch-push count)
(flan--start-polling)))
;; A request made while the program prints still gets its own reply.
(test-flan--check "a request while output is being pushed gets its own reply"
(member "step" (plist-get (flan--request '(:op "describe"))
:fns)))
;; ── Which evaluator C-x C-e reaches ──────────────────────────────────
;;
@ -1314,68 +1348,58 @@ already rely on it — so nothing here is a stand-in for the real thing."
;;
;; test_dev.ml proves the table itself: a program pushes and the daemon reads
;; it back without compiling anything. What is left to prove here is the
;; part that is only true in Emacs, and it is not the painting — it is that
;; an *asynchronous* sender and the ordinary synchronous request can share one
;; connection.
;;
;; The protocol is one reply per request on one socket. The watch timer
;; sends and does not wait, deliberately, because waiting on a 0.2s timer
;; stalls the UI. That leaves a reply in flight that the next C-c C-c would
;; read as its own — an evaluation reporting the watch table's answer, which
;; is the exact bug `flan-settle-hook' exists to make impossible. This
;; program writes nothing into the table, which does not matter: the
;; interleaving is the claim.
(flan-watch)
(test-flan--check "the watch buffer opens" (get-buffer flan-watch-buffer))
(test-flan--check "and the timer is running" flan-watch--timer)
(test-flan--check "a program that watches nothing says so, rather than looking broken"
(with-current-buffer flan-watch-buffer
(string-match-p "nothing is being watched" (buffer-string))))
;; The tick by hand, so this does not depend on a timer firing inside a batch
;; run. Two of them: the first sends, the second collects and sends again.
(flan-watch--tick)
(test-flan--check "a tick leaves a request in flight rather than waiting for it"
flan-watch--pending)
;; The background poll is a sender too, and it was the one sender that did
;; not settle: it guarded on `flan--busy' alone, which the watch timer
;; deliberately does not bind — it never waits, so it has nothing to hold —
;; and sent `describe' straight into a connection that already owed a reply.
;; It then read the watch's answer as its own, and the two stayed swapped
;; for the rest of the session. The second check is where that would show:
;; a `describe' answered by the watch table has no `:fns' in it at all.
(flan--poll)
(test-flan--check "a poll settles the watch's reply rather than reading it as its own"
(null flan-watch--pending))
(test-flan--check "and the request after it is still answered by its own reply"
;; part that is only true in Emacs: the daemon sends the table on the same
;; connection that carries replies, unasked, and neither gets in the way of
;; the other.
(let ((pushes 0))
(let ((count (lambda (_r) (setq pushes (1+ pushes)))))
(advice-add 'flan-watch--absorb :before count)
(unwind-protect
(progn
(flan-watch)
(test-flan--check "the watch buffer opens" (get-buffer flan-watch-buffer))
(test-flan--check "a program that watches nothing says so, rather than looking broken"
(with-current-buffer flan-watch-buffer
(string-match-p "nothing is being watched" (buffer-string))))
;; A body that writes the table, so there is something to send.
(flan--eval "(defn step [] i64 (set ticks (+ ticks 1)) (watch \"ticks\" ticks) ticks)"
"form")
(let ((until (+ (float-time) 5)))
(while (and (< (float-time) until)
(not (with-current-buffer flan-watch-buffer
(string-match-p "^ticks" (buffer-string)))))
(accept-process-output flan--connection 0.05)))
(test-flan--check "the table arrives without being asked for"
(with-current-buffer flan-watch-buffer
(string-match-p "^ticks [0-9]+" (buffer-string))))
;; `ticks' moves every frame, so every push is a new table.
(setq pushes 0)
(let ((until (+ (float-time) 1.0)))
(while (< (float-time) until)
(accept-process-output flan--connection 0.02)))
(test-flan--check
(format "and keeps arriving at the repaint interval (%d in 1s)" pushes)
(<= 2 pushes 8)))
(advice-remove 'flan-watch--absorb count))))
;; Replies are not disturbed by the pushes around them.
(test-flan--check "a request while the table is being pushed gets its own reply"
(member "step" (plist-get (flan--request '(:op "describe"))
:fns)))
;; And the same hook against a daemon restarted under an armed watch. The
;; reply the watch is owed was asked for on the connection that has gone, so
;; there is nothing to wait for — running the hook before the connection is
;; checked is what lets it see that. Asking after the reconnect meant a
;; whole `flan-reply-timeout' of frozen Emacs on the first thing anybody
;; typed after a restart, which is why the wait itself is what is measured.
(flan-watch--tick)
;; A daemon restarted under an armed watch: the new connection arms it again.
(delete-process flan--connection)
;; The timeout and the assertion are deliberately different numbers: what is
;; being told apart is a request that waited one out from a request that did
;; not, and the wider the gap the less this depends on how loaded the machine
;; running the suite happens to be. A reconnect and a `describe' are
;; milliseconds of work.
(let ((flan-reply-timeout 10)
(started (float-time)))
(let ((r (flan--request '(:op "describe"))))
(test-flan--check "a request after a restart does not wait out a reply the old connection owed"
(and (member "step" (plist-get r :fns))
(< (- (float-time) started) 3)))
(test-flan--check "and the watch is not left waiting for one either"
(null flan-watch--pending))))
;; A request in flight again, for the interleaving below.
(flan-watch--tick)
;; And now the interleaving, with a reply outstanding on purpose. If the
;; settle hook were not there this would return the watch table's plist and
;; `flan--report' would take its missing :status for a rejection.
;;
(let ((r (flan--request '(:op "describe"))))
(test-flan--check "after a reconnect the request is answered"
(member "step" (plist-get r :fns))))
(with-current-buffer flan-watch-buffer
(let ((inhibit-read-only t)) (erase-buffer)))
(let ((until (+ (float-time) 5)))
(while (and (< (float-time) until)
(not (with-current-buffer flan-watch-buffer
(string-match-p "^ticks" (buffer-string)))))
(accept-process-output flan--connection 0.05)))
(test-flan--check "and the table is pushed again on the new connection"
(with-current-buffer flan-watch-buffer
(string-match-p "^ticks" (buffer-string))))
;; Back in the source buffer first: `flan-doc' and `flan-watch' above both
;; display buffers of their own, and C-c C-c reads the buffer it is run in.
(pop-to-buffer (flan--buffer-visiting file))
@ -1383,31 +1407,24 @@ already rely on it — so nothing here is a stand-in for the real thing."
(search-forward "(defn step")
(goto-char (match-beginning 0))
(let ((said (test-flan--said (flan-eval-defun))))
(test-flan--check "an eval with a watch reply in flight still gets its own answer"
(and said (string-match-p "step" said)))
(test-flan--check "and the watch request was settled, not abandoned"
(null flan-watch--pending)))
(flan-watch--tick)
(flan-watch--tick)
(test-flan--check "and the buffer keeps painting afterwards"
(with-current-buffer flan-watch-buffer
(> (buffer-size) 0)))
(test-flan--check "an eval while the table is being pushed gets its own answer"
(and said (string-match-p "step" said))))
;; Point survives a repaint. This is why `replace-buffer-contents' is used
;; rather than erase-and-insert: the latter would put the cursor back at the
;; top of the buffer on every tick, which makes the one thing you want to do
;; in a watch buffer — look at a line while the program runs — impossible.
;; top of the buffer on every repaint, which makes the one thing you want to
;; do in a watch buffer — look at a line while the program runs — impossible.
(with-current-buffer flan-watch-buffer
(flan-watch--absorb '(:status "ok" :watch (("ticks" "1")) :overflow nil))
(goto-char (point-max))
(let ((where (point)))
(flan-watch--tick)
(flan-watch--tick)
(flan-watch--absorb '(:status "ok" :watch (("ticks" "2")) :overflow nil))
(test-flan--check "and point does not jump to the top on a repaint"
(= (point) where))))
(flan-watch-stop)
(test-flan--check "stopping cancels the timer" (null flan-watch--timer))
(test-flan--check "and takes the settle hook off with it"
(not (memq #'flan-watch--settle flan-settle-hook)))
;; Killing the buffer is how it is closed, and it disarms the table.
(kill-buffer flan-watch-buffer)
(test-flan--check "killing the watch buffer ends the subscription"
(and (null flan-watch--consumers)
(not (memq #'flan-watch--on-push flan-push-functions))))
(flan-disconnect)
(test-flan--check "disconnected" (not (process-live-p flan--connection)))

166
lib/dev.ml
View File

@ -4019,6 +4019,13 @@ let handle t req =
in
disassemble t ~name ~form
| None -> error "disassemble needs :name")
(* Whether this connection is written to without asking. [serve] keeps the
switch, since it belongs to the connection; see [pushing]. *)
| Some "push" ->
ok [ (match Wire.field req "on" with
(* Not [:push], which marks a frame as a push. *)
| Some { Form.v = Form.Sym "nil"; _ } | None -> ":pushing nil"
| Some _ -> ":pushing t") ]
| Some "close" -> ok []
| Some op -> error ("unknown op: " ^ op)
| None -> error "no :op"
@ -4084,6 +4091,136 @@ let reply_of_exn e =
error ~loc:(Loc.to_string l) (message_of_exn e)
| _ -> error (message_of_exn e)
(* ── Pushing to the editor ─────────────────────────────────────────── *)
(* A connection that has sent [(:op "push" :on t)] is also written to without
asking: the program's output as it is printed, and the watch table while
this connection has it armed. Every other frame on the socket answers a
request, so a push is marked [:push] with its kind — ["output"] or
["watch"] — and a client reads it apart from the reply it is waiting for.
Opt-in, because a client that has not said it reads unsolicited frames
would take the first one as the answer to its next request. The raw-socket
tests and any other client keep one reply per request and nothing else.
Output is coalesced: the first bytes after a quiet spell wait [push_settle]
for more, and no two output pushes are closer than [push_gap]. A program
printing every frame is then twenty frames a second on the socket rather
than sixty or two hundred, and a single line still lands within [push_gap].
A push never interleaves with a reply. The loop is one thread: while a
request is handled nothing is pushed, what the program prints meanwhile
stays in [t.out], and [with_output] puts it on that request's reply and
empties the buffer, so it is not pushed again afterwards. *)
let push_settle = 0.01
let push_gap = 0.05
let watch_interval_default = 0.2
type pushing = {
mutable on : bool;
mutable out_due : float option; (* when buffered output goes out *)
mutable last_out : float;
mutable watch_every : float option; (* armed by this connection *)
mutable watch_due : float;
}
let bool_field req key =
match Wire.field req key with
| Some { Form.v = Form.Sym "nil"; _ } | None -> false
| Some _ -> true
let float_field req key =
match Wire.field req key with
| Some { Form.v = Form.Float f; _ } -> Some f
| Some { Form.v = Form.Int i; _ } -> Some (Int64.to_float i)
| _ -> None
(* A reply's fields, tagged as a push. [reply] is a plist [(:status ...)]. *)
let as_push kind reply =
"(:push " ^ Wire.quote kind ^ " "
^ String.sub reply 1 (String.length reply - 1)
(* Output has arrived since the last look: schedule a push for it. *)
let note_output p t now =
if p.on && p.out_due = None && Buffer.length t.out > 0 then
p.out_due <- Some (Float.max (now +. push_settle) (p.last_out +. push_gap))
(* Whether the client is taking what it is sent. An editor that has stopped
reading — busy, or suspended — must not stop this loop, which is also what
drains the program's pipe: while the socket will not take more, output
stays in [t.out] (bounded by [capacity]) and the table waits a turn. *)
let writable fd =
match Unix.select [] [ fd ] [] 0. with
| _, [], _ -> false
| _ -> true
| exception Unix.Unix_error (Unix.EINTR, _, _) -> false
(* Something is due to be pushed. *)
let push_is_due p now =
p.on
&& ((match p.out_due with Some d -> now >= d | None -> false)
|| (p.watch_every <> None && now >= p.watch_due))
(* Send whatever is due, and say whether something due could not be sent
because the client is not reading. Raises [Unix_error] when the client has
gone. *)
let rec push_due p t fd now =
if not (push_is_due p now) then false
else if not (writable fd) then true
else begin push_now p t fd now; false end
and push_now p t fd now =
(match p.out_due with
| Some due when p.on && now >= due ->
p.out_due <- None;
p.last_out <- now;
(match take t with
| "" -> ()
| text ->
Wire.send fd (as_push "output" (ok [ ":output " ^ Wire.quote text ])))
| _ -> ());
match p.watch_every with
| Some every when p.on && now >= p.watch_due ->
p.watch_due <- now +. every;
(* Each push closes the numeric slots' accumulation window while the
program runs. A stopped program takes no samples, so its window is left
open and the numbers from the moment it stopped stay on the screen. *)
let stopped = match state t with Stopped _ -> true | _ -> false in
(* Sent whether or not it changed: ghost text is repainted from each push,
and a buffer scrolled into view while the program is stopped gets its
values from the next one. *)
Wire.send fd (as_push "watch" (watch_read t ~reset:(not stopped)))
| _ -> ()
(* How long the loop may block before a push is due; [-1.] is no limit, which
is what [Unix.select] takes a negative timeout to mean. *)
let push_wait p now =
if not p.on then -1.
else
let until = function Some d -> Float.max 0. (d -. now) | None -> -1. in
let a = until p.out_due
and b = until (Option.map (fun _ -> p.watch_due) p.watch_every) in
if a < 0. then b else if b < 0. then a else Float.min a b
(* What a request changes about pushing on this connection. [push] is the
switch; [watch-enable] arms or disarms the table's push, at [:interval]
seconds, once the program has accepted it. *)
let push_request p req op reply =
match op with
| Some "push" -> p.on <- bool_field req "on"
| Some "watch-enable" when String.starts_with ~prefix:"(:status \"ok\"" reply ->
if bool_field req "on" then begin
let every =
match float_field req "interval" with
| Some f when f > 0. -> Float.max f push_gap
| _ -> watch_interval_default
in
p.watch_every <- Some every;
p.watch_due <- 0.
end
else p.watch_every <- None
| _ -> ()
(* ── The loop ──────────────────────────────────────────────────────── *)
(* One connection at a time. An editor is one client, evaluations are
@ -4094,7 +4231,33 @@ let reply_of_exn e =
so [close] shuts the whole thing down rather than waiting for another
connection nobody is going to make. *)
let serve t fd =
let p = { on = false; out_due = None; last_out = 0.; watch_every = None;
watch_due = 0. } in
(* Between requests: push what is due, then wait for a request, for the
program's output, or for the next push, whichever comes first. The pipe
is drained here whether or not this client takes pushes, which is the
liveness requirement [drain] describes, met while an editor is attached
as well as between editors. *)
let rec go () =
match push_due p t fd (Unix.gettimeofday ()) with
| exception Unix.Unix_error _ -> false
| blocked ->
let fds = if t.finished then [ fd ] else [ fd; t.stdout ] in
(* A push the client is not taking waits for it to become writable
rather than spinning on a deadline that has already passed. *)
let wfds, wait =
if blocked then [ fd ], -1. else [], push_wait p (Unix.gettimeofday ())
in
(match Unix.select fds wfds [] wait with
| ready, _, _ ->
if List.mem t.stdout ready && not t.finished then begin
drain t;
note_output p t (Unix.gettimeofday ())
end;
if List.mem fd ready then request () else go ()
| exception Unix.Unix_error (Unix.EINTR, _, _) -> go ()
| exception Unix.Unix_error _ -> false)
and request () =
match Wire.recv fd with
| src ->
(* One of the two places the agent clock is read — see [agent_check].
@ -4125,6 +4288,9 @@ let serve t fd =
| r -> r
| exception e when not (fatal e) -> reply_of_exn e)
in
(match parsed with
| Either.Left req -> push_request p req op reply
| Either.Right _ -> ());
(* The two annotations are inside the boundary as well, and not because
they are likely to raise: [with_break] asks the program for its state
and [with_output] drains its pipe, so they touch the same things the

23
test/test_dev.ml
View File

@ -4046,6 +4046,29 @@ let () =
| Some v -> v <> first
| None -> false))
then fail "the watch table stopped moving";
(* Pushed, on a connection that asked for pushes: the table arrives
with nothing sent for it, marked as a push so a client can tell it
from a reply. *)
if Wire.string_field (ask "(:op \"push\" :on t)") "status" <> Some "ok"
then fail "push was refused";
Wire.send wc "(:op \"watch-enable\" :on t :interval 0.05)";
let rec reply () =
let f = Wire.parse (Wire.recv wc) in
if Wire.field f "push" = None then f else reply ()
in
if Wire.string_field (reply ()) "status" <> Some "ok" then
fail "watch-enable with an interval was refused";
(match Unix.select [ wc ] [] [] 5.0 with
| [], _, _ -> fail "no watch push arrived after arming"
| _ ->
let f = Wire.parse (Wire.recv wc) in
if Wire.string_field f "push" <> Some "watch" then
fail "the first frame after arming was not a watch push";
(match Wire.field f "watch" with
| Some { Form.v = Form.List (_ :: _); _ } -> ()
| _ -> fail "a watch push carried no table"));
Wire.send wc "(:op \"push\" :on nil)";
ignore (reply ());
(* And off again. The value already in a slot stays — nothing clears
it — but the program stops writing, so it stops changing. *)
if status (ask "(:op \"watch-enable\" :on nil)") <> "ok" then