From 5791faee4e0b579bfe624a332412d750b71c7b13 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 12:51:06 +0700 Subject: [PATCH 1/2] A breakpoint is a function call, and the editor only says where MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Finishes DISCUSS.md §9's `pause` marking: the daemon half was already built, this is the editor half plus the one daemon path it was missing. `C-u C-c C-c` marks the form point is inside, `C-u C-u C-c C-c` the top-level form (stop on entry), `C-u C-x C-e` the expression before point. The buffer is never edited — the position rides beside the code and the `(pause)` call goes into the tree after parsing, so no source location moves. `C-x C-e`'s path needed the daemon: its 5s `wait` answered "the program did not reach a frame boundary", which is exactly what a thunk parked at a breakpoint looks like from out here. `wait` is now three-way and asks `state t = Stopped` only when a pause was requested, so the no-pause shape `test_dev.ml` pins is unchanged. The overlay is an annotation and not feedback, so unlike an error marker it survives `pre-command-hook`; what takes it down is an accepted evaluation with no `:pause` on it, which is the same thing that takes the mark itself down. Tests: a `test_dev.ml` block over the new `dev-pause.flan` that marks, stops, re-evaluates plainly and then polls half a second confirming it does not stop again — one sample after `continue` proves nothing, the resumed frame is still in the old body — and an `emacs/test-flan-dev.el` block for which form a prefix picks, the byte column, the overlay's lifetime, and one live round trip. --- BUILT.md | 78 ++++++++++++++ HANDOFF-f2.md | 142 ------------------------ NEXT.md | 27 ++--- emacs/MANUAL.md | 28 +++++ emacs/flan-dev.el | 187 ++++++++++++++++++++++++++++---- emacs/test-flan-dev.el | 138 ++++++++++++++++++++++++ lib/dev.ml | 47 ++++++-- lib/session.ml | 22 +++- test/programs/dev-pause.flan | 24 +++++ test/test_dev.ml | 202 +++++++++++++++++++++++++++++++++++ 10 files changed, 700 insertions(+), 195 deletions(-) delete mode 100644 HANDOFF-f2.md create mode 100644 test/programs/dev-pause.flan diff --git a/BUILT.md b/BUILT.md index 696d81e..fa3a513 100644 --- a/BUILT.md +++ b/BUILT.md @@ -4887,3 +4887,81 @@ no inline value at all while appearing normally in the buffer. A `*` for the `?` recording as the predictable cost of the decision that section defends: anchoring on the *name* rather than on the head of the call is what makes the head a `defcustom`, and a `defcustom` with an enumerated default is a default that needs widening when the set of heads grows. That is a cheaper failure than the alternative and it is not a free one. + +## A breakpoint is a function call, and the editor only says where + +`C-u` before an evaluation marks a form so the program stops when that form runs — Clojure's convention, and +DISCUSS.md §9's request. Nothing in the compiler knows what a breakpoint is. + +**The mark is an ordinary `(pause)` call spliced into the tree.** `pause` is already in the prelude and is already +`error` under a `restart-case` with a `continue` clause, so an instrumented body is a body that calls one more +function, and the break loop it lands in is the one an unhandled condition already builds. A `paused : bool` on +`Ast.expr` would have had to be threaded through `Check`, `Tast` and `Emit` for a feature the prelude implements as a +function. + +**It travels as a position beside the code, not as text spliced into it.** §9 proposed sending the top-level form with +the target span replaced by `(do (pause) )`. That shifts every line and column after the insertion, and the +error overlays, `layout`, the break loop's frame locations and DWARF all read those. So the request carries +`:pause (LINE COL)` and the daemon applies it to the *declarations*, once parsing has attached the locations and +`Load` has qualified the names — `Ast.mark_pause`, pre-order, first hit wins. Applied after qualification, so a +package that defines a `pause` of its own cannot capture the synthesized call. + +**Pre-order and first-hit because desugaring makes locations non-unique.** `parse.ml` gives several nested nodes the +same location — `(when c a)` becomes an `If` whose branch is a `Do` at the `when`'s own position. The outermost node +at that position is the one the editor pointed at, and the walk stops there. + +**A whole `defn` cannot be wrapped, so marking one means stopping on entry.** `(do (pause) (defn ...))` is not an +expression. §9's first target therefore puts the call at the front of `fbody` instead, which is the same thing anyone +asking to stop at a function meant. `Ast.map_children` is exhaustive on purpose: a constructor left out would be a +form the mark silently cannot be set inside. + +**A position matching nothing is refused.** Installing an unmarked body and answering `ok` would report a breakpoint +that is not there — the silent-success failure the session refuses everywhere else. The reply echoes `:pause +"LINE:COL"` on success, and the editor draws its overlay off that echo rather than off what it asked for, so it can +never show a mark the session declined. + +**It sticks with no extra machinery.** The marked declaration is what goes into `Session.t.decls`, so it stays marked +until an evaluation replaces it — an ordinary `C-c C-c` over the same form with no `:pause`, or `C-c C-k` over the +buffer. That is §9's settled behaviour and it costs one statement that was already there. A parallel `paused` list on +the session would have been a second source of truth that drifts the first time some path replaces `decls` without +touching it, and clearing would have had to be written rather than falling out. + +**`C-u C-x C-e` is a flag, not a position.** `flan-eval-last-sexp` sends a raw `buffer-substring` with no line +padding — unlike `flan-dev--text`, which pads a snippet back onto its own line — so buffer coordinates do not survive +that path. They are also not needed: the expression sent *is* the target, so `:pause t` says everything there is to +say, and `Session.eval_expr` wraps the parsed expression before `Check.expression`. It does not stick and cannot: a +thunk is built and thrown away, so there is no declaration for the mark to live in. + +**The trap that path sets, and the reason `wait` is three-way.** `Dev.eval_expr` waits five seconds for the thunk to +produce a value and otherwise answers *"the program did not reach a frame boundary; is it calling (agent/poll)?"* — +which is exactly what a thunk parked at a breakpoint looks like from the daemon's side. Left alone it would report the +working feature as a failure, after a five-second stall. So `wait` answers `` `Value | `Stopped | `Timeout ``, and the +`Stopped` question is asked **only when a pause was requested**: without one, a thunk that stops did so by erroring, +and the timeout message is the answer that path has always given — `test_dev.ml` pins it. The `` `Stopped `` reply +carries no `:value`, because there is not one yet; `:stopped t :condition "Pause"` rides on it the way it rides on +every reply, from `with_break`. + +**The editor's column is a byte offset.** `flan-dev--wire-position` is the inverse of `flan-dev--position` and has to +count bytes for the same reason: the reader walks the source a byte at a time, so `current-column` would be short by +one per extra byte in every non-ASCII character earlier on the line and the daemon would find nothing where it was +pointed. The *line* is the buffer's own, which works because `flan-dev--text` pads the snippet with leading newlines. + +**One key, three targets.** `flan-eval-defun` takes `C-u` for the innermost form point is inside — `backward-up-list`, +falling back to the defun when point is not nested — and `C-u C-u` for the top-level form itself. With `C-u C-x C-e` +that is all three of §9's targets and no new binding; `flan-mode.el` did not change. + +**The overlay is an annotation, not feedback.** `flan-dev-pause-face` is drawn over the marked form and deliberately +does *not* copy the error overlays' lifetime. An error overlay is about the command that just failed and the next +keystroke takes it down; a pause mark is about the running program, and it has to survive `pre-command-hook` or the +buffer stops showing a breakpoint that is still there. What clears it is what clears the mark itself: an accepted +evaluation with no `:pause` on it, over a region that intersects it — and `C-c C-k` clears the whole buffer, because +every declaration in it was just replaced. The face inherits `warning` rather than `error`, agreeing with +`flan-cnr.el`, which already renders `Pause` that way: a breakpoint is a stop, not a failure. + +**The test that matters is the second one.** `test_dev.ml`'s pause block marks `step`'s `(+ ticks 1)`, waits for +`:stopped t :condition "Pause"` and checks `continue` is on offer — and then re-evaluates the form *plainly*, takes +`continue`, and polls for half a second confirming it never stops again. A single sample after the resume proves +nothing: the frame that resumed is still inside the old marked body, past the `(pause)` call, so the first look reads +as running whether or not the mark was cleared. Half a second is about a hundred calls through the body just +installed. `test/programs/dev-pause.flan` exists because `dev-loop.flan` calls `step` four times, which is too tight +for that, and because a program that stops on its own — `dev-break.flan` — would prove nothing about what stopped it. diff --git a/HANDOFF-f2.md b/HANDOFF-f2.md deleted file mode 100644 index 976c589..0000000 --- a/HANDOFF-f2.md +++ /dev/null @@ -1,142 +0,0 @@ -# Handoff: `pause` marking from Emacs (DISCUSS.md §9) - -The daemon half is built and works end to end over the wire. The Emacs half is **not** built. -Nothing half-written was left behind: `dune build` is clean and there is no new test. - -## The design, as it stands after reading the code - -`C-u` before an eval marks a form so the program stops when that form runs. The mark is **not** -spliced into the source text — that would move every line and column after the insertion, and the -error overlays, `layout`, the break loop's frame locations and DWARF all read those. Instead the -editor sends a **position** beside the code: - -``` -(:op "eval" :code "(defn step [] i64 ...)" :file "/x/y.flan" :pause (LINE COL)) -``` - -The daemon parses and `Load`s as usual, then walks the resulting `Ast.decl list` and puts a -`(pause)` call at whatever *starts* at that position. `(pause)` is an ordinary prelude function -(`error` under a `restart-case` with a `continue` clause), so an instrumented body is just a body -that calls one more function, and the break loop it lands in is the one an unhandled condition -already builds. Nothing in the compiler changes. - -It **sticks** with no extra machinery: the marked declaration is what goes into `Session.t.decls`, -so it stays marked until an evaluation replaces it — an ordinary `C-c C-c` over the same form with -no `:pause`, or `C-c C-k` over the buffer. That is §9's settled behaviour and it costs one -statement that was already there. - -### What §9 left out or got slightly wrong - -- **§9 says "send the top-level form with that span replaced by `(do (pause) )`".** That - wrapping is right for a sub-expression but *impossible* for the first of its three targets: a - whole top-level `defn` is a declaration, and `(do (pause) (defn ...))` is not an expression. - Marking a whole `defn` therefore means *stopping on entry*, and the call goes at the front of - `fbody`. `Ast.mark_pause` does both, chosen by what the position lands on. -- **§9 does not say the mark can be refused.** It has to be: a position that matches nothing must - be an error, because installing an unmarked body and answering `ok` reports a breakpoint that is - not there — the silent-success failure the session refuses everywhere else. -- **Desugaring makes locations non-unique.** `parse.ml` gives several nested nodes the same - location (`when` becomes an `If` whose branch is a `Do` at the `when`'s own position — lines 141, - 164, 651, 654). The walk is pre-order and stops at the first hit, so the outermost node at that - position wins, which is the one the editor pointed at. -- **The third target ("the form point is inside") needs no new daemon work** — it is the same - position field, computed differently in Emacs. - -## What was built, file by file - -All four are **working** (built, and exercised against a real daemon and a real running program by -hand — see "How it was checked"). - -- **`lib/ast.ml`** — new section at the end: - - `map_children : (expr -> expr) -> expr -> expr`, an exhaustive one-level rebuild. Exhaustive on - purpose: a missing constructor is a form you silently cannot stop inside. - - `pause_call : Loc.t -> expr` — `(pause)` at a given location. - - `mark_pause : line:int -> col:int -> decl list -> decl list option` — pre-order, first hit wins, - `None` when nothing is at that position. The synthesized `Do`/`Call` take the target's own - location, never `Loc.unknown`, because DWARF and the break loop's frame location read it. -- **`lib/wire.ml`** — `pos_field form key`, reading `(LINE COL)` as a pair of ints; `None` for - anything else, the same narrowness as `int_field`. -- **`lib/session.ml`** — `eval` takes `?pause:(int * int)`. It is applied **after** - `Load.qualify_decl`, so a package that defines a `pause` of its own cannot capture the - synthesized call, and a position that matches nothing is a `Loc.fail` naming the position. -- **`lib/dev.ml`** — `eval` takes `~pause`, `handle` reads `:pause` off the request, and a - successful install echoes `:pause "LINE:COL"` back so an editor marks the buffer only for a mark - the session actually applied. With no `:pause` in the request, every byte of the old behaviour is - unchanged. - -## How it was checked - -A daemon over `test/programs/dev-loop.flan`, driven by a raw socket client: - -- eval of `step` with `:pause (1 1)` → `(:status "ok" … :pause "1:1")`, and a later `describe` - came back `:stopped t :condition "Pause"` — the program stopped, on the prelude's own condition. -- `:pause (1 999)` → `(:status "error" :message "nothing to pause at line 1, column 999 of the form - sent")`. -- a plain re-eval of the same form → accepted. - -`dune build` is clean. **`dune test` was not run** (budget). The changes are additive: the new -session argument is optional and the new reply field only appears when `:pause` was sent, so no -existing path changes shape — but the suite should be run first thing next session anyway. Note -`test_dev.ml`'s first block is separately known-flaky (a socket bind race, ~1 in 4). - -## What remains, in order - -1. **`lib/dev.ml`, `eval_expr`** — accept `:pause` for `C-u C-x C-e` (§9's "last expression"). - Two parts. (a) `lib/session.ml`'s `eval_expr` should take `?(pause = false)` and wrap - `Parse.expr form` in `Do [Ast.pause_call loc; e]` before `Check.expression`. (b) `eval_expr`'s - `wait` loop in `dev.ml` returns `error "the program did not reach a frame boundary…"` after 5s, - which is exactly what a thunk that stopped in the break loop will do — so it would report the - working feature as a failure. Make `wait` three-way (`` `Value | `Stopped | `Timeout ``) and - check `state t = Stopped` **only when a pause was requested**: `test_dev.ml:519–560` already - asserts the current timeout shape for the no-pause case (`"an expression that stopped inside a - break answered anyway"`), and that must stay byte-identical. - Use `:pause t` here, not `(LINE COL)`: `flan-eval-last-sexp` sends a raw `buffer-substring` - with no line padding (unlike `flan-dev--text`), so buffer coordinates do not survive that path. -2. **`emacs/flan-dev.el`, `flan-dev--eval`** — take an optional pause position and put - `:pause (LINE COL)` on the request. The column is a **1-based byte offset**, per the comment - above `flan-dev--position`: `(1+ (- (position-bytes pos) (position-bytes (line-beginning-position))))`, - *not* `current-column`. The line is the buffer's own line, which already works because - `flan-dev--text` pads with leading newlines. -3. **`emacs/flan-dev.el`, `flan-eval-defun`** — `(interactive "P")`. `C-u` marks the innermost form - point is inside (`backward-up-list`, falling back to the defun's start when point is not nested); - `C-u C-u` marks the top-level form itself, i.e. stop on entry. That plus item 1 covers §9's three - targets with no new keybinding — `emacs/flan-mode.el` needs no change. -4. **`emacs/flan-dev.el`, the visual indication** — a `flan-dev-pause-face` overlay over the marked - form's bounds, drawn **only** when the reply carries `:pause`, tagged with a `flan-dev-pause` - property. Copy the shape of the error overlays (`flan-dev--show-error`) but *not* their lifetime: - a pause mark is an annotation on the program, not feedback about one command, so it must survive - `pre-command-hook`. Remove overlays intersecting the sent region on every accepted plain eval, - and over the whole buffer in `flan-eval-buffer` — that is the visible half of "cleared by an - ordinary `C-c C-c`". -5. **`test/programs/dev-pause.flan`** — new, shaped like `dev-break.flan`'s tail so the marked - function keeps being called: `(dotimes [i 4000] (agent/wait 5) (set ticks (step)))`. - `dev-loop.flan` calls `step` only four times, which is too tight. -6. **`test/test_dev.ml`** — a block in the style of the break-loop block (its own daemon, its own - program, its own output buffer). Assert both halves: mark `step`'s `(+ ticks 1)` sub-expression - → await `:stopped t` with a condition containing `Pause` → `break` lists `continue` → then - **re-eval `step` plainly, take `continue`, and confirm it runs on without stopping again**. The - second assertion is the one that tests the settled "it sticks until evaluated plainly" decision - and the one most likely to be skipped. -7. **`emacs/test-flan-dev.el`** — the elisp side, once items 2–4 exist. - -## Decisions made that were not already settled - -- **The mark is not a field on `Ast`.** It is an ordinary `(pause)` call spliced into the tree. A - `paused : bool` on `Ast.expr` would have to be threaded through `Check`, `Tast` and `Emit` for a - feature the prelude already implements as a function. -- **No parallel `paused` list on `Session.t`.** The spliced declaration in `t.decls` *is* the state - that makes the mark stick; a second `(name * position) list` would be a second source of truth - that drifts the first time some path replaces `decls` without touching it. Clearing then falls out - for free — any plain eval replaces the stored declaration with an unmarked one. -- **Marking a whole `defn` means stopping on entry**, since it cannot be wrapped (above). -- **A position matching nothing is refused**, rather than installed unmarked (above). -- **The splice happens after qualification**, so a package's own `pause` cannot capture it. -- **The reply echoes `:pause "LINE:COL"`** so the editor draws its overlay off the daemon's - confirmation and can never claim a mark that was refused. - -## Tried and abandoned - -- Nothing failed outright. Worth recording: the worktree this was done in was created **485 commits - behind** `dev-loop` (at `2c232dd`, before `lib/dev.ml` existed at all) and had to be - `git reset --hard` to the branch tip before any of the files named in the task existed. Check - `git log` against `dev-loop` before starting in a fresh worktree. diff --git a/NEXT.md b/NEXT.md index 2225e6c..de90b07 100644 --- a/NEXT.md +++ b/NEXT.md @@ -10,23 +10,12 @@ roughly 485 commits stale, on a tree where `lib/dev.ml` does not exist. Both age tip themselves. A lane that did not notice would produce plausible work against the wrong tree. Check `git log --oneline -1` before starting in a worktree. -### From `HANDOFF-f2.md` — `pause` marking, the Emacs half +### ~~From `HANDOFF-f2.md` — `pause` marking, the Emacs half~~ -The daemon half is built and works over the wire: `Ast.mark_pause` splices a `(pause)` call pre-order with first-hit -wins, `wire.ml` reads `:pause (LINE COL)`, `session.ml` applies it after `Load.qualify_decl`, and `dev.ml` echoes -`:pause "LINE:COL"`. With no `:pause` field the old behaviour is byte-identical. **Seven items remain, in order**, -and the handoff names the function for each. The two that are traps rather than work: - -- `eval_expr`'s 5-second `wait` loop in `dev.ml` returns a timeout error, which is exactly what a thunk stopped in - the break loop does — so it would report the working feature as a failure. It has to become three-way and check - `state t = Stopped` **only when a pause was requested**, because `test_dev.ml:519–560` pins the current shape for - the no-pause case and that must stay byte-identical. -- `flan-eval-last-sexp` sends a raw `buffer-substring` with no line padding, unlike `flan-dev--text`, so buffer - coordinates do not survive that path. It needs `:pause t`, not a position. - -One decision the lane had to make alone and that is worth knowing before touching it: **a whole `defn` cannot be -wrapped**, so marking one means stopping on entry. DISCUSS.md §9's "replace the span with `(do (pause) …)`" does not -work for its own first target. +**Built.** All seven items landed: the `eval_expr` pause path, `flan-dev--eval` sending the position, +`flan-eval-defun` taking `C-u`, the overlay and its face, `test/programs/dev-pause.flan`, the `test_dev.ml` block and +the `emacs/test-flan-dev.el` one. `HANDOFF-f2.md` is deleted; the reasoning is in `BUILT.md`, "A breakpoint is a +function call, and the editor only says where". ### From `HANDOFF-f1.md` — the socket flake is fixed, and two things follow it @@ -255,10 +244,8 @@ statement that needs a second run to make. Worth fixing before it trains someone Both lanes committed their main work and died on trailing polish; both are merged and the suite is green. -- **`pause` marking from Emacs was not built.** `DISCUSS.md` item 9 has the design, and the decisions are settled: the - instrumentation travels as a *separate field* applied by the daemon **after** parsing (splicing text would shift - every source location after it), and the mark **sticks** until the form is evaluated plainly. The watch lane got as - far as deciding to splice into the `Ast` rather than the forms. +- ~~**`pause` marking from Emacs was not built.**~~ **Built**, both halves. See `BUILT.md`, "A breakpoint is a + function call, and the editor only says where". - ~~**Ghost text** for the watch window — values shown inline at the code they belong to — is noted and not designed.~~ **Built.** See `BUILT.md`, "Ghost text finds its anchor in the buffer, not in the table". - `tools/unit-return.py` is re-runnable; run it over any `.flan` file a lane wrote before the conversion landed. diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 4718513..c7613c1 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -82,6 +82,32 @@ the actual process, with its actual state. So in a game you can type `(len enemies)` and get the real number. +### `C-u C-c C-c` — stop there + +The same key with a prefix argument **marks a form as a breakpoint**. `C-u C-c +C-c` marks the innermost form point is inside — with the cursor in `(+ ticks 1)` +the program stops at that `(+ ...)` — and `C-u C-u C-c C-c` marks the top-level +form itself, which means stopping on entry to it. + +The buffer is not edited. The position goes to the daemon beside the code, and +the `(pause)` call is put into the tree after parsing, so every location in the +file stays exactly where it was and error markers, `M-.` and the debugger keep +pointing at the right place. The marked form is underlined while the mark is on +it. + +When the program reaches it, it stops in the ordinary break loop: `C-c C-b` +shows the stack, and `continue` resumes at the call. Nothing special-cases this +— `pause` is a prelude function that signals a `Pause` condition, so a +breakpoint is just a condition nobody handled. + +**The mark sticks** until you evaluate that form plainly. Mark it, run the game, +hit it as many times as you like; an ordinary `C-c C-c` over the same form (or +`C-c C-k` over the buffer) takes it off. + +`C-u C-x C-e` does the same for the expression before point: it stops *at* the +expression instead of printing its value. That one does not stick, because there +is no definition for it to stick to. + ### `C-c C-k` — the whole buffer The whole buffer, sent as **one** module rather than as a form at a time. That @@ -490,8 +516,10 @@ Use `C-c C-g` if you need frames. | Key | Does | |---|---| | `C-c C-c` | the top-level form at point, recompiled and installed | +| `C-u C-c C-c` | ...and stop at the form point is inside (`C-u C-u`: on entry) | | `C-c C-k` | the whole buffer, as one module | | `C-x C-e` | the expression before point, evaluated in the running program | +| `C-u C-x C-e` | ...and stop at it instead of printing its value | | `C-c C-z` | connect (finds `.flan-dev.sock` upward) | | `C-c C-q` | disconnect | | `C-c C-o` | the running program's own output | diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index c0aadce..4c91f22 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -889,6 +889,22 @@ than being told so." ;; overshooting into the next line would point at innocent code. (min (or p eol) eol)))) +(defun flan-dev--wire-position (pos) + "POS as the (LINE COL) pair the daemon reads off a `:pause' field. + +The inverse of `flan-dev--position', and byte-columns for the same reason: +the reader walks the source a byte at a time, so `current-column' would be +short by one per extra byte in every non-ASCII character earlier on the line +and the daemon would find nothing at the position it was handed. + +The line is the buffer's own, which is what the daemon sees because +`flan-dev--text' pads the snippet back onto it." + (list (line-number-at-pos pos) + (save-excursion + (goto-char pos) + (1+ (- (position-bytes pos) + (position-bytes (line-beginning-position))))))) + (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." @@ -987,6 +1003,62 @@ Returns non-nil when it put an overlay somewhere." (when (eq buf (current-buffer)) (goto-char beg)) t))))))) +;;; Pause marks + +;; The other overlay in this file, and deliberately not the same thing. An +;; error overlay is feedback about the command that just failed and lasts +;; exactly as long as that — the next keystroke takes it away. A pause mark is +;; an *annotation on the running program*: the daemon spliced a `(pause)' call +;; into the declaration it stored, and it will keep stopping there until an +;; ordinary evaluation replaces that declaration. So it must survive +;; `pre-command-hook', and it is not on one. +;; +;; It is drawn from the reply's `:pause' and never from what was asked for. A +;; position that matches no form is refused by the daemon, and an overlay drawn +;; on the request would then be showing a breakpoint that is not there. +;; +;; What clears it is what clears the mark itself: an accepted evaluation with +;; no `:pause' on it, over a region that intersects the mark. `C-c C-k' sends +;; the whole buffer and therefore clears the whole buffer, which is right — +;; every declaration in it was just replaced. + +(defface flan-dev-pause-face + ;; `warning', because `flan-cnr.el' already renders the `Pause' condition in + ;; the conditions buffer as a warning and the two surfaces are about the same + ;; stop. A breakpoint is not a failure. + '((t :inherit warning :underline t)) + "Face for a form the program will stop at." + :group 'flan-dev) + +(defun flan-dev--pause-overlays (&optional buffer) + "The Flan pause overlays in BUFFER, or in the current buffer." + (with-current-buffer (or buffer (current-buffer)) + (seq-filter (lambda (o) (overlay-get o 'flan-dev-pause)) + (overlays-in (point-min) (point-max))))) + +(defun flan-dev-clear-pause (&optional start end) + "Remove pause marks between START and END, or from the whole buffer. +Interactively, the whole buffer: the point of asking is to be rid of them." + (interactive) + (remove-overlays (or start (point-min)) (or end (point-max)) + 'flan-dev-pause t)) + +(defun flan-dev--show-pause (beg end) + "Mark BEG to END as a form the program will stop at." + ;; The old mark first: re-marking a form that was already marked must leave + ;; one overlay, not two stacked ones whose faces compound. + (flan-dev-clear-pause beg end) + (let ((ov (make-overlay beg end nil t nil))) + (overlay-put ov 'flan-dev-pause t) + (overlay-put ov 'face 'flan-dev-pause-face) + (overlay-put ov 'help-echo + "flan: the program stops here; C-c C-c over it to clear") + ;; Under the error overlays, which are about one command and should win + ;; while they are up. + (overlay-put ov 'priority 50) + (overlay-put ov 'evaporate nil) + ov)) + ;;; What the program defines ;; eldoc, completion and find-definition all want the same three things about a @@ -1326,20 +1398,39 @@ of the tenth name tells you neither how many there were nor which." (user-error "flan: %s%s" (or msg "rejected") (if loc (format " (%s)" loc) ""))))) -(defun flan-dev--eval (code what &optional start end) +(defun flan-dev--eval (code what &optional start end pause) "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) - ;; `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))) +START and END, when given, are the region it came from, flashed on success. +PAUSE, when given, is (BEG . END): the bounds of the form inside CODE the +program should stop at. Only BEG goes on the wire — the daemon matches it +against the location the reader attached to that form — and END is what the +mark is drawn over here. Nothing is inserted in the buffer; see DISCUSS.md +§9." + (let ((reply + (flan-dev--request + ;; buffer-file-name so an error points at the file being edited + ;; rather than at the daemon's placeholder. + (append + (list :op "eval" :code code :file (or buffer-file-name "")) + (when pause + (list :pause (flan-dev--wire-position (car pause)))))))) + (flan-dev--report reply 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)) + ;; Drawn off the daemon's echo and not off what was asked for, so a mark + ;; the session refused can never be shown as one it took. And an accepted + ;; evaluation *without* a mark is what takes one down: §9's "cleared by an + ;; ordinary C-c C-c", made visible. By the time this runs the daemon has + ;; already replaced the stored declaration with an unmarked one, so the + ;; overlay is the only thing left claiming a breakpoint. + (cond + ((and pause (plist-get reply :pause)) + (flan-dev--show-pause (car pause) (cdr pause))) + ((and start end) (flan-dev-clear-pause start end))) + reply)) (defun flan-dev--text (start end) "The buffer text from START to END, on the line it is actually written on. @@ -1366,12 +1457,44 @@ columns already were, because a top-level form starts at column 1." (let ((b (flan-dev--defun-bounds))) (buffer-substring-no-properties (car b) (cdr b)))) +(defun flan-dev--pause-bounds (b arg) + "Bounds of the form to mark inside the defun B, for prefix ARG, or nil. + +Two of §9's three targets, off the same key. One `C-u' marks *the form point +is inside* — with the cursor at `(+ 1| 1)' the program stops at that `(+ ...)' +— which is the one you want nine times out of ten, because you put point +where you want to look. Point not nested inside anything, or two `C-u's, +marks the top-level form itself: a `defn' cannot be wrapped in a `do', so the +daemon reads that as stopping on entry instead." + (cond + ((null arg) nil) + ((and (consp arg) (> (prefix-numeric-value arg) 4)) b) + (t (or (save-excursion + (condition-case nil + (progn (backward-up-list) + ;; The top-level form is its own case above; walking out + ;; to it from inside would silently give "stop on entry" + ;; to someone who asked to stop at a sub-expression. + (and (> (point) (car b)) + (cons (point) (progn (forward-sexp) (point))))) + (scan-error nil))) + b)))) + ;;;###autoload -(defun flan-eval-defun () - "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" (car b) (cdr b)))) +(defun flan-eval-defun (&optional arg) + "Recompile the top-level form at point and install it in the running program. + +With a prefix ARG, also mark a form inside it so the program stops there when +it next runs — `C-u' the form point is inside, `C-u C-u' the top-level form +itself, which means stopping on entry. The buffer is not edited: the daemon +is told where the form is and splices the call in after parsing, so every +location in the file stays where it was. The mark sticks until the same form +is evaluated without a prefix." + (interactive "P") + (let* ((b (flan-dev--defun-bounds)) + (pause (flan-dev--pause-bounds b arg))) + (flan-dev--eval (flan-dev--text (car b) (cdr b)) "form" (car b) (cdr b) + pause))) ;;;###autoload (defun flan-eval-buffer () @@ -1380,18 +1503,36 @@ One module, not one per form: a var and the function that uses it have to arrive in the same load or the first refers to storage that does not exist." (interactive) (flan-dev--eval (buffer-substring-no-properties (point-min) (point-max)) - (buffer-name))) + (buffer-name)) + ;; `flan-dev--eval' signals on a rejection, so reaching here means every + ;; declaration in the buffer was just replaced by an unmarked one — and + ;; therefore that every mark in it is gone. Done here rather than by passing + ;; bounds, because those are also what gets flashed and pulsing a whole + ;; buffer is not feedback, it is a flicker. + (flan-dev-clear-pause)) ;;;###autoload -(defun flan-eval-last-sexp () - "Evaluate the expression before point in the running program and show it." - (interactive) +(defun flan-eval-last-sexp (&optional arg) + "Evaluate the expression before point in the running program and show it. + +With a prefix ARG, stop at it instead: the expression is wrapped in a +`(pause)' before it is checked, so the thunk breaks where it stands and the +break loop gets the frame. A flag rather than a position, because the +expression sent *is* the target — and because this path sends a raw +substring, so buffer line numbers would not survive it anyway. + +It does not stick, and cannot: a thunk is built and thrown away, so there is +no declaration for the mark to live in. Nothing is drawn in the buffer for +the same reason." + (interactive "P") (let ((code (buffer-substring-no-properties (save-excursion (backward-sexp) (point)) (point)))) (flan-dev--report (flan-dev--request - (list :op "eval-expr" :code code :file (or buffer-file-name ""))) + (append + (list :op "eval-expr" :code code :file (or buffer-file-name "")) + (when arg (list :pause t)))) "expression"))) ;;;###autoload diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 5084fd3..5ee03f5 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -809,6 +809,144 @@ is written instead — the real `message' call the real command makes." (flan-dev-quit) (ignore-errors (delete-file socket3))) + ;; ── Marking a form with (pause) ─────────────────────────────────────── + ;; + ;; DISCUSS.md §9: `C-u' before an evaluation marks a form so the program + ;; stops when it runs, and the buffer is never edited — the position goes on + ;; the wire beside the code and the daemon splices the call in after parsing. + ;; + ;; Last in this file on purpose: the one live check here *stops the program*, + ;; and everything above it needs one that is running. + ;; + ;; Three things are the client's own and need no daemon at all: which form a + ;; prefix argument picks, the byte column that names it, and the fact that a + ;; mark outlives the next command where a rejection does not. + (with-temp-buffer + (flan-mode) + (insert "(defvar ticks i64)\n\n(defn step [] i64\n (set ticks (+ ticks 1))\n ticks)\n") + (goto-char (point-min)) + (search-forward "(+ ticks 1)") + (goto-char (1- (match-end 0))) ; inside the (+ ...), before its ")" + (let* ((b (flan-dev--defun-bounds)) + (inner (flan-dev--pause-bounds b '(4))) + (whole (flan-dev--pause-bounds b '(16)))) + (test-flan--check "no prefix marks nothing" + (null (flan-dev--pause-bounds b nil))) + (test-flan--check "C-u marks the form point is inside" + (equal (buffer-substring-no-properties + (car inner) (cdr inner)) + "(+ ticks 1)")) + ;; A `defn' is a declaration and cannot be wrapped in a `do', so the + ;; daemon reads the top-level form's own position as "stop on entry". + (test-flan--check "C-u C-u marks the top-level form itself" + (equal whole b))) + ;; Point at the very start of the defn is not nested inside anything, and + ;; `backward-up-list' would either fail or walk somewhere surprising. It + ;; falls back to the defun, which is the only honest answer. + (goto-char (point-min)) + (search-forward "(defn step") + (goto-char (match-beginning 0)) + (let ((b (flan-dev--defun-bounds))) + (test-flan--check "and a prefix with point not nested falls back to it" + (equal (flan-dev--pause-bounds b '(4)) b))) + ;; The column is a byte offset, because the reader walks the source a byte + ;; at a time. Same rule as the `:loc' column, the other way round — and + ;; `flan-dev--position' is the inverse, so a round trip is the check. + (goto-char (point-min)) + (search-forward "(+ ticks 1)") + (let* ((pos (match-beginning 0)) + (lc (flan-dev--wire-position pos))) + (test-flan--check "a marked position round-trips through the wire" + (= (flan-dev--position (nth 0 lc) (nth 1 lc)) pos))) + (with-temp-buffer + (insert ";; héllo\n(defn wörld [] i64 (+ 1 1))\n") + (goto-char (point-min)) + (search-forward "(+ 1 1)") + (test-flan--check "and counts bytes, not characters, past a non-ASCII one" + (equal (flan-dev--wire-position (match-beginning 0)) + (list 2 (1+ (string-bytes "(defn wörld [] i64 "))))))) + + ;; A mark is an annotation on the running program and not feedback about one + ;; command, so unlike a rejection it has to survive the next keystroke. That + ;; difference is the whole of its lifetime, and it is checked here the same + ;; way the rejection's is: by calling what the command loop calls. + (with-temp-buffer + (flan-mode) + (insert "(defn step [] i64 (+ 1 1))\n") + (goto-char (point-min)) + (search-forward "(+ 1 1)") + (flan-dev--show-pause (match-beginning 0) (match-end 0)) + (test-flan--check "a mark is drawn over the form" + (= 1 (length (flan-dev--pause-overlays)))) + (run-hooks 'pre-command-hook) + (test-flan--check "and survives the next command, where a rejection would not" + (= 1 (length (flan-dev--pause-overlays)))) + ;; Re-marking the same form leaves one, not two stacked overlays whose + ;; faces compound into something that is not the face. + (flan-dev--show-pause (match-beginning 0) (match-end 0)) + (test-flan--check "and marking it again leaves one mark, not two" + (= 1 (length (flan-dev--pause-overlays)))) + (flan-dev-clear-pause) + (test-flan--check "and clearing takes it down" + (null (flan-dev--pause-overlays)))) + + ;; And once against a real daemon: the round trip, the overlay drawn off the + ;; reply's `:pause' rather than off what was asked for, and the mark coming + ;; down again when the same form is evaluated plainly. + (let ((socket4 (concat socket "-pause"))) + (ignore-errors (delete-file socket4)) + (flan-dev program socket4) + (test-flan--check "a daemon to mark a form in" + (process-live-p flan-dev--connection)) + (with-temp-buffer + (flan-mode) + (insert "(defn step [] i64\n (set ticks (+ ticks 1))\n ticks)\n") + (goto-char (point-min)) + (search-forward "(+ ticks 1)") + (goto-char (1- (match-end 0))) + (flan-eval-defun '(4)) + (let ((ovs (flan-dev--pause-overlays))) + (test-flan--check "C-u C-c C-c marks the form point is inside" + (and (= 1 (length ovs)) + (equal (buffer-substring-no-properties + (overlay-start (car ovs)) + (overlay-end (car ovs))) + "(+ ticks 1)"))) + (test-flan--check "and marks it as a pause, not as an error" + (and ovs + (eq (overlay-get (car ovs) 'face) + 'flan-dev-pause-face)))) + ;; The program calls `step' every few milliseconds, so it stops almost at + ;; once — but "almost" is not "before this line", so wait for it. + (let ((tries 400)) + (while (and (> tries 0) (not (eq (flan-dev-state) 'stopped))) + (setq tries (1- tries)) + (flan-dev--request (list :op "describe")) + (sleep-for 0.005))) + (test-flan--check "and the program stops there" + (eq (flan-dev-state) 'stopped)) + ;; A plain `C-c C-c' over the same form replaces the stored declaration + ;; with an unmarked one, which is what makes the mark stop sticking — and + ;; the overlay has to go with it or the buffer is claiming a breakpoint + ;; the daemon no longer has. Allowed while stopped: there is no frame in + ;; progress for `step'. + (flan-eval-defun) + (test-flan--check "and an ordinary C-c C-c takes the mark down again" + (null (flan-dev--pause-overlays))) + ;; Left running, because the next thing this file does is finish and the + ;; daemon's program is killed with it — but a test that ends with the + ;; program parked is one nobody can add anything after. + (flan-dev-restart "continue") + (let ((tries 400)) + (while (and (> tries 0) (eq (flan-dev-state) 'stopped)) + (setq tries (1- tries)) + (flan-dev--request (list :op "describe")) + (sleep-for 0.005))) + (test-flan--check "and it resumes when continue is taken" + (not (eq (flan-dev-state) 'stopped)))) + (flan-dev-quit) + (ignore-errors (delete-file socket4))) + (if (zerop test-flan--failures) (message "flan-dev.el: all tests passed") (message "\n%d failure(s)" test-flan--failures) diff --git a/lib/dev.ml b/lib/dev.ml index 8e763f5..2ae1c31 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -477,10 +477,10 @@ let eval t ~code ~origin ~pause = install into, so the module carries a thunk the agent runs once. The value comes back through the runtime rather than through this reply, because the frame boundary it runs at is the program's to choose. *) -let eval_expr t ~code ~origin = +let eval_expr t ~code ~origin ~pause = if not (alive t) then error "the program exited; restart flan dev" else - match Session.eval_expr ~origin t.session code with + match Session.eval_expr ~origin ~pause t.session code with | c -> let before = match result t with Some (g, _) -> g | None -> 0L in t.n <- t.n + 1; @@ -492,17 +492,38 @@ let eval_expr t ~code ~origin = | _ -> (match deliver t out with | "ok" -> + (* Three-way, and the middle case exists only because of [:pause]. + A thunk that stopped in the break loop produces no value and + never will until someone resumes it — which is exactly what a + program that never reached a frame boundary looks like from + here. Reporting the timeout for it would call the working + feature a failure. + + The [Stopped] question is asked only when a pause was requested. + Without one, a thunk that stops did so by erroring, and the + timeout message is the answer that path has always given — + which [test_dev.ml] pins. *) + let stopped () = + pause && (match state t with Stopped _ -> true | _ -> false) + in let rec wait ms = match result t with - | Some (g, v) when Int64.compare g before > 0 -> Some v - | _ when ms <= 0 -> None + | Some (g, v) when Int64.compare g before > 0 -> `Value v + | _ when stopped () -> `Stopped + | _ when ms <= 0 -> `Timeout | _ -> ignore (Unix.select [] [] [] 0.005); - if alive t then wait (ms - 5) else None + if alive t then wait (ms - 5) else `Timeout in (match wait 5000 with - | Some v -> ok [ ":value " ^ Wire.quote v ] - | None -> + | `Value v -> ok [ ":value " ^ Wire.quote v ] + (* No [:value], because there is not one yet and there will not be + one until the break is resumed. [:stopped t :condition "Pause"] + rides on this reply as it does on every other — [with_break] + puts it there — so the editor already has what it needs, and + the note says which of the two silences this is. *) + | `Stopped -> ok [ ":note " ^ Wire.quote "stopped at (pause)" ] + | `Timeout -> error "the program did not reach a frame boundary; is it calling \ (agent/poll)?") @@ -1690,7 +1711,17 @@ let handle t req = let origin = match Wire.string_field req "file" with Some f -> f | None -> "" in - eval_expr t ~code ~origin + (* [:pause t], a flag, where [eval] takes a position: the editor sends + [C-x C-e]'s text as a raw substring with no line padding, so buffer + coordinates do not survive that path — and they are not needed, since + the expression sent is the whole of the target. Absent or [nil] is + false and anything else true, the same spelling [:on] uses. *) + let pause = + match Wire.field req "pause" with + | Some { Form.v = Form.Sym "nil"; _ } | None -> false + | Some _ -> true + in + eval_expr t ~code ~origin ~pause | None -> error "eval-expr needs :code") | Some "describe" -> describe t | Some "defs" -> defs t diff --git a/lib/session.ml b/lib/session.ml index 8d3a03e..3218d1e 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -985,14 +985,32 @@ let render_globals ?(origin = "") t ~(globals : Tast.global list) ignore origin; ({ ir; names = []; fns = []; installs = true }, List.rev !refused) -let eval_expr ?(origin = "") t src : change = +(* [pause] is [C-u C-x C-e] — §9's "last expression" target. It is a flag and + not a position, because there is only one form here and it is the whole of + what was sent: the expression *is* the target. It is also why nothing here + sticks — a thunk is built and thrown away, so the mark lasts exactly one + evaluation, which is the truthful thing for an expression that has no + declaration to live in. *) +let eval_expr ?(origin = "") ?(pause = false) t src : change = let form = match Reader.read_all ~file:origin src with | [ f ] -> f | [] -> fail Loc.unknown "nothing to evaluate" | _ :: f :: _ -> fail f.Form.loc "one expression at a time" in - let checked, base, bnames = Check.expression t.env (Parse.expr form) in + let parsed = Parse.expr form in + (* Wrapped before the checker, so the call is checked like any other and a + prelude that stopped offering [pause] would be an ordinary unknown name + rather than a thunk that silently did not stop. The [Do] takes the + expression's own location for the reason [Ast.mark_pause] does: the frame + the break loop reports reads it. *) + let parsed = + if pause then + { Ast.e = Ast.Do [ Ast.pause_call parsed.Ast.loc; parsed ]; + Ast.loc = parsed.Ast.loc } + else parsed + in + let checked, base, bnames = Check.expression t.env parsed in (* The thunk's frame starts at whatever [Check.expression] needed and grows as the walk finds slices in it, so the slots the renderer asks for are appended past [base] and collected here to size the frame below. *) diff --git a/test/programs/dev-pause.flan b/test/programs/dev-pause.flan new file mode 100644 index 0000000..9f5afb0 --- /dev/null +++ b/test/programs/dev-pause.flan @@ -0,0 +1,24 @@ +;;;; A program to set a breakpoint in, for driving `C-u C-c C-c' from an editor. +;;;; +;;;; Unlike dev-break.flan it does not stop on its own: it starts running and +;;;; keeps running, because the claim being tested is that marking a form is +;;;; what stops it. Anything already stopped would prove nothing. +;;;; +;;;; What it needs is a function that keeps being called, so that a mark set +;;;; after startup is hit, and hit again after the mark is cleared. dev-loop.flan +;;;; calls [step] four times, which is too tight for that; this is dev-break.flan's +;;;; tail with nothing in front of it. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn step [] i64 + (set ticks (+ ticks 1)) + ticks) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-pause-fallback.sock") + (dotimes [i 4000] + (agent/wait 5) + (set ticks (step))) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index 303d57c..b184eac 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -2054,6 +2054,208 @@ let () = (try ignore (Unix.waitpid [] wpid) with Unix.Unix_error _ -> ()); List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ wsock; wout ]; + (* ── Marking a form with (pause), from the editor's side ───────── *) + + (* DISCUSS.md §9: C-u before an evaluation marks a form so the program + stops when it runs. The mark travels as a *position* beside the code + rather than spliced into it — splicing text would move every line and + column after the insertion, and the error overlays, the break loop's + frame locations and DWARF all read those. + + Two claims, and the second is the one worth the daemon: + + a marked form stops the program where it was marked, on the prelude's + own Pause with its own [continue] restart — nothing in the compiler + knows about breakpoints; + + and it *sticks*, until the same form is evaluated plainly. That is + §9's settled behaviour, and the half that is easy to leave untested: + one stop proves the splice, not the storage. + + Its own daemon over its own program, for the reason every block here + has one. [dev-pause.flan] starts running and keeps running: a program + already stopped would prove nothing about what stopped it. *) + let psock = tmp "pause.sock" and pout = tmp "pause.out" in + (try Sys.remove psock with Sys_error _ -> ()); + let pfd = + Unix.openfile pout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let ppid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-pause.flan"; "-s"; psock |] + Unix.stdin pfd Unix.stderr + in + Unix.close pfd; + if not (await (fun () -> Sys.file_exists psock)) then begin + fail "the pause daemon never listened"; + (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let poutput = Buffer.create 256 in + let c = connect psock in + let ask sexp = + let r = Wire.parse (Wire.send c sexp; Wire.recv c) in + (match Wire.string_field r "output" with + | Some t -> Buffer.add_string poutput t + | None -> ()); + r + in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + (* One line, so the position is line 1 and a column, and the column is + derived from the text rather than counted by hand: a miscount would + come back as "nothing to pause at", which reads like a broken feature + rather than a broken test. *) + let body = "(defn step [] i64 (set ticks (+ ticks 1)) ticks)" in + let target = "(+ ticks 1)" in + let col = + let n = String.length target in + let rec find i = + if i + n > String.length body then 0 + else if String.equal (String.sub body i n) target then i + 1 + else find (i + 1) + in + find 0 + in + if col = 0 then fail "the pause test cannot find its own target"; + (* Running when it arrives, which is what makes the stop below mean + something. *) + if stopped (ask "(:op \"describe\")") then + fail "the pause program was already stopped before anything marked it"; + let marked = + ask + (Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\" :pause (1 %d))" + (Wire.quote body) col) + in + if status marked <> "ok" then + fail "marking a sub-expression: %s" + (Option.value ~default:"" (Wire.string_field marked "message")) + else begin + (* Echoed back, so an editor draws its overlay off a mark the session + actually applied and can never claim one that was refused. *) + if Wire.string_field marked "pause" <> Some (Printf.sprintf "1:%d" col) + then + fail "an accepted mark did not echo its position: %s" + (Option.value ~default:"" (Wire.string_field marked "pause")); + let last = ref marked in + if not + (await (fun () -> + last := ask "(:op \"describe\")"; + stopped !last)) + then fail "a marked form never stopped the program" + else begin + (* The prelude's own condition. Nothing in the compiler knows what a + breakpoint is: [(pause)] is [error] under a [restart-case], so the + break loop this lands in is the one an unhandled condition already + builds. *) + (match Wire.string_field !last "condition" with + | Some "Pause" -> () + | c -> + fail "a marked form stopped on %S, wanted %S" + (Option.value ~default:"" c) "Pause"); + let r = ask "(:op \"break\")" in + let names = + match Wire.field r "restarts" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (n : Form.t) -> + match n.Form.v with Form.Str x -> Some x | _ -> None) + l + | _ -> [] + in + if not (List.exists (String.equal "continue") names) then + fail "a break at (pause) offers %s, wanted continue among them" + (String.concat ", " names); + + (* The second claim, and the one this block exists for. A plain + re-evaluation of the same form replaces the stored declaration + with an unmarked one — that single statement is the whole of + "it sticks until evaluated plainly", and nothing else holds the + mark. Sent while stopped, which the break loop allows: there is + no frame in progress for [step]. *) + let r = + ask + (Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/buf.flan\")" + (Wire.quote body)) + in + if status r <> "ok" then + fail "re-evaluating a marked form plainly: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if Wire.field r "pause" <> None then + fail "a plain evaluation echoed a pause position"; + let r = ask "(:op \"restart\" :name \"continue\")" in + if status r <> "ok" then + fail "continue at a breakpoint: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) + then fail "the program never resumed from its breakpoint" + else begin + (* And then it has to *stay* running. A single sample proves + nothing: the frame that resumed is still in the old marked body, + past the [(pause)] call, so the first look is running whether + or not the mark was cleared. The program calls [step] every 5ms, + so half a second of polling is a hundred calls through the body + just installed — and if the mark were still there, one of them + would stop. *) + let deadline = Unix.gettimeofday () +. 0.5 in + let rec run_on () = + if Unix.gettimeofday () > deadline then () + else if stopped (ask "(:op \"describe\")") then + fail "the mark was still there after a plain re-evaluation" + else begin + ignore (Unix.select [] [] [] 0.01); + run_on () + end + in + run_on () + end + end + end; + (* C-u C-x C-e: the same feature for §9's "last expression" target, and + a flag rather than a position because the expression sent is the + whole of it. The reply it must *not* give is the timeout, which is + what a thunk parked in the break loop looks like from the daemon's + side and what this path used to answer. *) + let r = + ask + "(:op \"eval-expr\" :code \"(+ 20 3)\" :file \"/tmp/buf.flan\" :pause t)" + in + if status r <> "ok" then + fail "C-u C-x C-e was reported as a failure: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if Wire.string_field r "value" <> None then + fail "an expression that stopped at (pause) answered with a value"; + if not (stopped r) then + fail "an expression that stopped at (pause) did not say so"; + if Wire.string_field r "condition" <> Some "Pause" then + fail "C-u C-x C-e stopped on %s, wanted Pause" + (Option.value ~default:"" (Wire.string_field r "condition")); + (* It does not stick, and cannot: a thunk is built and thrown away, so + taking [continue] leaves nothing marked behind it. *) + let r = ask "(:op \"restart\" :name \"continue\")" in + if status r <> "ok" then + fail "continue at an expression's breakpoint: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the program never resumed from an expression's breakpoint" + else begin + let r = + ask "(:op \"eval-expr\" :code \"(+ 2 2)\" :file \"/tmp/buf.flan\")" + in + if Wire.string_field r "value" <> Some "4" then + fail "an ordinary expression after a paused one: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + end; + ignore (ask "(:op \"close\")"); + Unix.close c + end; + (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] ppid) with Unix.Unix_error _ -> ()); + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ psock; pout ]; + (* ── The escape hatch, which still has to work ─────────────────── *) (* [--two-process] is the old shape: a compiler process that builds the From f2be0a62dd626d5c5ce09dd940ee6c407b27b7c2 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 13:07:25 +0700 Subject: [PATCH 2/2] A pause is waited for by name, and a build is not a socket MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two follow-ups to the marking commit. `Dev.eval_expr`'s new wait matched `Stopped _`, which fires on the first iteration when the program is already parked on something else — the break loop allows evaluating, so that is reachable — and answers for a thunk that has not run yet, on a reply whose own `:condition` names the other condition. It now waits for `Stopped "Pause"`, which the agent reports under a nested break because `condition_name` is overwritten on the way in and restored on the way out. `dev-pause.flan` grows a `Missing` and a `boom` so the test can park the program on something else first and tell the two apart. And the flake NEXT.md had as "seen once and unexplained": `the daemon never listened` is not a race, it is an llc-and-link of the whole program before `flan dev` binds — ~600ms idle, measured at 6.6s and 6.8s with the rest of the suite beside it, against a 5s and 8s await. All three test binaries now wait a minute; the watchdog is what bounds the run. Two consecutive full runs green. --- BUILT.md | 8 ++++ NEXT.md | 12 ++++-- lib/dev.ml | 17 +++++++- test/programs/dev-pause.flan | 12 ++++++ test/test_dev.ml | 82 ++++++++++++++++++++++++++++++------ test/test_emacs.ml | 7 ++- test/test_repl.ml | 8 +++- 7 files changed, 126 insertions(+), 20 deletions(-) diff --git a/BUILT.md b/BUILT.md index fa3a513..421fd9d 100644 --- a/BUILT.md +++ b/BUILT.md @@ -4941,6 +4941,14 @@ and the timeout message is the answer that path has always given — `test_dev.m carries no `:value`, because there is not one yet; `:stopped t :condition "Pause"` rides on it the way it rides on every reply, from `with_break`. +**And it asks for `Stopped "Pause"` by name, not for "stopped at all".** The break loop allows evaluating, so this +path is reachable from a program already parked on something else — and a match on `Stopped _` would then fire on the +first iteration, answering for a thunk that has not run yet, on a reply whose own `:condition` names the *other* +condition. Asked by name it waits through the outer break until the thunk reaches its own `(pause)`, which the agent +reports because a nested break overwrites `condition_name` and restores it on the way out (`flan_agent.c`, around the +`status` verb). A program already parked on a `Pause` is the one case this cannot tell apart, and nothing could: both +answers are "stopped at a pause". + **The editor's column is a byte offset.** `flan-dev--wire-position` is the inverse of `flan-dev--position` and has to count bytes for the same reason: the reader walks the source a byte at a time, so `current-column` would be short by one per extra byte in every non-ASCII character earlier on the line and the daemon would find nothing where it was diff --git a/NEXT.md b/NEXT.md index de90b07..20d9cc2 100644 --- a/NEXT.md +++ b/NEXT.md @@ -24,10 +24,14 @@ The fix is ordering, not timing: the test checked for `agent.sock` before comple the check took it from 2/8 failures to 0/10, and closed a second race that was burning the full 10s timeout. `lib/dev.ml` was not touched. -1. **A different flake, seen once and unexplained.** `the daemon never listened` — that exact wording comes from - `test_emacs.ml:50` and `test_repl.ml:71`, not from the block that was fixed, whose other daemons all use - qualified wording. Probably the same class of bug, a bounded `await` on a socket path under parallel-dune CPU - contention, but that is a hypothesis. Loop `dune test` capturing per-binary output to pin it down. +1. ~~**A different flake, seen once and unexplained.** `the daemon never listened`~~ **Diagnosed and fixed.** The + hypothesis was right and it is not a race at all: the wait is not for a socket but for an llc-and-link of the + whole program before `flan dev` binds. That is ~600ms idle and was measured twice at **6.6s and 6.8s** with the + rest of the suite running beside it under dune's own parallelism, against a 5s (`test_dev.ml`) and 8s + (`test_emacs.ml`, `test_repl.ml`) `await`. The message reads like a bug in the daemon and is a build slower than + the timeout. All three now wait a minute — the watchdog is what bounds the run, and this only has to be long + enough that a failure means the daemon is not coming. `test_dev.ml` has a named `listening` for it so the reason + is written once for its thirteen daemons. 2. **Decide whether `merged_serve`'s 10s warning path deserves a test.** `lib/dev.ml:2322-2326` is exercised by nothing now that the unlink race is closed. 3. **Confirm at a longer sweep if 0/10 is too thin, then delete this file's "One flaky test, measured rather than diff --git a/lib/dev.ml b/lib/dev.ml index 2ae1c31..04db953 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -502,9 +502,22 @@ let eval_expr t ~code ~origin ~pause = The [Stopped] question is asked only when a pause was requested. Without one, a thunk that stops did so by erroring, and the timeout message is the answer that path has always given — - which [test_dev.ml] pins. *) + which [test_dev.ml] pins. + + And it asks for [Pause] by name, not for "stopped at all". The + break loop allows evaluating, so this is reachable from a + program already parked on something else — and [Stopped _] would + then answer for a thunk that has not run yet, on a reply whose + own [:condition] says the other condition's name. Asked by name + it waits through the outer break until the thunk reaches its own + [(pause)], which the agent reports because a nested break + overwrites [condition_name] and restores it on the way out. + + A program already parked on a [Pause] is the one case this + cannot tell apart, and nothing could: both answers are "stopped + at a pause". *) let stopped () = - pause && (match state t with Stopped _ -> true | _ -> false) + pause && (match state t with Stopped "Pause" -> true | _ -> false) in let rec wait ms = match result t with diff --git a/test/programs/dev-pause.flan b/test/programs/dev-pause.flan index 9f5afb0..901836f 100644 --- a/test/programs/dev-pause.flan +++ b/test/programs/dev-pause.flan @@ -12,6 +12,18 @@ (defvar ticks i64) +;;; Something to stop on that is *not* a breakpoint, so that a marked +;;; expression sent to an already-stopped program can be told from the break it +;;; was already sitting in. It is here rather than in an evaluated form for the +;;; reason dev-loop.flan gives: the break loop matches on a class the host was +;;; compiled with. +(defstruct Missing [id i32]) + +(defn boom [] i64 + (restart-case + (do (error (Missing {.id 1})) 0) + (carry-on [] -1))) + (defn step [] i64 (set ticks (+ ticks 1)) ticks) diff --git a/test/test_dev.ml b/test/test_dev.ml index b184eac..32fff3e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -23,6 +23,19 @@ let rec await ?(ms = 5000) f = else if ms <= 0 then false else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end +(* Waiting for a daemon to listen is not waiting for a socket: [flan dev] + compiles the whole program first, and only then binds. The build is llc and + a link, which is ~600ms on an idle machine and has been measured at 6.8s + with this suite's other binaries running beside it under dune's own + parallelism — so the 5s default turned a busy machine into "the daemon never + listened", a message that reads like a bug in the daemon and is not one. + + A minute is not a guess about how slow the build can get; it is long enough + that a failure here means the daemon is not coming, which is the only thing + this check is trying to find out. The watchdog is the thing that bounds the + run, and it is armed at 900s for exactly this reason. *) +let listening path = await ~ms:60000 (fun () -> Sys.file_exists path) + let rec connect ?(ms = 5000) path = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in match Unix.connect s (Unix.ADDR_UNIX path) with @@ -73,7 +86,7 @@ let () = in Unix.close fd; - if not (await (fun () -> Sys.file_exists sock)) then + if not (listening sock) then fail "the daemon never listened" else begin (* The daemon owns the program's lifetime and kills it on [close], so @@ -408,7 +421,7 @@ let () = Unix.stdin bfd Unix.stderr in Unix.close bfd; - if not (await (fun () -> Sys.file_exists bsock)) then begin + if not (listening bsock) then begin fail "the break daemon never listened"; (try Unix.kill bpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -800,7 +813,7 @@ let () = Unix.stdin xfd Unix.stderr in Unix.close xfd; - if not (await (fun () -> Sys.file_exists xsock)) then begin + if not (listening xsock) then begin fail "the bad-index daemon never listened"; (try Unix.kill xpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -928,7 +941,7 @@ let () = Unix.stdin lfd Unix.stderr in Unix.close lfd; - if not (await (fun () -> Sys.file_exists lsock)) then begin + if not (listening lsock) then begin fail "the locals daemon never listened"; (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1109,7 +1122,7 @@ let () = Unix.stdin ifd Unix.stderr in Unix.close ifd; - if not (await (fun () -> Sys.file_exists isock)) then begin + if not (listening isock) then begin fail "the inspect daemon never listened"; (try Unix.kill ipid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1313,7 +1326,7 @@ let () = Unix.stdin gfd Unix.stderr in Unix.close gfd; - if not (await (fun () -> Sys.file_exists gsock)) then begin + if not (listening gsock) then begin fail "the globals daemon never listened"; (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1536,7 +1549,7 @@ let () = Unix.stdin dfd Unix.stderr in Unix.close dfd; - if not (await (fun () -> Sys.file_exists dsock)) then begin + if not (listening dsock) then begin fail "the disassembly daemon never listened"; (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1764,7 +1777,7 @@ let () = env Unix.stdin sfd Unix.stderr in Unix.close sfd; - if not (await (fun () -> Sys.file_exists ssock)) then begin + if not (listening ssock) then begin fail "the daemon with no working llc never listened"; (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1832,7 +1845,7 @@ let () = Unix.stdin gfd Unix.stderr in Unix.close gfd; - if not (await (fun () -> Sys.file_exists gsock)) then begin + if not (listening gsock) then begin fail "the --debug daemon never listened"; (try Unix.kill gpid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -1915,7 +1928,7 @@ let () = Unix.stdin wfd Unix.stderr in Unix.close wfd; - if not (await (fun () -> Sys.file_exists wsock)) then + if not (listening wsock) then fail "the watch daemon never listened" else begin let wc = connect wsock in @@ -2086,7 +2099,7 @@ let () = Unix.stdin pfd Unix.stderr in Unix.close pfd; - if not (await (fun () -> Sys.file_exists psock)) then begin + if not (listening psock) then begin fail "the pause daemon never listened"; (try Unix.kill ppid Sys.sigkill with Unix.Unix_error _ -> ()) end @@ -2249,6 +2262,51 @@ let () = fail "an ordinary expression after a paused one: %s" (Option.value ~default:(status r) (Wire.string_field r "message")) end; + + (* And the same key on a program that is *already* stopped, which the + break loop allows. The wait has to be looking for a [Pause] and not + for "stopped at all": the outer break is already there when the + request arrives, so anything less specific would answer for a thunk + that has not run yet — and answer it on a reply whose own + [:condition] names the other condition. *) + let r = + ask "(:op \"eval-expr\" :code \"(i64 (boom))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "an expression that erred inside a thunk answered anyway"; + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "the program never stopped on the expression that errs" + else begin + let r = + ask + "(:op \"eval-expr\" :code \"(+ 5 5)\" :file \"/tmp/buf.flan\" :pause t)" + in + if Wire.string_field r "condition" <> Some "Pause" then + fail + "C-u C-x C-e on an already-stopped program answered for %s, not Pause" + (Option.value ~default:"" (Wire.string_field r "condition")); + if Wire.string_field r "value" <> None then + fail "C-u C-x C-e under an outer break answered with a value"; + (* Innermost first, so this is the thunk's own [continue] and not + anything the outer break offers. *) + let r = ask "(:op \"restart\" :name \"continue\")" in + if status r <> "ok" then + fail "continue at a breakpoint under an outer break: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + (* Back on the outer break, which was never resumed, and out of it the + ordinary way. *) + if not + (await (fun () -> + Wire.string_field (ask "(:op \"describe\")") "condition" + = Some "Missing")) + then fail "the outer break did not come back after the inner pause"; + let r = ask "(:op \"restart\" :name \"carry-on\")" in + if status r <> "ok" then + fail "resuming the outer break: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the program never resumed from the outer break" + end; ignore (ask "(:op \"close\")"); Unix.close c end; @@ -2276,7 +2334,7 @@ let () = Unix.stdin tfd Unix.stderr in Unix.close tfd; - if not (await (fun () -> Sys.file_exists tsock)) then + if not (listening tsock) then fail "--two-process never listened" else begin let tc = connect tsock in diff --git a/test/test_emacs.ml b/test/test_emacs.ml index b2ffdc0..25ffdcf 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -46,7 +46,12 @@ let () = Unix.stdin fd Unix.stderr in Unix.close fd; - if not (await (fun () -> Sys.file_exists sock)) then begin + (* A minute, not the 8s default: what is being waited for is not a socket + but an llc-and-link of the whole program, which has been measured at + 6.8s with this suite's other binaries running beside it under dune's own + parallelism. It only has to be long enough that a failure here means the + daemon is not coming; the watchdog is what bounds the run. *) + if not (await ~ms:60000 (fun () -> Sys.file_exists sock)) then begin print_endline "FAIL the daemon never listened"; (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ()); exit 1 diff --git a/test/test_repl.ml b/test/test_repl.ml index f642277..5e0a1d5 100644 --- a/test/test_repl.ml +++ b/test/test_repl.ml @@ -68,7 +68,13 @@ let () = Unix.stdin fd Unix.stderr in Unix.close fd; - if not (await (fun () -> Sys.file_exists sock)) then fail "the daemon never listened" + (* A minute, not the 8s default: what is being waited for is not a socket + but an llc-and-link of the whole program, which has been measured at + 6.8s with this suite's other binaries running beside it under dune's own + parallelism. It only has to be long enough that a failure here means the + daemon is not coming; the watchdog is what bounds the run. *) + if not (await ~ms:60000 (fun () -> Sys.file_exists sock)) then + fail "the daemon never listened" else begin let c = connect sock in let evals code =