From 831cab9fb2804a01e629b97dbaf90d66fb330f98 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 22:55:11 +0700 Subject: [PATCH] Review follow-ups: x86 parity, ArithError, and three refusal bugs Five fixes off the independent review, plus the author's u8 ruling. x86 parity: the bad-index block always ran x86 (it is flan dev's default) and now says so with an explicit --x86; the condition render gets an assertion under the x86 backend too, beside the LLVM one, and a user error is pinned as carrying no site on both. ArithError's layout is now pinned: {i32 op; i64 lhs, rhs} in C against the prelude's defstruct, read field by field through the break loop's render, driven from the editor through a divide under a restart-case. That also covers condition and site on LLVM. Three refusals that were wrong: trap_site tested the prefix "err" and so ate any site whose path began with those letters; source_line let Sys_error from input_line escape and take the whole break reply with it, leaking the handle; and a condition with no fields was reported as a name no struct has. The daemon now sends its own field count and the buffer tells the two empties apart. Nits taken: an over-long site is dropped rather than silently truncated into a plausible one; the caret pads with the source line's own tabs; the headline says when it has cut the field list; flan-cnr-layout is live again as the single spelling of that request rather than dead beside an inlined copy. And the ruling: a u8 renders as 97 (\a) where a person is inspecting and stays 97 where the program is printing. --- FIX.org | 18 +++++ emacs/flan-cnr.el | 100 +++++++++++++++++-------- emacs/test-flan-cider.el | 35 +++++++++ emacs/test-flan.el | 9 ++- lib/dev.ml | 60 +++++++++++---- lib/render.ml | 24 ++++++ lib/session.ml | 17 +++++ runtime/flan_dev.c | 51 +++++++++++++ test/programs/dev-break.flan | 11 +++ test/programs/dev-locals.flan | 9 ++- test/programs/generics.flan | 6 ++ test/test_acceptance.ml | 2 +- test/test_dev.ml | 134 +++++++++++++++++++++++++++++++++- vendor/agent/flan_agent.c | 6 +- 14 files changed, 430 insertions(+), 52 deletions(-) diff --git a/FIX.org b/FIX.org index d75d642..1dacf00 100644 --- a/FIX.org +++ b/FIX.org @@ -4080,6 +4080,24 @@ full pass and reword things." =restart-at= with the index for every choice, name as receipt, so the shadowed line just says "same name as N; taken by its number". +- A u8 shows its character where a person is inspecting: =97 (\a)= in a + frame's locals, in inspect, and in a condition's fields. Ruled by the + author: =[u8]= already renders as text, so a lone byte reading =97= was an + asymmetry exactly where someone is reading rather than computing. + =println= is untouched — a u8 is a number and that path is the program + talking. The switch is =Render.pointers=, which already marks the + inspecting side and which =println= passes as =None=, so the printing path + cannot acquire this by accident. Spellings answer to lib/reader.ml's + =read_byte= (the five named ones, and any single non-delimiter character), + so what is shown could be typed back; a byte with no spelling shows the + number alone rather than an invented escape or a raw control byte. The + table is in flan_dev.c as one call: the value is only known at run time, + and a chain over ninety-odd comparisons per rendered byte would have been + the walk paying for its own shape. Pinned on both backends with a + printable, a named and an unprintable byte, and =println (u8 97)= pinned + bare in the acceptance table — the existing 255 could not tell the two + apart. + ** Deferred, ready to build - Restart locations. The =%restart= frame is mirrored across emit.ml, x86.ml and flan_rt.c (fields 0-9 today), so giving =continue= a file:line:col diff --git a/emacs/flan-cnr.el b/emacs/flan-cnr.el index 6f92758..51e6b76 100644 --- a/emacs/flan-cnr.el +++ b/emacs/flan-cnr.el @@ -154,8 +154,13 @@ as its numbers and every other condition reads as its own." (not (string-match-p "\n" (nth 2 f))))) fields))) (when short - (mapconcat (lambda (f) (format "%s %s" (nth 0 f) (nth 2 f))) - (seq-take short 4) ", ")))) + (concat (mapconcat (lambda (f) (format "%s %s" (nth 0 f) (nth 2 f))) + (seq-take short 4) ", ") + ;; A headline is one line, so a wide condition is cut — and + ;; says it is, because a silently short list reads as the whole + ;; of what the condition carries. The section below has all of + ;; them. + (when (> (length short) 4) ", …"))))) (defun flan-cnr--site-line-col (site) "The (LINE . COL) a SITE string names, or nil." @@ -173,10 +178,20 @@ indexing or the division itself, so it sits directly under the headline." (let ((source (plist-get state :source)) (lc (flan-cnr--site-line-col site))) (when (and source lc) - (let ((prefix (format "%4d| " (car lc)))) + (let* ((prefix (format "%4d| " (car lc))) + (col (max 0 (1- (cdr lc)))) + ;; The pad copies the source's own leading whitespace rather + ;; than assuming spaces: a tab-indented line puts the caret + ;; a tab-stop off under any other rule, and a caret that + ;; points at the wrong column is worse than none. + (pad (concat (make-string (length prefix) ?\s) + (mapconcat + (lambda (ch) (if (eq ch ?\t) "\t" " ")) + (string-to-list (substring source 0 + (min col (length source)))) + "")))) (insert "\n" (propertize prefix 'face 'shadow) source "\n") - (insert (make-string (+ (length prefix) (max 0 (1- (cdr lc)))) ?\s) - (propertize "^" 'face 'error) "\n"))))))) + (insert pad (propertize "^" 'face 'error) "\n"))))))) (defun flan-cnr--insert-condition (state) (let* ((name (or (plist-get state :condition) "a condition")) @@ -207,9 +222,19 @@ indexing or the division itself, so it sits directly under the headline." (let ((fields (plist-get state :fields)) (why (plist-get state :fields-why))) (if (null fields) - (insert (propertize (concat " not available — " - (or why (flan-cnr--why 'layout)) "\n") - 'face 'font-lock-comment-face)) + ;; Three different empties, and only one of them is a refusal. A + ;; condition that *declares* no fields is an ordinary thing — Pause is + ;; one — and saying "no struct has this name" about it would be + ;; false. `:fields-empty' is the daemon's own count, so this end is + ;; not inferring it from a list that is also empty when the read + ;; failed. + (insert (propertize + (cond + ((plist-get state :fields-empty) + " this condition has no fields\n") + (t (concat " not available — " + (or why (flan-cnr--why 'layout)) "\n"))) + 'face 'font-lock-comment-face)) (progn ;; The section-wide reason, once, above the rows — repeating it per ;; field was the noise the rewording pass was asked to cut. @@ -628,6 +653,8 @@ data and the fixture-driven tests can drive it without a socket." (plist-get fields :fields) fields) :fields-why (and (keywordp (car-safe fields)) (plist-get fields :why)) + :fields-empty (and (keywordp (car-safe fields)) + (plist-get fields :empty)) ;; STACK is passed in rather than fetched, for the same reason FIELDS ;; is: this stays a function from data to data, so the fixture tests ;; drive it with no socket. Nil is still a legitimate answer — the @@ -654,17 +681,27 @@ qualified struct name the compiler put into the error: `Emit' takes it from up by the same name. So it resolves without anything here knowing what package it came from. -A refusal is not an error here: nil means the layout section draws the reason -it is empty, which is the degradation the buffer is already built for." - (when (and type (not (string-empty-p type))) - (let ((r (funcall flan-cnr-request-function (list :op "layout" :type type)))) - (when (equal (plist-get r :status) "ok") - (mapcar (lambda (f) - ;; The value is nil: the shape of a condition is a fact - ;; about the build, its contents are a fact about the - ;; stopped frame, and this op only ever answers the first. - (list (nth 0 f) (nth 1 f) nil)) - (plist-get r :fields)))))) +A refusal is not an error here: `:fields' nil means the section draws the +reason it is empty, which is the degradation the buffer is already built for, +and `:why' carries the daemon's own sentence for it — a bare name it will not +guess between two packages reads better than anything this end could invent. + +Returns (:fields ROWS :why WHY), the shape `flan-cnr-condition-fields' +returns, so the two are interchangeable where the buffer takes either." + (let ((r (and type (not (string-empty-p type)) + (funcall flan-cnr-request-function + (list :op "layout" :type type))))) + (if (equal (plist-get r :status) "ok") + (list :fields + (mapcar (lambda (f) + ;; The value is nil: the shape of a condition is a + ;; fact about the build, its contents are a fact about + ;; the stopped frame, and this op only ever answers + ;; the first. + (list (nth 0 f) (nth 1 f) nil)) + (plist-get r :fields)) + :why "the stop's value was not readable") + (list :fields nil :why (plist-get r :message))))) (defun flan-cnr-condition-fields (type) "The stopped condition's fields with their values, or what stands in. @@ -684,18 +721,21 @@ section-wide reason, nil when the values arrived." ;; still shows, with its own reason in the value column. (mapcar (lambda (f) (list (nth 0 f) nil nil (nth 1 f))) (plist-get r :refused))) - :why nil) + :why nil + ;; The build's own count. Zero means this condition declares no + ;; fields, which is a fact about it and not a failure to read + ;; one. + :empty (eql 0 (plist-get r :declared))) + ;; The shape alone, through the one function that spells the `layout' + ;; request. Its own reason is kept when it is the one that refused — + ;; "not a qualified name" says more than anything about the values — + ;; and the values' reason otherwise. (let* ((why (plist-get r :message)) - (r2 (when (and type (not (string-empty-p type))) - (funcall flan-cnr-request-function - (list :op "layout" :type type)))) - (ok2 (equal (plist-get r2 :status) "ok")) - (layout (when ok2 - (mapcar (lambda (f) (list (nth 0 f) (nth 1 f) nil)) - (plist-get r2 :fields))))) - (list :fields layout - :why (or why (unless ok2 (plist-get r2 :message)) - (and layout "the stop's value was not readable"))))))) + (fallback (flan-cnr-layout type))) + (list :fields (plist-get fallback :fields) + :why (if (plist-get fallback :fields) + (or why (plist-get fallback :why)) + (or (plist-get fallback :why) why))))))) (defun flan-cnr-backtrace () "The stopped program's frames, innermost first, as the renderer wants them. diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index b8bb7cd..9808867 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -1191,6 +1191,41 @@ would be overwritten. Look again and re-do the edit") (test-flan--check "every field renders with its value" (string-match-p ":length +i64 +100" text))) +;; A condition that declares no fields is an ordinary thing — Pause is one — +;; and saying "no struct has this name" about it would be false. The two +;; empties are told apart by the daemon's own count, not inferred from a list +;; that is empty in both cases. +(let ((text (with-current-buffer + (test-flan--cnr (list :condition "Pause" :restarts '("continue") + :fields nil :fields-empty t)) + (buffer-string)))) + (test-flan--check "a condition with no fields says so" + (string-match-p "this condition has no fields" text)) + (test-flan--check "and is not reported as an unknown name" + (not (string-match-p "no struct has this name" text)))) + +(let ((text (with-current-buffer + (test-flan--cnr (list :condition "Whatsit" :restarts '("continue") + :fields nil)) + (buffer-string)))) + (test-flan--check "while a name with no struct behind it still says that" + (string-match-p "not available — no struct has this name" text))) + +;; A tab-indented source line: the caret pads with the line's own whitespace, +;; so it lands under the column rather than a tab stop away from it. +(let ((text (with-current-buffer + (test-flan--cnr + (list :condition "BoundsError" :restarts nil + :fields '(("low" "i64" "9")) + :site "/x/t.flan:3:9" + :source "\t\t(at g i)")) + (buffer-string)))) + ;; Six spaces for the " 3| " gutter, then the line's own two tabs, then + ;; six spaces for "(at g " — the caret lands under column 9 whatever the + ;; tab stop is. + (test-flan--check "the caret pads with the source's own tabs" + (string-match-p "\n \\{6\\}\t\t \\{6\\}\\^\n" text))) + ;; No implementation note ever prints: the bracketed design asides used to ;; leak into the buffer, and the fix is pinned as a property of the whole ;; rendering rather than of one string. diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 4a4a065..377f442 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -242,9 +242,14 @@ already rely on it — so nothing here is a stand-in for the real thing." (require 'flan-cnr) (let ((flan-cnr-request-function #'flan--request)) (test-flan--check "a struct's fields come back named and typed" - (equal (flan-cnr-layout "Missing") '(("id" "i32" nil)))) + (equal (plist-get (flan-cnr-layout "Missing") :fields) + '(("id" "i32" nil)))) (test-flan--check "and a type the daemon cannot place is nil, not an error" - (null (flan-cnr-layout "Nonesuch")))) + (null (plist-get (flan-cnr-layout "Nonesuch") :fields))) + ;; The refusal's own sentence rides along, because it is the one the + ;; section draws and the daemon writes it better than this end could. + (test-flan--check "and its reason comes with it" + (stringp (plist-get (flan-cnr-layout "Nonesuch") :why)))) ;; C-c C-c on the form at point: put point inside `step' and send it. The ;; text comes from the buffer, so this exercises `beginning-of-defun' against diff --git a/lib/dev.ml b/lib/dev.ml index b0d221c..917c36b 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -408,7 +408,12 @@ let trap_site t = | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) | text -> let line = String.trim text in - if String.length line >= 3 && String.sub line 0 3 = "err" then Error line + (* ["err "] with the space, not ["err"]: every refusal the agent writes + has one, and a *site* is a path — [errors.flan:10:2] starts with those + three letters and is an answer, not a refusal. Testing the shorter + prefix dropped that site silently, which is the one failure this + whole section exists to avoid. *) + if String.length line >= 4 && String.sub line 0 4 = "err " then Error line else Ok (if line = "-" || line = "" then None else Some line) (* Where a stopped program is, one frame per line, innermost first — the same @@ -1397,12 +1402,19 @@ let source_line site = (match open_in path with | exception Sys_error _ -> None | ic -> + (* Every way out closes the handle, and every failure is [None]. + [open_in] on a directory succeeds on Linux and it is the + *read* that raises [Sys_error] — which escaping from here + would take down the whole [break] reply over a cosmetic + line, and leak the handle on the way. A source line is a + nicety; the site above it is the answer. *) let rec skip n = match input_line ic with | exception End_of_file -> None + | exception Sys_error _ -> None | text -> if n <= 1 then Some text else skip (n - 1) in - let r = skip line in + let r = match skip line with r -> r | exception _ -> None in close_in_noerr ic; r) | Some _ -> None)) @@ -1872,27 +1884,45 @@ let condition_op t = | Error m -> error m | Ok v -> (* One line per field — name, type, value, tab separated, and - safe because every string the renderer emits is escaped. *) - let entries = - List.filter_map - (fun line -> - match String.split_on_char '\t' line with - | [ n; ty; value ] -> - Some - (Wire.list - [ Wire.quote n; Wire.quote ty; Wire.quote value ]) - | _ -> None) - (String.split_on_char '\n' v) - in + safe because every string the renderer emits is escaped. + + A line that is not three parts is *not* dropped. Nothing + should produce one, which is exactly why it must be visible + if anything ever does: a field silently in neither list + would read as a condition that has fewer fields than it + has. It joins the refusals, with what came back. *) + let entries = ref [] and strays = ref [] in + List.iter + (fun line -> + match String.split_on_char '\t' line with + | [ n; ty; value ] -> + entries := + Wire.list + [ Wire.quote n; Wire.quote ty; Wire.quote value ] + :: !entries + | _ -> + if String.trim line <> "" then + strays := + (line, "the renderer wrote a line this end could not \ + read as a field") + :: !strays) + (String.split_on_char '\n' v); + let entries = List.rev !entries in ok [ ":type " ^ Wire.quote cname; ":fields " ^ Wire.list entries; + (* How many the *build* says this struct has, so a client + can tell "rendered nothing" from "has nothing to + render". A condition with no fields is an ordinary + thing — [Pause] is one — and it must not be reported + the way an unknown name is. *) + Printf.sprintf ":declared %d" (List.length st.Tast.fields); ":refused " ^ Wire.list (List.map (fun (n, why) -> Wire.list [ Wire.quote n; Wire.quote why ]) - refused) ]) + (refused @ List.rev !strays)) ]) (* [(:op "inspect" :frame N :slot I :path (...))] — the inspector's second rooting mode. [docs/BUILT.md]'s "Two ways to root a walk" says what each root diff --git a/lib/render.ml b/lib/render.ml index c0022a3..ad83dd8 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -48,6 +48,12 @@ type emitter = { registry to call. *) type pointers = { live : Tast.expr -> Tast.expr; (* a (Ptr a) -> bool: may it be read *) + (* The character half of a u8: emits " (\a)" beside the number, or nothing + for a byte with no spelling a reader would take back. It rides in this + record rather than in [emitter] because it belongs to exactly the side + that record already marks — the inspecting one. [println] passes [None] + here and a u8 stays a bare number there, which is what it is. *) + bytechar : Tast.expr -> Tast.expr; (* u8 -> unit *) (* Emits what the registry remembers about a dead address, and emits nothing at all for one it never saw — a stack local is not in it by design, and inventing a sentence about one would be worse than the silence [] @@ -105,6 +111,24 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = else match e.Tast.ty with | Types.Int Types.U64 -> [ c.emit.eu64 e ] + (* A byte, where the reader is inspecting rather than the program is + printing: the number and then the character it is, [97 (\a)]. [[u8]] + already renders as text, so a lone byte showing only 97 is the one + place the same data reads two ways — and this is the side where that + matters, because nobody is computing with what is on the screen. + + [println] has no [ptrs] and is unchanged: a u8 is a number there. The + expression is bound to a slot first, for the pointer arm's reason — + it is named twice here, and the expression it came from may be a + call through a bounds check. *) + | Types.Int Types.U8 when c.ptrs <> None -> + let pt = Option.get c.ptrs in + let bv = c.alloc e.Tast.ty in + let b () = { Tast.e = Tast.Local bv; ty = e.Tast.ty; loc } in + [ unit_ + (Tast.Let ([ (bv, e) ], + [ c.emit.ei64 (cast (Types.Int Types.I64) (b ())); + pt.bytechar (b ()) ])) ] | Types.Int _ -> [ c.emit.ei64 (cast (Types.Int Types.I64) e) ] | Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ] | Types.Bool -> diff --git a/lib/session.ml b/lib/session.ml index 0456ad5..7b89074 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -947,6 +947,10 @@ let externs : Tast.extern list = { Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition"; eparams = []; eret = Types.Ptr (Types.Int Types.U8); eloc = Loc.unknown }; + (* The character beside a rendered byte. See [Render.pointers]. *) + { Tast.ename = "flan/dev-emit-u8-char"; esym = "flan_dev_emit_u8_char"; + eparams = [ Types.Int Types.I64 ]; eret = Types.Unit; + eloc = Loc.unknown }; { Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin"; eparams = []; eret = Types.Unit; eloc = Loc.unknown }; { Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end"; @@ -1013,6 +1017,19 @@ let dev_pointers : Render.pointers = { Tast.e = Tast.Do [ ask "flan/reg-emit" p; { Tast.e = Tast.Unit; ty = Types.Unit; loc } ]; + ty = Types.Unit; loc }); + (* Widened to i64 at the call, because every extern this file declares + that takes a number takes one, and the C reads the byte back out of + it. The spelling table is in flan_dev.c and answers to + lib/reader.ml's [read_byte]. *) + bytechar = + (fun b -> + let loc = b.Tast.loc in + let wide = + { Tast.e = Tast.Prim (Tast.Cast (Types.Int Types.I64), [ b ]); + ty = Types.Int Types.I64; loc } + in + { Tast.e = Tast.Call ("flan/dev-emit-u8-char", [ wide ]); ty = Types.Unit; loc }) } (* ── The locals of a stopped frame ─────────────────────────────────── *) diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 4d844ec..e47bcac 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -351,6 +351,57 @@ void flan_dev_emit_str(const uint8_t *bytes, int64_t len) { put_str(flan_dev_emit, bytes, len); } +/* The character half of a u8, appended after the number: " (\a)", or nothing + * for a byte with no spelling a reader would accept. + * + * A u8 is a number and prints as one — [println] is unchanged. But a *reader* + * looking at a frame is in the asymmetric position the author named: [u8] + * already renders as text, so a lone byte showing 97 is the one place the + * same data reads two ways. This is the inspecting half, and only the + * inspecting renderers call it. + * + * The spellings are lib/reader.ml's [read_byte], which is the authority: the + * five named ones, and any single character that is not a delimiter there — + * so what is shown could be typed back. A delimiter has no single-character + * spelling and no name, and a control byte has neither; both get the number + * alone rather than an invented escape or a raw control byte written into a + * buffer someone is about to read. Done here rather than as emitted + * comparisons because the value is only known at run time: a chain over + * ninety-odd bytes per rendered u8 would be the walk paying for its own + * shape, and the table belongs in one place. */ +void flan_dev_emit_u8_char(int64_t x) { + const char *name = NULL; + char one[2]; + if (x < 0 || x > 255) return; + switch (x) { + case 32: name = "space"; break; + case 9: name = "tab"; break; + case 10: name = "newline"; break; + case 13: name = "return"; break; + case 0: name = "nul"; break; + default: break; + } + if (name == NULL) { + /* Printable and not one of the reader's delimiters. */ + if (x < 33 || x > 126) return; + switch ((char)x) { + case '(': case ')': case '[': case ']': case '{': case '}': + case '"': case ';': case '`': case '~': case ',': + return; + default: break; + } + one[0] = (char)x; + one[1] = '\0'; + name = one; + } + /* [put] and not [put_str]: this is punctuation around a spelling, not a + * string value, so it must not be quoted or escaped a second time. Every + * byte written here is one [read_byte] would accept back. */ + put(flan_dev_emit, " (\\"); + put(flan_dev_emit, name); + put(flan_dev_emit, ")"); +} + void flan_dev_result_end(void) { truncate_value(result, &result_len, RESULT_MAX, result_full); close_value(&generation); diff --git a/test/programs/dev-break.flan b/test/programs/dev-break.flan index b8a60b6..1c37c89 100644 --- a/test/programs/dev-break.flan +++ b/test/programs/dev-break.flan @@ -24,6 +24,17 @@ (set ticks (+ ticks 1)) ticks) +;;; A division under a restart-case, called from the editor rather than from +;;; main. It is here for the *other* condition the runtime builds by hand: +;;; ArithError's three fields are a C struct in flan_rt.c and a defstruct in +;;; the prelude, and the break loop's render now reads them field by field, +;;; padding and all. A layout that drifted would show the op in `lhs'. +;;; The operands are parameters so nothing constant-folds the division away. +(defn divide [a i64 b i64] i64 + (restart-case + (/ a b) + (use-zero [] 0))) + (defn main [] i32 (agent/start "/tmp/flan-dev-break-fallback.sock") (print (fetch 1)) (println "") diff --git a/test/programs/dev-locals.flan b/test/programs/dev-locals.flan index 906793c..6457e40 100644 --- a/test/programs/dev-locals.flan +++ b/test/programs/dev-locals.flan @@ -14,7 +14,14 @@ (defn look [n i64 label string] i64 (let [p (Point {.x 1.5 .y 2.5}) xs [10 20 30] - flag (> n 0)] + flag (> n 0) + ;; Three bytes, for the three answers the character half has. A [u8] + ;; already renders as text, so a lone byte showing only its number is + ;; the one place the same data reads two ways — but only where a + ;; person is inspecting. [println] of a u8 stays a number. + byte (u8 97) ; printable: 97 (\a) + gap (u8 32) ; one the reader names: 32 (\space) + ctl (u8 7)] ; no spelling: the number alone ;; A loop, for its hidden bound: [dotimes] allocates a slot nobody named, ;; and the listing must *hide* it rather than refuse it by an invented ;; name — [s6] is not a variable anyone can find in this file. diff --git a/test/programs/generics.flan b/test/programs/generics.flan index 78944a8..2912d1f 100644 --- a/test/programs/generics.flan +++ b/test/programs/generics.flan @@ -175,6 +175,12 @@ (println (next-after (i64 10))) (println (next-after 2.5)) (println (next-after (u8 254))) + ;; A byte the reader *can* spell, printed rather than inspected. The + ;; break loop and the inspector show this one as `97 (\a)' — a u8 is the + ;; one type that reads two ways, and which way depends on who is looking. + ;; Printing is the program talking, so it stays the number. 254 above + ;; cannot tell the two apart, because 255 has no spelling either way. + (println (u8 97)) (println (plus-300 1)) ;; And the prelude's own three, which are these bodies under their real diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index be59c98..71d33af 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2662,7 +2662,7 @@ let () = and which this does not second-guess. *) let generics_out = "3\n4.5\ntrue\n7\n5\n-1\n5\n42\n3\n1\n10\n1\n8\n\ - true\ntrue\ntrue\ntrue\ntrue\ntrue\n4\n11\n3.5\n255\n301\n\ + true\ntrue\ntrue\ntrue\ntrue\ntrue\n4\n11\n3.5\n255\n97\n301\n\ true\ntrue\nfalse\n\ 3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\n\ 0\n-1\n2.5\n0\ntrue\nfalse\ntrue\n2\n0\n\ diff --git a/test/test_dev.ml b/test/test_dev.ml index cc32dab..c9e9574 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -1134,6 +1134,80 @@ let () = (Option.value ~default:(status r) (Wire.string_field r "message")) end end; + + (* ── ArithError, and the layout nobody can see both halves of ──── + The other condition the runtime builds by hand. [flan_arith_cond] + is {i32 op; i64 lhs, rhs} in flan_rt.c and [(defstruct ArithError + [op i32 lhs i64 rhs i64])] in the prelude, and neither end can see + the other — the same hand-kept agreement [flan_name_id] has with + [Check.type_id]. It used to be read only by a handler that pulled + out one field; the break loop's render now walks all three, padding + included, so a drifted layout shows the op sitting in [lhs]. + + Driven from the editor rather than from main: [divide] holds a + restart-case, so the break has somewhere to go afterwards and the + daemon carries on. This is also the LLVM half of the site check — + an arith trap publishes its loc the same way a bounds trap does, + and the bad-index block below is x86. *) + (let r = + ask + "(:op \"eval-expr\" :code \"(divide (i64 1) (i64 0))\" :file \"/tmp/buf.flan\")" + in + if status r <> "error" then + fail "a division by zero answered instead of stopping" + else if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "a division by zero never stopped the program" + else begin + (match Wire.string_field (ask "(:op \"describe\")") "condition" with + | Some "ArithError" -> () + | c -> + fail "a division by zero is reported as %S" + (Option.value ~default:"" c)); + let r = ask "(:op \"condition\")" in + if status r <> "ok" then + fail "ArithError's fields: %s" + (Option.value ~default:(status r) (Wire.string_field r "message")) + else begin + let fields = + match Wire.field r "fields" with + | Some { Form.v = Form.List l; _ } -> + List.filter_map + (fun (e : Form.t) -> + match e.Form.v with + | Form.List + [ { Form.v = Form.Str n; _ }; + { Form.v = Form.Str ty; _ }; + { Form.v = Form.Str v; _ } ] -> Some (n, ty, v) + | _ -> None) + l + | _ -> [] + in + (* op 0 is FLAN_ARITH_DIV_ZERO; lhs is the dividend and rhs the + divisor, which is the pair the unhandled message prints. Each + read at its own offset, so an i32 followed by two i64s is the + layout both ends have to agree on. *) + if + fields + <> [ ("op", "i32", "0"); ("lhs", "i64", "1"); ("rhs", "i64", "0") ] + then + fail "ArithError's rendered fields: %s" + (String.concat ", " + (List.map (fun (n, ty, v) -> n ^ " " ^ ty ^ " = " ^ v) fields)) + end; + (* The site, on LLVM: an arith trap publishes its loc around the + hook exactly as a bounds trap does. *) + (match Wire.string_field (ask "(:op \"break\")") "site" with + | Some site when contains_sub site "dev-break.flan:" -> () + | Some site -> fail "the arith site points at %s" site + | None -> fail "a division by zero carries no :site"); + let r = ask "(:op \"restart\" :name \"use-zero\")" in + if status r <> "ok" then + fail "resuming past a division by zero: %s" + (Option.value ~default:"" (Wire.string_field r "message")); + if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then + fail "the program never resumed past a division by zero" + end); + (* ...and the other way out. Every check above is of an abort being *refused*; the accepted path is the one that must not be left as code that has never run, because it is the one that ends a program. Break @@ -1229,7 +1303,14 @@ let () = in let xpid = Unix.create_process flan - [| flan; "dev"; "programs/dev-break-bounds.flan"; "-s"; xsock |] + (* [--x86] spelled out rather than taken from the default. It *is* + the default for [flan dev] (bin/main.ml), so this block has always + been the x86 side of the break loop — but the condition render, + the trap site and the nested-site check all live here, and which + backend they run under is the whole point of them. A default that + moves must not silently take this coverage with it; the LLVM side + of the same three is the break block above. *) + [| flan; "dev"; "programs/dev-break-bounds.flan"; "-s"; xsock; "--x86" |] Unix.stdin xfd Unix.stderr in Unix.close xfd; @@ -1669,6 +1750,14 @@ let () = ("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("xs", "[3 i32]", "[ 10 20 30]"); ("flag", "bool", "true"); + (* The byte's character half, in the three shapes it has. The + spelling is one [lib/reader.ml]'s [read_byte] accepts, so + what is shown could be typed back; 7 has neither a name nor + a single-character spelling, so it stays a number rather + than growing an invented escape. *) + ("byte", "u8", "97 (\\a)"); + ("gap", "u8", "32 (\\space)"); + ("ctl", "u8", "7"); (* [hop] is [dotimes]'s index and it is listed; the loop's hidden bound sits in the very next slot and is *not* — a compiler temp is hidden, not refused, because [s6] is not a @@ -1745,7 +1834,11 @@ let () = holding [p]'s value and nothing would say so. *) let r = ask - "(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {.x 9.0 .y 9.0}) ys [1 2 3] mark (< n 0)] (dotimes [pip 0] (print \\\"\\\")) (let [tag \\\"x\\\"] (restart-case (do (error (Boom {.why 7})) (let [later (i64 99)] later)) (carry-on [] 5)))))\" :file \"/tmp/buf.flan\")" + (* Slot for slot with the body on the stack — three u8s included, + or the *count* would catch this and the fingerprint would go + untested. Every name differs and every type matches, which is + exactly what a count cannot see. *) + "(:op \"eval\" :code \"(defn look [n i64 label string] i64 (let [q (Point {.x 9.0 .y 9.0}) ys [1 2 3] mark (< n 0) ch (u8 98) sp (u8 33) cc (u8 8)] (dotimes [pip 0] (print \\\"\\\")) (let [tag \\\"x\\\"] (restart-case (do (error (Boom {.why 7})) (let [later (i64 99)] later)) (carry-on [] 5)))))\" :file \"/tmp/buf.flan\")" in if status r <> "ok" then fail "installing a renamed body while stopped: %s" @@ -4647,6 +4740,29 @@ let () = l | _ -> [] in + (* The condition's own fields, rendered under this backend. The thunk + reads them through [flan_agent_condition] at offsets the *x86* + backend laid out, and x86 tracks LLVM's observable behaviour: the + break block above renders a condition on LLVM, so this renders one + here, and the two must read alike. [look] signals (Boom {.why 7}), + so the number is the one the source wrote. *) + (let r = request c "(:op \"condition\")" in + if status r <> "ok" then fail "x86 condition: %s" (said r) + else + match Wire.field r "fields" with + | Some { Form.v = Form.List + [ { Form.v = Form.List + [ { Form.v = Form.Str "why"; _ }; + { Form.v = Form.Str "i32"; _ }; + { Form.v = Form.Str "7"; _ } ]; _ } ]; _ } -> () + | _ -> fail "x86 condition did not render (Boom {.why 7})"); + (* And a user [error] carries no site — there is no trapping + expression behind it — which is the same answer LLVM gives. Said + rather than left untested: the site is absent here for a reason, + not because this backend cannot produce one. *) + (match Wire.string_field (request c "(:op \"break\")") "site" with + | None -> () + | Some site -> fail "an x86 user error carried a site: %s" site); if status r <> "ok" then fail "x86 backtrace: %s" (said r) else (match frames with @@ -4691,6 +4807,12 @@ let () = ("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("xs", "[3 i32]", "[ 10 20 30]"); ("flag", "bool", "true"); + (* And the byte's character half under this backend too: the + spelling table is the dev runtime's, but the slot the byte + is read from is x86's. *) + ("byte", "u8", "97 (\\a)"); + ("gap", "u8", "32 (\\space)"); + ("ctl", "u8", "7"); (* Same two rows the LLVM listing pins: the loop index shown, the loop's hidden bound hidden, the shadowing rebind kept raw because the outer [label] is on the same list. *) @@ -4723,6 +4845,14 @@ let () = else if Wire.string_field r "value" <> Some "(Point {.x 1.5 .y 2.5})" then fail "x86 inspect of slot 2 answered %S" (Option.value ~default:"" (Wire.string_field r "value")); + (* And a byte by the same root: the inspector is the other place a + person is reading rather than the program printing, so it shows + the character half exactly as the listing does. Slot 5 is [byte]. *) + (let r = request c "(:op \"inspect\" :frame 0 :slot 5)" in + if status r <> "ok" then fail "x86 inspect of a byte: %s" (said r) + else if Wire.string_field r "value" <> Some "97 (\\a)" then + fail "x86 inspect of a byte answered %S" + (Option.value ~default:"" (Wire.string_field r "value"))); (* And the write half of the same root, for the reason this whole block exists: the two backends must answer the same. A store is where they could most easily not — the place forms the walk ends at are lowered diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index a1332cd..1cd3509 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -526,7 +526,11 @@ static int snap_push(int resumable, void *cond) { s->sitelen = 0; if (flan_break_site != NULL && flan_break_site_len > 0) { int64_t k = flan_break_site_len; - if (k > (int64_t)sizeof s->site) k = (int64_t)sizeof s->site; + /* Truncation would be silent and would produce a *plausible* site — a + * path cut short still parses as one — so a site too long to hold is + * dropped instead. No site is a state the reader already handles; a + * wrong one is not. 512 is far past any real file:line:col. */ + if (k > (int64_t)sizeof s->site) k = 0; memcpy(s->site, flan_break_site, (size_t)k); s->sitelen = (int32_t)k; /* Consumed, not just read. The trap site clears the global when its hook