diff --git a/TODO.org b/TODO.org index 920de488..fc3a0b45 100644 --- a/TODO.org +++ b/TODO.org @@ -1562,8 +1562,10 @@ CLOSED: [2026-09-25] =(watch "name" v)= is a checker arm beside =print=, sharing its render context with the emitter aimed at the watch slot, so any value watches as it prints. The value is evaluated once, before the table is asked whether it is armed, so the -program behaves the same with or without a watch buffer open. The =declare-c= -scalar entry points stay. See docs/BUILT.md, "The scalar entry points, and the +program behaves the same with or without a watch buffer open. Outside a dev +build, and always in the JS dialect, the backend drops everything but the +value's evaluation, so a release build makes no call. The =declare-c= scalar +entry points stay. See docs/BUILT.md, "The scalar entry points, and the form for everything else". ** DONE Two ways to root a walk @@ -1815,8 +1817,9 @@ frame's names and types. CLOSED: [2026-09-25] A frame whose location is == is hidden by default, and a line in its place counts the hidden run; =P= shows them. A hidden frame keeps its index, -because =locals= and the inspector are asked by it. Rules out renumbering the -visible frames. +because =locals= and the inspector are asked by it. The innermost frame is +shown even when it is the prelude's, unless the stop is =(pause)=, because it +is where the program stopped. Rules out renumbering the visible frames. ** TODO There is no stepper =(pause)= stops and offers restarts, frames, locals and the inspector, but diff --git a/docs/BUILT.md b/docs/BUILT.md index ef79239e..03cd3061 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -5441,8 +5441,14 @@ So the cost of a watch call in a program nobody is debugging is **one relaxed lo is the same number in a release build as in a dev one: `flan_dev.c` is linked into every build (`Build`, which says why), so the symbols resolve either way and there is no second version of the file. -It is not *free*, and the distinction is worth keeping honest. The `(watch ...)` form below still makes the call, and -still evaluates its value, so a load and a branch per watched value per frame is the real number. +It is not *free*, and the distinction is worth keeping honest: a load and a branch per watched value per frame is the +real number for a scalar entry point, in either build. The `(watch ...)` form below costs that in a dev build and +nothing but its value's evaluation in any other, because the checker wraps the render in an `If` on +`flan_dev_watch_begin_n` and each backend lowers that `If` to its unit else branch when the build is not a dev one +(`Tast.is_watch_guard`). The checker does not know which build it is checking for, so the drop has to be the +backend's, the way the allocation registry's notes are. The JS dialect always drops it: there is no watch table there. +Measured on a 200-million-iteration loop at `-O2`: 0.53s with the call, 0.00s without it, the same as the loop with no +`watch` in it. ### The scalar entry points, and the form for everything else diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index a20ab958..252b2fc6 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -382,7 +382,9 @@ program was running, abandon and call the code again. **The stack.** Frames are numbered innermost first. A frame of a prelude function — `pause` is one, so every breakpoint has one — is hidden, and a line in its place says how many were hidden; `P` shows them. A hidden frame keeps -its number, so the numbers either side of it have a gap. +its number, so the numbers either side of it have a gap. The innermost frame is +where the program stopped, so it is shown even when it belongs to the prelude, +unless the stop is a `(pause)`. A frame's location is where its function is written, and the `at` line under the condition is the expression that stopped. `RET` on either opens that file @@ -718,9 +720,11 @@ to see what the last frame held. **What it costs when you are not watching.** Nothing writes the table until a watch buffer is open; `M-x flan-watch` tells the program somebody is looking -and closing it tells the program to stop. So a `watch-i64` call in a program -nobody is debugging is a load and a branch that is not taken, in a release -build as in a dev one. +and closing it tells the program to stop. So in a dev build a `watch` nobody is +looking at costs a load and a branch that is not taken. In a release build +`watch` makes no call at all: the value is evaluated and nothing else happens. +A scalar entry point called through `declare-c` is an ordinary C call and costs +the load and the branch in either build. **The limits.** The table holds **64 names**, and names past that are dropped rather than being fatal — the buffer says how many, because a value that simply diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 1d83ac5d..e18f0350 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -67,6 +67,7 @@ (declare-function flan--request "flan" (form)) (declare-function flan-visit-loc "flan" (loc subject)) +(declare-function flan--forget-break-stack "flan" ()) (declare-function flan-inspect "flan-inspect" (expr)) (declare-function flan-inspect-slot "flan-inspect" (frame slot name)) @@ -399,7 +400,14 @@ breakpoint the program's author wrote, not a step of the program." ;; A hidden frame keeps its number. The index is what `locals' and ;; the inspector are asked by, so the frames either side of a hidden ;; run are numbered with a gap, and the line in the gap says why. - (if (and (not flan-cnr--show-prelude) (flan-cnr--prelude-frame-p fr)) + ;; + ;; The innermost frame is where the program stopped, so it is shown + ;; even when it is the prelude's — unless the stop is `(pause)', + ;; whose own frame is the breakpoint and not where anything failed. + (if (and (not flan-cnr--show-prelude) + (flan-cnr--prelude-frame-p fr) + (or (> i 0) + (equal (plist-get state :condition) flan-cnr-breakpoint))) (setq hidden (1+ hidden)) (when (> hidden 0) (flan-cnr--insert-hidden hidden) @@ -647,6 +655,11 @@ visits the source of the one it lands on." (flan-visit-loc (get-text-property found 'flan-cnr-loc) (flan-cnr--loc-subject found)))) +(defun flan-cnr--forget () + "The stack this buffer drew is gone; stop `next-error' walking it." + (when (eq next-error-last-buffer (current-buffer)) + (setq next-error-last-buffer nil))) + (defun flan-cnr--invoke (index name) "Take restart INDEX, named NAME. By index, because the index is the identity — two frames can offer `retry' @@ -662,6 +675,7 @@ different restart than the one it showed." ;; buffer says so and goes, rather than redrawing a state that is about ;; to stop being true. (progn (message "flan: %s — %s" name (or (plist-get r :note) "accepted")) + (flan-cnr--forget) (quit-window)) (user-error "flan: %s" (or (plist-get r :message) "refused"))))) @@ -688,7 +702,9 @@ different restart than the one it showed." (interactive) (let ((r (funcall flan-cnr-request-function '(:op "abort")))) (if (equal (plist-get r :status) "ok") - (progn (message "flan: %s" (or (plist-get r :note) "aborted")) (quit-window)) + (progn (message "flan: %s" (or (plist-get r :note) "aborted")) + (flan-cnr--forget) + (quit-window)) (user-error "flan: %s" (or (plist-get r :message) "refused"))))) (defun flan-cnr-toggle-frame () @@ -1032,8 +1048,9 @@ walk from a running program." (flan-cnr-backtrace) (flan-cnr-globals))) ;; So `M-g M-n' from the source buffer walks this stack rather than - ;; the last compilation's errors, for as long as the program is - ;; stopped here. + ;; the last compilation's errors. Taken back when a restart or an + ;; abort is accepted, here or from `flan.el', and when the poll sees + ;; the program running again: see `flan--forget-break-stack'. (setq next-error-last-buffer buf)) (pop-to-buffer buf) buf))) diff --git a/emacs/flan-watch.el b/emacs/flan-watch.el index 89f11177..3b013653 100644 --- a/emacs/flan-watch.el +++ b/emacs/flan-watch.el @@ -168,9 +168,8 @@ was the only consumer and wrong the moment it was not.") ;; both are painted from the same reply, in `flan-watch--absorb'. ;; ;; WHERE A VALUE ATTACHES. The table carries a name and a rendered string and -;; no source location, and it is not going to grow one here — that needs a -;; `(watch ...)' form in the checker, which is a file this does not own. But a -;; location is not actually missing: `(watch-i64 "hp" hp)' is *in the buffer*, +;; no source location. A location is not actually missing: `(watch "hp" hp)' +;; or `(watch-i64 "hp" hp)' is *in the buffer*, ;; and the name in the table is the string literal in it. So the anchor is ;; found by searching the text rather than by being told, which costs one ;; regexp scan per displayed buffer per repaint and needs nothing new from the diff --git a/emacs/flan.el b/emacs/flan.el index 1db19f22..2efbfd6c 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -484,6 +484,7 @@ with it, and a rejected evaluation is a likely moment to *become* stopped." (setq flan--stopped now) (unless (equal was now) (force-mode-line-update t) + (unless now (flan--forget-break-stack)) ;; Once, on the edge. A message every poll would bury whatever else the ;; echo area was saying, every second, for as long as the program sat ;; there. @@ -1170,6 +1171,7 @@ apart, so a prompt cannot take a different restart than the one it showed." (progn ;; Accepted, not resumed — see `flan-restart'. (setq flan--stopped nil) + (flan--forget-break-stack) (force-mode-line-update t) (message "flan: %s — %s" name (or (plist-get r :note) "accepted"))) (user-error "flan: %s" (or (plist-get r :message) "refused"))))) @@ -1191,6 +1193,7 @@ here for a name known in advance." ;; re-established by the next poll if the program is somehow still ;; there. (setq flan--stopped nil) + (flan--forget-break-stack) (force-mode-line-update t) (message "flan: %s — %s" name (or (plist-get r :note) "accepted"))) @@ -1236,6 +1239,7 @@ nothing left to serve once it has gone." (let ((r (flan--request '(:op "abort")))) (if (equal (plist-get r :status) "ok") (progn (setq flan--stopped nil) + (flan--forget-break-stack) (force-mode-line-update t) (message "flan: %s" (or (plist-get r :note) "aborted"))) (user-error "flan: %s" (or (plist-get r :message) "refused"))))) @@ -1317,6 +1321,17 @@ than being told so." (string-to-number (match-string 2 loc)) (string-to-number (match-string 3 loc))))) +(defun flan--forget-break-stack () + "Stop `next-error' walking the break buffer's stack. +The break buffer makes itself `next-error-last-buffer' while the program is +stopped. Once the program resumes or ends that stack is gone, and `M-g M-n' +from a source buffer must go back to the last compilation's errors rather +than visit frames that no longer exist." + (let ((buf (and (boundp 'flan-cnr-buffer) + (get-buffer (symbol-value 'flan-cnr-buffer))))) + (when (and buf (eq next-error-last-buffer buf)) + (setq next-error-last-buffer nil)))) + (defun flan--visitable-loc (loc subject) "LOC as (FILE LINE COL) when FILE can be visited, or a `user-error'. SUBJECT names what LOC is the location of, for the refusal. One set of diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 017d3f73..d20becdc 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -1319,6 +1319,53 @@ would be overwritten. Look again and re-do the edit") (let ((b (get-file-buffer src))) (when b (kill-buffer b)))) (delete-directory dir t))) +;; A stop raised inside a prelude function is shown where it stopped: the +;; innermost frame stays even though it is the prelude's, and the prelude +;; frames further out are still hidden. `(pause)' is the exception, above. +(let ((text (with-current-buffer + (test-flan--cnr + (list :condition "BoundsError" :restarts nil + :stack (list (list :fn "sum" :loc ":40:3") + (list :fn "fold" :loc ":12:1") + (list :fn "main" :loc "/g.flan:3:1")))) + (buffer-string)))) + (test-flan--check "a prelude frame that stopped is shown" + (string-match-p " 0: > sum" text)) + (test-flan--check "and the prelude frames outside it are hidden" + (and (not (string-match-p " 1: > fold" text)) + (string-match-p "1 prelude frame hidden" text)))) + +;; Once a restart or an abort is accepted the stack is gone, and `next-error' +;; from a source buffer must stop walking it. +(dolist (how '(restart abort)) + (let* ((flan-cnr-request-function (lambda (_) '(:status "ok"))) + (buf (test-flan--cnr (list :condition "Missing" :restarts '("retry") + :stack (list (list :fn "f" :loc "/x.flan:1:1")))))) + (setq next-error-last-buffer buf) + (with-current-buffer buf + (save-window-excursion + (if (eq how 'abort) (flan-cnr-abort) + (goto-char (point-min)) + (search-forward "retry") + (flan-cnr-take)))) + (test-flan--check (format "after the %s, next-error no longer walks the stack" how) + (null next-error-last-buffer)))) + +;; And the same when the program resumed some other way: the break buffer is +;; forgotten, and any other next-error buffer is left alone. +(let ((flan-cnr-buffer " *test-cnr*") + (other (get-buffer-create " *test-other-errors*"))) + (setq next-error-last-buffer (get-buffer " *test-cnr*")) + (flan--forget-break-stack) + (test-flan--check "a resume forgets the break buffer as the next-error buffer" + (null next-error-last-buffer)) + (setq next-error-last-buffer other) + (flan--forget-break-stack) + (test-flan--check "and leaves a compilation's alone" + (eq next-error-last-buffer other)) + (setq next-error-last-buffer nil) + (kill-buffer other)) + ;; The two buffers meet, and this is the fixture the bug lived in. `i' used ;; to send the local's *name* to be evaluated, which resolves wherever the ;; evaluator stands: right on the innermost frame by luck, and on any other diff --git a/lib/check.ml b/lib/check.ml index d3290183..a127a542 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8675,13 +8675,16 @@ and named_call ?(qualified = false) ctx ~want loc name args = The same walk as [print], with the pieces aimed at flan_dev.c's watch slot instead of stdout, so a struct, a slice, an option or a dyn value - watches the way it prints. flan_dev.c is linked into every build, so this - compiles the same in a release one, where nothing ever arms the table. + watches the way it prints. The value is evaluated once, before the table is asked whether anyone is looking, so a side effect in it happens whether or not a watch buffer is open. The walk runs only when one is: [flan_dev_watch_begin_n] answers 0 - when the table is not armed or is full, and the render is skipped. *) + when the table is not armed or is full, and the render is skipped. + + Outside a dev build the backends drop the guarded [If] whole — see + [Tast.is_watch_guard] — so a release build evaluates the value and makes + no call at all. *) | "watch" -> arity ctx loc name 2 args; let label = check ctx ~want:Types.String (List.hd args) in @@ -8715,11 +8718,18 @@ and named_call ?(qualified = false) ctx ~want loc name args = a number. *) | Types.String -> [ emitter.Render.estr (mk loc bslice (Tast.Prim (Tast.Bytes, [ value ]))) ] - | _ -> Render.render (render_ctx ctx emitter) 0 value + | _ -> + Render.render + ~refuse:(fun _loc t -> + Printf.sprintf + "%s has no rendering, so it cannot be watched — watch the \ + values you want out of it instead" + (Types.to_string t)) + (render_ctx ctx emitter) 0 value in let begin_ = mk loc (Types.Int Types.I32) - (Tast.Prim (Tast.Rt "flan_dev_watch_begin_n", [ label ])) + (Tast.Prim (Tast.Rt Tast.watch_begin, [ label ])) in let zero = mk loc (Types.Int Types.I32) (Tast.Int (0L, Types.I32)) in let open_ = mk loc Types.Bool (Tast.Prim (Tast.Ne, [ begin_; zero ])) in @@ -10023,7 +10033,8 @@ let builtins : (string * string * string) list = ("watch", "watch [string T] ()", "Writes the value, rendered as print renders it, into the dev session's \ watch table under the name, where M-x flan-watch shows it. Does nothing \ - when no watch buffer is open, and in a build with no dev session."); + when no watch buffer is open. Outside a dev build it only evaluates \ + the value."); ("exit", "exit [i32] never", "Ends the process with this status. It has no value, so nothing written \ after it runs."); diff --git a/lib/emit.ml b/lib/emit.ml index 9b450d50..c4d380e9 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1865,6 +1865,9 @@ and value_at f (e : Tast.expr) : string = bind_slot f slot) bs; block f body + (* A (watch ...) outside a dev build: its else branch, which is unit. See + [Tast.is_watch_guard]. *) + | Tast.If (c, _, e') when (not f.md.dev) && Tast.is_watch_guard c -> value f e' | Tast.If (c, t, e') -> emit_if f e.Tast.ty c t e' | Tast.While (c, body, latch) -> emit_while f c body latch; "zeroinitializer" (* A plain branch, and then the block is dead — [term] closes it and [ins] diff --git a/lib/js.ml b/lib/js.ml index ae5fe71d..c687f59b 100644 --- a/lib/js.ml +++ b/lib/js.ml @@ -1158,6 +1158,9 @@ and stmt f dest (e : Tast.expr) = line f "%s = %s;" f.names.(slot) x) binds; block f dest body + (* A (watch ...): there is no watch table in the JS dialect, so only the + else branch, which is unit. See [Tast.is_watch_guard]. *) + | Tast.If (c, _, b) when Tast.is_watch_guard c -> stmt f dest b | Tast.If (c, a, b) -> let cv = value f c in line f "if (%s) {" cv; diff --git a/lib/render.ml b/lib/render.ml index 03307359..f1cb9667 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -97,7 +97,14 @@ let max_span = 8 let fail = Loc.fail -let rec render c depth (e : Tast.expr) : Tast.expr list = +(* The refusal for a type the walk has no arm for, worded for the form that + asked. [print]'s is the default. *) +let print_refusal _loc t = + Printf.sprintf "no printer for %s — print the values you want out of it" + (Types.to_string t) + +let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr list = + let render c depth e = render ~refuse c depth e in let loc = e.Tast.loc in let unit_ e = { Tast.e; ty = Types.Unit; loc } in let cast t x = { Tast.e = Tast.Prim (Tast.Cast t, [ x ]); ty = t; loc } in @@ -391,5 +398,4 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = arm above, and a [Var] never reaches a backend. So this names the fix rather than only the refusal. *) | t -> - fail loc "no printer for %s — print the values you want out of it" - (Types.to_string t) + fail loc "%s" (refuse loc t) diff --git a/lib/tast.ml b/lib/tast.ml index deec3a91..7f1aa9af 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -437,6 +437,19 @@ type program = { A lifted clause's body is not in here: it is a function of its own, and this walks one expression. A reader that wants it follows [hfn], the way [Reach] does. *) +(* The name [(watch ...)] asks the table under, and the test a backend uses to + recognise the [If] the checker wraps a watch's rendering in. The checker + does not know whether the build is a dev one; a backend does, and outside a + dev build it lowers the whole [If] to its else branch, which is unit — so a + release build keeps only the value's own evaluation, bound before the [If], + and makes no call into the runtime at all. *) +let watch_begin = "flan_dev_watch_begin_n" + +let is_watch_guard (c : expr) = + match c.e with + | Prim (Ne, [ { e = Prim (Rt s, _); _ }; _ ]) -> String.equal s watch_begin + | _ -> false + let rec walk (f : expr -> unit) (e : expr) = f e; let go = walk f in diff --git a/lib/x86.ml b/lib/x86.ml index b01553ff..ed91def6 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -1821,6 +1821,10 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = bind_slot f slot) bs; block f body dst t + (* A (watch ...) outside a dev build: its else branch, which is unit. See + [Tast.is_watch_guard]. *) + | Tast.If (c, _, b) when (not f.md.Emit.dev) && Tast.is_watch_guard c -> + lower f b dst | Tast.If (c, a, b) -> let lelse = new_label f "else" and lend = new_label f "endif" in scoped f (fun () -> let cv = eval f c in load_loc f ~reg:rax cv Types.Bool); diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index ab1f3c95..2e0fe251 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -566,10 +566,10 @@ static uint64_t watch_epoch; * build — [flan_dev.c] is linked into both (see [Build], which says why) so the * symbols resolve either way and there is no second version of this file. * - * What it is *not*: free. The [(watch ...)] form still makes the call, so it - * costs the same as a scalar entry point does. A load and a branch - * per watched value per frame is the honest number, and it is the same number - * in both builds rather than a dev-only tax. */ + * What it is *not*: free. A scalar entry point called through [declare-c] + * costs a load and a branch per watched value per frame, in both builds. The + * [(watch ...)] form costs that in a dev build only: outside one the backend + * drops its call, and what is left is the value's own evaluation. */ static int watch_on; void flan_dev_watch_enable(int on) { diff --git a/test/programs/watch-release.flan b/test/programs/watch-release.flan index b32abe29..8814723a 100644 --- a/test/programs/watch-release.flan +++ b/test/programs/watch-release.flan @@ -1,9 +1,8 @@ ;;;; (watch "name" v) in a build with no dev session behind it. ;;;; -;;;; Nothing arms the watch table here, so every watch is the load and the -;;;; branch and nothing else: the program must compile, link and print exactly -;;;; what it prints without them. The value is still evaluated once, which the -;;;; counter shows. +;;;; Outside a dev build a watch makes no call into the runtime: the program +;;;; must compile, link and print exactly what it prints without them. The value +;;;; is still evaluated once, which the counter shows. (defstruct Pos [x i32 y f64]) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 91ddbd2b..435f22d5 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -4406,6 +4406,22 @@ level "1" "programs/watch-release.flan" "3 2\n"; outputs ~x86:true "watch: a release build, --x86" "programs/watch-release.flan" "3 2\n"; + (* And a release build makes no call into the watch table at all: the + backend drops the guarded render, so the only cost left is the value's + own evaluation. A dev build keeps the call. *) + (let p = + Reader.read_file "programs/watch-release.flan" |> Parse.program + |> Check.program + in + let call = "call i32 @flan_dev_watch_begin_n(" in + if contains (Emit.program p) call then begin + incr failures; + print_endline "FAIL watch: a release build still calls the watch table" + end; + if not (contains (Emit.program ~dev:true p) call) then begin + incr failures; + print_endline "FAIL watch: a dev build lost its call to the watch table" + end); (* ── Per-type descriptors, M2 item 2 ───────────────────────────── The first program anywhere with a dyn field in a struct, which was a refusal until the descriptors landed. It matters at all three rows diff --git a/test/test_flan.ml b/test/test_flan.ml index 04f993e8..3c606aef 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -5747,6 +5747,17 @@ let () = Printf.printf "FAIL %s\n wanted: %s (no printer for)\n got: %s (%s)\n" name ":1:43" got dmsg end); + (* The same refusal from watch is worded for watch, not for print. *) + (let name = "an unwatchable value is refused in watch's own words" in + match checked "(defn f [m (Map i32 i32)] () (watch \"m\" m))" with + | _ -> + incr failures; + Printf.printf "FAIL %s: expected a type error\n" name + | exception Loc.Error { Loc.dmsg; _ } -> + if not (contains dmsg "cannot be watched") || contains dmsg "print" then begin + incr failures; + Printf.printf "FAIL %s\n got: %s\n" name dmsg + end); (* A predicate a body relies on has to be carried by every signature between it and the call site, or the refusal moves into code the caller did not diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index 83985fce..50e5767f 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -213,8 +213,8 @@ let corpus = immortal and is not a collector object. If that reasoning is wrong, 50000 instances past the one-megabyte floor is where ASan says so. *) "programs/dyn-class.flan", []; - (* (watch ...) with the table unarmed: every value is bound and every - call reaches flan_dev_watch_begin_n, and nothing past it runs. *) + (* (watch ...) outside a dev build: every value is bound to a slot and + evaluated, and nothing else about the form is emitted. *) "programs/watch-release.flan", []; (* nil <-> None at (Option T), M2 queue item 4: an Option's tag is read with a raw [Field] the surface language never writes (check.ml's