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

Merge branch 'worktree-agent-a7fa4f6e37607b13b' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 13:46:47 +07:00
commit 72d6b8b00e
12 changed files with 823 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
BUILT.md
View File

@ -4887,3 +4887,89 @@ 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) <span>)`. 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`.
**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
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.

142
HANDOFF-f2.md
View File

@ -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) <span>)`".** 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.

39
NEXT.md
View File

@ -87,23 +87,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
@ -112,10 +101,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
@ -338,10 +331,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.

28
emacs/MANUAL.md
View File

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

177
emacs/flan-dev.el
View File

@ -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
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.
(list :op "eval" :code code :file (or buffer-file-name "<buffer>")))
what)
;; 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 "<buffer>"))
(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)))
(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 "<buffer>")))
(append
(list :op "eval-expr" :code code :file (or buffer-file-name "<buffer>"))
(when arg (list :pause t))))
"expression")))
;;;###autoload

138
emacs/test-flan-dev.el
View File

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

60
lib/dev.ml
View File

@ -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,51 @@ 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.
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 "Pause" -> 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 +1724,17 @@ let handle t req =
let origin =
match Wire.string_field req "file" with Some f -> f | None -> "<editor>"
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

22
lib/session.ml
View File

@ -985,14 +985,32 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
ignore origin;
({ ir; names = []; fns = []; installs = true }, List.rev !refused)
let eval_expr ?(origin = "<eval>") 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 = "<eval>") ?(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. *)

36
test/programs/dev-pause.flan Normal file
View File

@ -0,0 +1,36 @@
;;;; 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)
;;; 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)
(defn main [] i32
(agent/start "/tmp/flan-dev-pause-fallback.sock")
(dotimes [i 4000]
(agent/wait 5)
(set ticks (step)))
0)

282
test/test_dev.ml
View File

@ -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
@ -2054,6 +2067,253 @@ 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 (listening 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:"<none>" (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:"<none>" 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:"<none>" (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;
(* 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:"<none>" (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;
(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
@ -2074,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

7
test/test_emacs.ml
View File

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

8
test/test_repl.ml
View File

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