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.
This commit is contained in:
parent
abe7e8cd46
commit
831cab9fb2
18
FIX.org
18
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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
60
lib/dev.ml
60
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
|
||||
|
||||
@ -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 [<ptr>]
|
||||
@ -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 ->
|
||||
|
||||
@ -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 ─────────────────────────────────── *)
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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 "")
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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\
|
||||
|
||||
134
test/test_dev.ml
134
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
|
||||
|
||||
6
vendor/agent/flan_agent.c
vendored
6
vendor/agent/flan_agent.c
vendored
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user