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

Review follow-ups: x86 parity, ArithError, and three refusal bugs

Browse Source 
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.
This commit is contained in:
Joseph Ferano 2026-09-20 22:55:11 +07:00
parent abe7e8cd46
commit 831cab9fb2
14 changed files with 430 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
FIX.org
View File

@ -4080,6 +4080,24 @@ full pass and reword things."
=restart-at= with the index for every choice, name as receipt, so the =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". 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 ** Deferred, ready to build
- Restart locations. The =%restart= frame is mirrored across emit.ml, x86.ml - 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 and flan_rt.c (fields 0-9 today), so giving =continue= a file:line:col

94
emacs/flan-cnr.el
View File

@ -154,8 +154,13 @@ as its numbers and every other condition reads as its own."
(not (string-match-p "\n" (nth 2 f))))) (not (string-match-p "\n" (nth 2 f)))))
fields))) fields)))
(when short (when short
(mapconcat (lambda (f) (format "%s %s" (nth 0 f) (nth 2 f))) (concat (mapconcat (lambda (f) (format "%s %s" (nth 0 f) (nth 2 f)))
(seq-take short 4) ", ")))) (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) (defun flan-cnr--site-line-col (site)
"The (LINE . COL) a SITE string names, or nil." "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)) (let ((source (plist-get state :source))
(lc (flan-cnr--site-line-col site))) (lc (flan-cnr--site-line-col site)))
(when (and source lc) (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 "\n" (propertize prefix 'face 'shadow) source "\n")
(insert (make-string (+ (length prefix) (max 0 (1- (cdr lc)))) ?\s) (insert pad (propertize "^" 'face 'error) "\n")))))))
(propertize "^" 'face 'error) "\n")))))))
(defun flan-cnr--insert-condition (state) (defun flan-cnr--insert-condition (state)
(let* ((name (or (plist-get state :condition) "a condition")) (let* ((name (or (plist-get state :condition) "a condition"))
@ -207,8 +222,18 @@ indexing or the division itself, so it sits directly under the headline."
(let ((fields (plist-get state :fields)) (let ((fields (plist-get state :fields))
(why (plist-get state :fields-why))) (why (plist-get state :fields-why)))
(if (null fields) (if (null fields)
(insert (propertize (concat " not available — " ;; Three different empties, and only one of them is a refusal. A
(or why (flan-cnr--why 'layout)) "\n") ;; 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)) 'face 'font-lock-comment-face))
(progn (progn
;; The section-wide reason, once, above the rows — repeating it per ;; The section-wide reason, once, above the rows — repeating it per
@ -628,6 +653,8 @@ data and the fixture-driven tests can drive it without a socket."
(plist-get fields :fields) (plist-get fields :fields)
fields) fields)
:fields-why (and (keywordp (car-safe fields)) (plist-get fields :why)) :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 ;; 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 ;; 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 ;; 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 up by the same name. So it resolves without anything here knowing what package
it came from. it came from.
A refusal is not an error here: nil means the layout section draws the reason A refusal is not an error here: `:fields' nil means the section draws the
it is empty, which is the degradation the buffer is already built for." reason it is empty, which is the degradation the buffer is already built for,
(when (and type (not (string-empty-p type))) and `:why' carries the daemon's own sentence for it — a bare name it will not
(let ((r (funcall flan-cnr-request-function (list :op "layout" :type type)))) guess between two packages reads better than anything this end could invent.
(when (equal (plist-get r :status) "ok")
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) (mapcar (lambda (f)
;; The value is nil: the shape of a condition is a fact ;; The value is nil: the shape of a condition is a
;; about the build, its contents are a fact about the ;; fact about the build, its contents are a fact about
;; stopped frame, and this op only ever answers the first. ;; the stopped frame, and this op only ever answers
;; the first.
(list (nth 0 f) (nth 1 f) nil)) (list (nth 0 f) (nth 1 f) nil))
(plist-get r :fields)))))) (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) (defun flan-cnr-condition-fields (type)
"The stopped condition's fields with their values, or what stands in. "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. ;; still shows, with its own reason in the value column.
(mapcar (lambda (f) (list (nth 0 f) nil nil (nth 1 f))) (mapcar (lambda (f) (list (nth 0 f) nil nil (nth 1 f)))
(plist-get r :refused))) (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)) (let* ((why (plist-get r :message))
(r2 (when (and type (not (string-empty-p type))) (fallback (flan-cnr-layout type)))
(funcall flan-cnr-request-function (list :fields (plist-get fallback :fields)
(list :op "layout" :type type)))) :why (if (plist-get fallback :fields)
(ok2 (equal (plist-get r2 :status) "ok")) (or why (plist-get fallback :why))
(layout (when ok2 (or (plist-get fallback :why) why)))))))
(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")))))))
(defun flan-cnr-backtrace () (defun flan-cnr-backtrace ()
"The stopped program's frames, innermost first, as the renderer wants them. "The stopped program's frames, innermost first, as the renderer wants them.

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

@ -1191,6 +1191,41 @@ would be overwritten. Look again and re-do the edit")
(test-flan--check "every field renders with its value" (test-flan--check "every field renders with its value"
(string-match-p ":length +i64 +100" text))) (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 ;; 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 ;; leak into the buffer, and the fix is pinned as a property of the whole
;; rendering rather than of one string. ;; rendering rather than of one string.

9
emacs/test-flan.el
View File

@ -242,9 +242,14 @@ already rely on it — so nothing here is a stand-in for the real thing."
(require 'flan-cnr) (require 'flan-cnr)
(let ((flan-cnr-request-function #'flan--request)) (let ((flan-cnr-request-function #'flan--request))
(test-flan--check "a struct's fields come back named and typed" (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" (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 ;; 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 ;; text comes from the buffer, so this exercises `beginning-of-defun' against

54
lib/dev.ml
View File

@ -408,7 +408,12 @@ let trap_site t =
| exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e) | exception Unix.Unix_error (e, _, _) -> Error (Unix.error_message e)
| text -> | text ->
let line = String.trim text in 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) else Ok (if line = "-" || line = "" then None else Some line)
(* Where a stopped program is, one frame per line, innermost first — the same (* 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 (match open_in path with
| exception Sys_error _ -> None | exception Sys_error _ -> None
| ic -> | 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 = let rec skip n =
match input_line ic with match input_line ic with
| exception End_of_file -> None | exception End_of_file -> None
| exception Sys_error _ -> None
| text -> if n <= 1 then Some text else skip (n - 1) | text -> if n <= 1 then Some text else skip (n - 1)
in in
let r = skip line in let r = match skip line with r -> r | exception _ -> None in
close_in_noerr ic; close_in_noerr ic;
r) r)
| Some _ -> None)) | Some _ -> None))
@ -1872,27 +1884,45 @@ let condition_op t =
| Error m -> error m | Error m -> error m
| Ok v -> | Ok v ->
(* One line per field — name, type, value, tab separated, and (* One line per field — name, type, value, tab separated, and
safe because every string the renderer emits is escaped. *) safe because every string the renderer emits is escaped.
let entries =
List.filter_map 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 -> (fun line ->
match String.split_on_char '\t' line with match String.split_on_char '\t' line with
| [ n; ty; value ] -> | [ n; ty; value ] ->
Some entries :=
(Wire.list Wire.list
[ Wire.quote n; Wire.quote ty; Wire.quote value ]) [ Wire.quote n; Wire.quote ty; Wire.quote value ]
| _ -> None) :: !entries
(String.split_on_char '\n' v) | _ ->
in 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 ok
[ ":type " ^ Wire.quote cname; [ ":type " ^ Wire.quote cname;
":fields " ^ Wire.list entries; ":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 " ":refused "
^ Wire.list ^ Wire.list
(List.map (List.map
(fun (n, why) -> (fun (n, why) ->
Wire.list [ Wire.quote n; Wire.quote 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 (* [(: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 rooting mode. [docs/BUILT.md]'s "Two ways to root a walk" says what each root

24
lib/render.ml
View File

@ -48,6 +48,12 @@ type emitter = {
registry to call. *) registry to call. *)
type pointers = { type pointers = {
live : Tast.expr -> Tast.expr; (* a (Ptr a) -> bool: may it be read *) 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 (* 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 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 [<ptr>] inventing a sentence about one would be worse than the silence [<ptr>]
@ -105,6 +111,24 @@ let rec render c depth (e : Tast.expr) : Tast.expr list =
else else
match e.Tast.ty with match e.Tast.ty with
| Types.Int Types.U64 -> [ c.emit.eu64 e ] | 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.Int _ -> [ c.emit.ei64 (cast (Types.Int Types.I64) e) ]
| Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ] | Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ]
| Types.Bool -> | Types.Bool ->

17
lib/session.ml
View File

@ -947,6 +947,10 @@ let externs : Tast.extern list =
{ Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition"; { Tast.ename = "flan/dev-cond"; esym = "flan_agent_condition";
eparams = []; eret = Types.Ptr (Types.Int Types.U8); eparams = []; eret = Types.Ptr (Types.Int Types.U8);
eloc = Loc.unknown }; 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"; { Tast.ename = "flan/dev-begin"; esym = "flan_dev_result_begin";
eparams = []; eret = Types.Unit; eloc = Loc.unknown }; eparams = []; eret = Types.Unit; eloc = Loc.unknown };
{ Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end"; { Tast.ename = "flan/dev-end"; esym = "flan_dev_result_end";
@ -1013,6 +1017,19 @@ let dev_pointers : Render.pointers =
{ Tast.e = { Tast.e =
Tast.Do [ ask "flan/reg-emit" p; Tast.Do [ ask "flan/reg-emit" p;
{ Tast.e = Tast.Unit; ty = Types.Unit; loc } ]; { 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 }) } ty = Types.Unit; loc }) }
(* ── The locals of a stopped frame ─────────────────────────────────── *) (* ── The locals of a stopped frame ─────────────────────────────────── *)

51
runtime/flan_dev.c
View File

@ -351,6 +351,57 @@ void flan_dev_emit_str(const uint8_t *bytes, int64_t len) {
put_str(flan_dev_emit, bytes, 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) { void flan_dev_result_end(void) {
truncate_value(result, &result_len, RESULT_MAX, result_full); truncate_value(result, &result_len, RESULT_MAX, result_full);
close_value(&generation); close_value(&generation);

11
test/programs/dev-break.flan
View File

@ -24,6 +24,17 @@
(set ticks (+ ticks 1)) (set ticks (+ ticks 1))
ticks) 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 (defn main [] i32
(agent/start "/tmp/flan-dev-break-fallback.sock") (agent/start "/tmp/flan-dev-break-fallback.sock")
(print (fetch 1)) (println "") (print (fetch 1)) (println "")

9
test/programs/dev-locals.flan
View File

@ -14,7 +14,14 @@
(defn look [n i64 label string] i64 (defn look [n i64 label string] i64
(let [p (Point {.x 1.5 .y 2.5}) (let [p (Point {.x 1.5 .y 2.5})
xs [10 20 30] 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, ;; 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 ;; 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. ;; name — [s6] is not a variable anyone can find in this file.

6
test/programs/generics.flan
View File

@ -175,6 +175,12 @@
(println (next-after (i64 10))) (println (next-after (i64 10)))
(println (next-after 2.5)) (println (next-after 2.5))
(println (next-after (u8 254))) (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)) (println (plus-300 1))
;; And the prelude's own three, which are these bodies under their real ;; And the prelude's own three, which are these bodies under their real

2
test/test_acceptance.ml
View File

@ -2662,7 +2662,7 @@ let () =
and which this does not second-guess. *) and which this does not second-guess. *)
let generics_out = let generics_out =
"3\n4.5\ntrue\n7\n5\n-1\n5\n42\n3\n1\n10\n1\n8\n\ "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\ true\ntrue\nfalse\n\
3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\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\ 0\n-1\n2.5\n0\ntrue\nfalse\ntrue\n2\n0\n\

134
test/test_dev.ml
View File

@ -1134,6 +1134,80 @@ let () =
(Option.value ~default:(status r) (Wire.string_field r "message")) (Option.value ~default:(status r) (Wire.string_field r "message"))
end end
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 (* ...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 *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 that has never run, because it is the one that ends a program. Break
@ -1229,7 +1303,14 @@ let () =
in in
let xpid = let xpid =
Unix.create_process flan 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 Unix.stdin xfd Unix.stderr
in in
Unix.close xfd; Unix.close xfd;
@ -1669,6 +1750,14 @@ let () =
("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("p", "Point", "(Point {.x 1.5 .y 2.5})");
("xs", "[3 i32]", "[ 10 20 30]"); ("xs", "[3 i32]", "[ 10 20 30]");
("flag", "bool", "true"); ("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 (* [hop] is [dotimes]'s index and it is listed; the loop's
hidden bound sits in the very next slot and is *not* — a hidden bound sits in the very next slot and is *not* — a
compiler temp is hidden, not refused, because [s6] 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. *) holding [p]'s value and nothing would say so. *)
let r = let r =
ask 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 in
if status r <> "ok" then if status r <> "ok" then
fail "installing a renamed body while stopped: %s" fail "installing a renamed body while stopped: %s"
@ -4647,6 +4740,29 @@ let () =
l l
| _ -> [] | _ -> []
in 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) if status r <> "ok" then fail "x86 backtrace: %s" (said r)
else else
(match frames with (match frames with
@ -4691,6 +4807,12 @@ let () =
("p", "Point", "(Point {.x 1.5 .y 2.5})"); ("p", "Point", "(Point {.x 1.5 .y 2.5})");
("xs", "[3 i32]", "[ 10 20 30]"); ("xs", "[3 i32]", "[ 10 20 30]");
("flag", "bool", "true"); ("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, (* Same two rows the LLVM listing pins: the loop index shown,
the loop's hidden bound hidden, the shadowing rebind kept the loop's hidden bound hidden, the shadowing rebind kept
raw because the outer [label] is on the same list. *) 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 else if Wire.string_field r "value" <> Some "(Point {.x 1.5 .y 2.5})" then
fail "x86 inspect of slot 2 answered %S" fail "x86 inspect of slot 2 answered %S"
(Option.value ~default:"" (Wire.string_field r "value")); (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 (* 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 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 could most easily not — the place forms the walk ends at are lowered

6
vendor/agent/flan_agent.c vendored
View File

@ -526,7 +526,11 @@ static int snap_push(int resumable, void *cond) {
s->sitelen = 0; s->sitelen = 0;
if (flan_break_site != NULL && flan_break_site_len > 0) { if (flan_break_site != NULL && flan_break_site_len > 0) {
int64_t k = flan_break_site_len; 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); memcpy(s->site, flan_break_site, (size_t)k);
s->sitelen = (int32_t)k; s->sitelen = (int32_t)k;
/* Consumed, not just read. The trap site clears the global when its hook /* Consumed, not just read. The trap site clears the global when its hook