diff --git a/FIX.org b/FIX.org index 1dacf00..aef70c6 100644 --- a/FIX.org +++ b/FIX.org @@ -4110,3 +4110,50 @@ full pass and reword things." - A site for user =error= calls. flan_error has no loc parameter; threading one through means both backends' call emission. Same lane as above if the frame is being touched anyway. +* The INSERTIONSORT crash, 2026-09-20 — bytes copies, rodata traps, segfaults park + +** What happened +The author dogfooded an in-place sort over (bytes "INSERTIONSORT"). (bytes s) +was a zero-cost reinterpret — the [u8] aliased the string's storage — so the +sort wrote into a string constant. The compiled build appeared to carry on +(measured: at -O2 LLVM deletes the store as UB, so the program silently does +nothing; at -O0 both backends already emitted the data read-only and the +store trapped). The dev session hard-crashed with no message at all: the +merged daemon runs the program's code in its own process, so the SIGSEGV +took compiler, socket and session down together. + +** The decisions, in the author's words +1. "I would expect bytes to copy, but there should be an equivalent slice + function for read-only." — (bytes s) now allocates a writable copy of the + string's bytes; (bytes-view s) is the old free reinterpret, read-only by + convention. (string b), the mirror reinterpret, is unchanged. +2. "Don't we have allocators for this sort of thing?" — the copy goes + through the allocator surface like every allocating operation: (bytes s) + takes the context allocator, (bytes s a) names one, failure signals + StorageExhausted with retry, and dev builds note the block in the + allocation registry. Never a hidden malloc. +3. String constants are read-only on every path — LLVM `constant` globals, + x86 .rodata — so a stray write traps immediately and identically at -O0 + on both backends and in the session (pinned in test_acceptance.ml; the + -O2 store deletion is UB and is documented, not pinned). +4. A segfault in a dev session is a stop, not a silent death: dev builds + install a SIGSEGV/SIGBUS handler (flan_dev_crash_enable, constructor + emitted only in dev builds) that names the address and the innermost + frame, then parks in the break loop through flan_trap_hook exactly like + the no-channel traps — the daemon stays alive, describe answers + :condition "SegFault", evals still run. Release builds are untouched. + +** Open directions left here +- Read-only slice types. bytes-view is read-only *by convention* only: the + type system has no way to say a [u8] cannot be stored through, so the + rodata trap is the enforcement. A read-only slice (or provenance) is what + would move that refusal to compile time. +- (clone slice) / (clone slice a) as the general spelling of what (bytes s) + does for strings. Not done now: clone answers its argument's type, and a + cloned [u8] would be a block with no owner — the same who-frees question + bytes answers by leaning on free-all/destroy. If slices grow a clone, the + two should share the lowering (flan_bytes_dup already is it). +- The bytes copy is reclaimable only by its allocator's free-all or + arena-destroy — the slice carries no allocator, so (free) cannot take it. + Fine against an arena or the frame allocator; a heap-tier copy is a block + that lives until exit. Documented in BUILT.md's surface table. diff --git a/NEXT.md b/NEXT.md index 5c98104..6683727 100644 --- a/NEXT.md +++ b/NEXT.md @@ -2734,24 +2734,29 @@ memcheck sweep (`@valgrind`), whose alarm is looser at 5400s because memcheck is `rl/draw-text` is safe for a third reason: the shim's `flan_shim_cstr` copies out of ptr+len before the call. - **Writing through a string literal is undefined, and the two build modes - disagree about how.** `(let [s (bytes "Hi")] (set (at s 0) \h))` stores into + disagree about how.** *Narrowed 2026-09-20, after the INSERTIONSORT + dogfooding crash (FIX.org): `(bytes s)` now answers a writable copy from + the context allocator, so the common spelling no longer reaches this edge + at all. What remains is `(bytes-view s)`, the renamed reinterpret.* + `(let [s (bytes-view "Hi")] (set (at s 0) \h))` stores into a `private unnamed_addr constant`. At `-O0` that is a store to read-only - memory and the program takes SIGSEGV; at `-O2` LLVM deletes it as undefined - and the program prints `Hi` and exits 0. Same source, and which way it fails - depends on a flag — the worst shape available, and worse than either outcome - alone. + memory and the program takes SIGSEGV — now pinned on both backends, and a + dev session parks on it with a report instead of dying; at `-O2` LLVM + deletes it as undefined and the program prints `Hi` and exits 0. Same + source, and which way it fails depends on a flag — the worst shape + available, and worse than either outcome alone. - Nothing refuses it. `bytes` turns a `string` into a `[u8]`, the language lets - you write through a slice, and by then nothing records that the bytes came - from a constant. The honest fix is provenance — knowing a slice's origin — - which is plan.org open decision #3 and deliberately deferred. A cheaper one - that is *not* a fix: emitting literals as mutable globals only moves which - flag misbehaves, and costs their read-only placement. + Nothing refuses it. `bytes-view` turns a `string` into a `[u8]`, the + language lets you write through a slice, and by then nothing records that + the bytes came from a constant. The honest fix is provenance or a + read-only slice type — plan.org open decision #3, still deferred. A + cheaper one that is *not* a fix: emitting literals as mutable globals only + moves which flag misbehaves, and costs their read-only placement. Found by the string lane while deciding whether `lower-ascii` should mutate in place. It ships the copying version for exactly this reason, and that is the rule to follow until provenance exists: **a function over a `string` must - not write through it.** + not write through it — `bytes-view` is for reading.** Most of these are edges the language keeps and you should know about. Two — the top-level namespace and the shift count, diff --git a/calc-me.flan b/calc-me.flan index f5fc8fb..d7a46b1 100644 --- a/calc-me.flan +++ b/calc-me.flan @@ -120,6 +120,6 @@ (defn main [args [string]] i32 (if (< (len args) 2) (do (println "usage: calc-me \"1 + 2 * 3\"") 1) - (match (evaluate (bytes (at args 1))) + (match (evaluate (bytes-view (at args 1))) (Some v) (do (print v) (println "") 0) None (do (println "calc-me: cannot parse") 1)))) diff --git a/docs/BUILT.md b/docs/BUILT.md index 010816d..d44e652 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -2409,6 +2409,8 @@ fires. | `(as-slice v)` / `(as-slice v lo hi)` | a non-owning `[T]` view | | `(clone v)` / `(clone v a)` | the only copy; assignment moves | | `(free v)` | consumes its argument | +| `(bytes s)` / `(bytes s a)` | a writable copy of a string's bytes, against the context or a named allocator — an allocating operation like `vec-new`: StorageExhausted with retry, a registry note in dev builds. The answer is a `[u8]` view of the block, so nothing can `free` it through the slice; it lives until its allocator's `free-all` or destroy | +| `(bytes-view s)` | the string's own storage as a `[u8]`, costing nothing — the old `(bytes s)` reinterpret, renamed. Read-only by convention: a literal's view points into `.rodata` and a store through it traps | ### Three amendments to a frozen spec, and one addition diff --git a/examples/digits.flan b/examples/digits.flan index ba5b88a..c9aa8e1 100644 --- a/examples/digits.flan +++ b/examples/digits.flan @@ -7,7 +7,7 @@ ;;;; allocator to build one in. So a number was drawn one glyph at a time out ;;;; of a `[10 string]` table. ;;;; -;;;; `(string b)` closed that. It is the mirror of `(bytes s)` and costs no +;;;; `(string b)` closed that. It is the mirror of `(bytes-view s)` and costs no ;;;; instructions — a `string` and a `[u8]` are the same 16-byte %slice — so ;;;; `(string (i64->bytes n))` draws in one call and the table, the per-glyph ;;;; pen and the digit arithmetic behind them are gone. diff --git a/examples/text-codepoints-loading.flan b/examples/text-codepoints-loading.flan index 0fa883e..38e0967 100644 --- a/examples/text-codepoints-loading.flan +++ b/examples/text-codepoints-loading.flan @@ -19,7 +19,7 @@ ;;;; come back out of LoadCodepoints as the right 54, and as 49 distinct ones. ;;;; Nothing in the ;;;; language claims to know what a character is — a `string` is bytes and a -;;;; `[u8]` is the same bytes, which `(string ...)` and `(bytes ...)` say in +;;;; `[u8]` is the same bytes, which `(string ...)` and `(bytes-view ...)` say in ;;;; both directions — and that turns out to be exactly the right amount of ;;;; opinion for this. The count below is a count of codepoints because raylib ;;;; decoded them, not because Flan did. @@ -132,7 +132,7 @@ ;; for the duration of the call, which is all GetCodepointNext wants, because ;; it only ever reads forwards. (defn codepoint-at [off i32 size-out (Ptr i32)] i32 - (let [b (bytes text)] + (let [b (bytes-view text)] (if (>= off (len b)) 0 (rl/get-codepoint-next (string (slice b off (len b))) size-out)))) @@ -145,7 +145,7 @@ ;; behaviour a reader of this example would have expected anyway. (defn step-forward [off i32] i32 (let [size 0 - b (bytes text)] + b (bytes-view text)] (if (>= off (len b)) off (do (codepoint-at off (addr size)) @@ -167,7 +167,7 @@ ;; still the right answer for a language with no raylib in it; it is not the ;; right answer for this program. (defn step-back [off i32] i32 - (let [b (bytes text) + (let [b (bytes-view text) size 0] (if (<= off 0) 0 diff --git a/examples/text-rectangle-bounds.flan b/examples/text-rectangle-bounds.flan index 0dc1a30..9051b40 100644 --- a/examples/text-rectangle-bounds.flan +++ b/examples/text-rectangle-bounds.flan @@ -165,7 +165,7 @@ "raylib [text] example - draw text inside a rectangle") (defer (rl/close-window)) - (let [text (bytes message) + (let [text (bytes-view message) resizing? false word-wrap? true container (rl/Rectangle {.x 25.0 .y 25.0 diff --git a/examples/text-writing-anim.flan b/examples/text-writing-anim.flan index 255ab3a..ec3aa46 100644 --- a/examples/text-writing-anim.flan +++ b/examples/text-writing-anim.flan @@ -28,7 +28,7 @@ ;;;; the C's, and it costs one `min`. ;;;; ;;;; The message is a `[u8]` and not a `string` because `slice` takes an array -;;;; or a slice; `(bytes "…")` is the bridge in the other direction from +;;;; or a slice; `(bytes-view "…")` is the bridge in the other direction from ;;;; `(string …)` and costs nothing either. The embedded newline is written as ;;;; an escape, and raylib's draw-text breaks the line on it. @@ -66,7 +66,7 @@ ;; One character every ten frames. The clamp is the whole difference from ;; the C — see the header comment. - (let [b (bytes message) + (let [b (bytes-view message) n (min (i32 (len b)) (/ frames-counter 10))] (rl/draw-text (string (slice b 0 n)) 210 160 20 rl/maroon)) diff --git a/lib/check.ml b/lib/check.ml index f4f8b47..445adeb 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -7045,9 +7045,9 @@ and named_call ?(qualified = false) ctx ~want loc name args = The one sharp edge, and it is not new: the slice this hands back points into .rodata, so a store through it either segfaults at -O0 or is deleted at -O2 — the same measured trap the prelude's ASCII-case note describes - for (bytes "Hi"). Clone the bytes into a Vec for a mutable copy. Nothing - here widens that hole; it inherits it, and provenance is what would close - it. *) + for (bytes-view "Hi"). Copy the bytes — (bytes s) does exactly that for a + string — for a mutable buffer. Nothing here widens that hole; it inherits + it, and read-only slice types are what would close it (FIX.org). *) | "embed" -> (match args with | [ p ] | [ p; _ ] -> @@ -7496,14 +7496,78 @@ and named_call ?(qualified = false) ctx ~want loc name args = expect ctx loc ~want (mk loc (Types.Option a.Tast.ty) (Tast.Some_ a)) (* ── the milestone-2 host primitives (plan.org) ────────────────── *) - | "bytes" -> + (* (bytes-view s): the string's own storage seen as a [u8], costing nothing. + This is what (bytes s) used to be, renamed for what it is: a *view*. The + slice aliases the string — a literal's view points into .rodata and a + store through it traps at -O0 on either backend — so it is read-only by + convention until the type system can say so (FIX.org, read-only slices). + Reading through it is the whole use: bytes=?, split, index-of-bytes and + every other comparison walks a string's bytes without copying them. *) + | "bytes-view" -> arity ctx loc name 1 args; prim Tast.Bytes (Types.Slice (Types.Int Types.U8)) [ check ctx ~want:Types.String (List.hd args) ] - (* (string b): a [u8] seen as a string. The mirror of (bytes s), spelled the - same way — a type name in head position, like (bytes s) and unlike the - numeric casts, which go through [is_cast] and really do convert. + (* (bytes s) / (bytes s a): a *writable copy* of the string's bytes, from + the context allocator or one named — never a hidden malloc, which is + spec-memory.md's frozen rule over every allocating operation. It used to + be the zero-cost reinterpret above, and the author's in-place sort over + (bytes "INSERTIONSORT") wrote into the string constant; "I would expect + bytes to copy" is the ruling this implements. + + The lowering mirrors [vec-new]: a hidden (Vec u8) temp holds the block so + the allocation registry can read its extent, the attempt sits under + [alloc_guard] so a failure signals StorageExhausted with retry, and the + answer is the [as-slice] of the whole of it. The slice carries no + allocator, so nothing can [free] this block through it — it lives until + its allocator's free-all or destroy, which is the story every borrowed + view already has and is written down in BUILT.md's surface table. + + No [region_check]: that guard compares a Vec header being *stored* against + the region it lands in, and the header here is a temp nothing stores. *) + | "bytes" -> + (match args with + | s :: rest when List.length rest <= 1 -> + let u8 = Types.Int Types.U8 in + let s = check ctx ~want:Types.String s in + let a = allocator_arg ctx loc rest in + (* The string is bound before the guard's loop, so a retry re-attempts + the same copy rather than re-evaluating the expression that produced + the string. Same rule as [push]'s element. *) + let sv = fresh_slot ctx Types.String in + let v = fresh_slot ctx (Types.Vec u8) in + let out = fresh_slot ctx (Types.Slice u8) in + let attempt = + rt loc (Types.Int Types.I8) "flan_bytes_dup" + [ mk loc (Types.Vec u8) (Tast.Local v); a; + mk loc Types.String (Tast.Local sv); here loc ] + in + let fill = + rt loc Types.Unit "flan_vec_as_slice" + [ mk loc (Types.Vec u8) (Tast.Local v); + addr_of loc (mk loc (Types.Slice u8) (Tast.Local out)); + mk loc index_ty (Tast.Int (0L, Types.I32)); + mk loc index_ty (Tast.Int (-1L, Types.I32)); + size_of loc u8; here loc ] + in + expect loc ~want + (mk loc (Types.Slice u8) + (Tast.Let + ([ (sv, s); + (v, mk loc (Types.Vec u8) (Tast.Zero (Types.Vec u8))); + (out, mk loc (Types.Slice u8) (Tast.Zero (Types.Slice u8))) ], + [ with_note loc (alloc_guard ctx loc attempt) + (reg_note loc "flan_dev_reg_note_vec" + (mk loc (Types.Vec u8) (Tast.Local v)) + [ size_of loc u8 ] u8); + fill; + mk loc (Types.Slice u8) (Tast.Local out) ]))) + | _ -> fail loc "bytes is (bytes s) or (bytes s allocator)") + + (* (string b): a [u8] seen as a string. The mirror of (bytes-view s), + spelled the same way — a type name in head position, like (bytes s) and + unlike the numeric casts, which go through [is_cast] and really do + convert. It costs nothing. emit.ml lowers Types.String and Types.Slice _ to the same %slice, 16 bytes at align 8, so a string and a [u8] are already the @@ -7527,12 +7591,12 @@ and named_call ?(qualified = false) ctx ~want loc name args = of it does not make. 2. It does not widen the literal-write hole (NEXT.md, "Writing through a - string literal"). That hole is the other direction: (bytes "Hi") hands - you a writable-looking slice over constant data. This direction only - loses the ability to write — a string is read-only everywhere — so the - result of (string b) can reach strictly fewer stores than b could. - Provenance is still what the other direction needs; nothing here - depends on having it. + string literal"). That hole is the other direction: (bytes-view "Hi") + hands you a writable-looking slice over constant data — narrowed since + (bytes s) became a copy, and closable only by read-only slice types + (FIX.org). This direction only loses the ability to write — a string + is read-only everywhere — so the result of (string b) can reach + strictly fewer stores than b could. The sharp edge left here is one of lifetime and no longer one of sharing: the slice that i64->bytes / f64->bytes / u64->bytes answer is a view into @@ -8812,10 +8876,17 @@ let builtins : (string * string * string) list = written as a name rather than as a call."); (* the host primitives *) - ("bytes", "bytes [string] [u8]", - "A string seen as a byte slice. It costs nothing — both are a ptr and a \ - length at run time — and it decodes nothing. A literal's bytes are \ - constant data, so the slice looks writable and is not."); + ("bytes", "bytes [string Allocator?] [u8]", + "A writable copy of the string's bytes, from the current allocator or \ + one named. It allocates like vec-new does — a failure signals \ + StorageExhausted with retry — and the block lives until its \ + allocator's free-all or destroy. For reading without a copy, \ + bytes-view."); + ("bytes-view", "bytes-view [string] [u8]", + "The string's own storage seen as a byte slice. It costs nothing — both \ + are a ptr and a length at run time — and it decodes nothing. \ + Read-only by convention: a literal's bytes are constant data, so the \ + slice looks writable and a store through it traps."); ("string", "string [[u8]] string", "A byte slice seen as a string, and free at run time. It does not check \ UTF-8, because `string` does not claim UTF-8 — valid-utf8? is an \ diff --git a/lib/emit.ml b/lib/emit.ml index a85c1ef..f5d59b7 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3831,12 +3831,14 @@ declare void @flan_dyn_root_globals_begin() declare void @flan_dyn_root_globals_end() declare void @flan_gc_init() declare void @flan_dev_reg_enable() +declare void @flan_dev_crash_enable() declare void @flan_dev_reg_note_vec(ptr, i64, ptr, i64) declare void @flan_dev_reg_note_map(ptr, i64, i64, ptr, i64) declare i8 @flan_vec_init(ptr, ptr, i64, i64, i64, ptr, i64) declare i8 @flan_vec_reserve(ptr, i64, i64, i64, ptr, i64) declare i8 @flan_vec_push(ptr, ptr, i64, i64, ptr, i64) declare i8 @flan_vec_clone(ptr, ptr, ptr, i64, i64, ptr, i64) +declare i8 @flan_bytes_dup(ptr, ptr, ptr, i64, ptr, i64) declare i64 @flan_vec_len(ptr, ptr, i64) ; These two take the transfer channel as well, because a Vec's bounds check is ; inside the runtime rather than emitted here and (at v i) has to signal the @@ -4342,9 +4344,16 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) program linked into a C host has no [main] of ours to put a line at the top of. Priority 65535 is the default slot; nothing here needs to beat another constructor, only to beat the program. *) + (* And the crash handler, in the same slot and for a cousin of the same + reason: a dev-build segfault must park the program in front of the + daemon instead of taking the whole session down silently, and the + handler has to be installed before any program code can fault. Only in + a dev build — the constructor is emitted here and nowhere else — so a + release build dies exactly the way it always did. *) Buffer.add_string m.out - "@llvm.global_ctors = appending global [1 x { i32, ptr, ptr }] \ - [{ i32, ptr, ptr } { i32 65535, ptr @flan_dev_reg_enable, ptr null }]\n"; + "@llvm.global_ctors = appending global [2 x { i32, ptr, ptr }] \ + [{ i32, ptr, ptr } { i32 65535, ptr @flan_dev_reg_enable, ptr null }, \ + { i32, ptr, ptr } { i32 65535, ptr @flan_dev_crash_enable, ptr null }]\n"; Buffer.add_char m.out '\n' end; List.iter (emit_global m ~hidden) p.Tast.globals; diff --git a/lib/prelude.ml b/lib/prelude.ml index d896150..ea7678a 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -547,7 +547,7 @@ let source = {flan| ;; ── Bytes ───────────────────────────────────────────────────────────── ;; -;; Over [u8] and not over string, so (bytes s) is what a caller writes and one +;; Over [u8] and not over string, so (bytes-view s) is what a caller writes and one ;; copy of each serves strings and byte slices both — which is as close to a ;; generic as a language without them gets. Nothing here allocates: every ;; result is a bool, an index, or a number. @@ -1472,11 +1472,11 @@ let source = {flan| ;; comparison over two inputs beats lowering both and comparing. What is *not* ;; on offer is the third shape, lowering a [u8] in place, and it is worth ;; saying why rather than shipping it. A string -;; literal is emitted `private unnamed_addr constant` (emit.ml), so (bytes +;; literal is emitted `private unnamed_addr constant` (emit.ml), so (bytes-view ;; "Hello") is a [u8] pointing straight into read-only memory. An in-place ;; lower-ascii type checks against that slice, and what happens next depends ;; on the optimiser — which is the worst of the available answers. Measured, -;; with (set (at (bytes "Hi") 0) \h): +;; with (set (at (bytes-view "Hi") 0) \h): ;; ;; -O0 the store is emitted against the constant and the program takes ;; SIGSEGV. @@ -1485,9 +1485,10 @@ let source = {flan| ;; ;; So the same source either dies or silently does nothing depending on a ;; flag, and the -O2 half is the quiet-wrongness class this file keeps -;; refusing elsewhere. Given a byte function instead, a caller that really -;; does own its buffer writes the two-line loop itself over storage it can -;; see the declaration of. +;; refusing elsewhere. (bytes s) answers a writable copy now for exactly this +;; reason; these byte functions stay the right call when no copy is wanted, +;; and a caller that really does own its buffer writes the two-line loop +;; itself over storage it can see the declaration of. ;; ;; ASCII only, and only the 26 letters: case outside ASCII is not a byte ;; operation at all — it is per-code-point, it is not length-preserving (ß @@ -1607,11 +1608,11 @@ let source = {flan| (append b (f64->bytes x))) ;; concat and join. Both take a slice of slices, which is the shape a caller -;; already has: an array literal of them, [(bytes "a") (bytes b)], slices to a +;; already has: an array literal of them, [(bytes-view "a") (bytes-view b)], slices to a ;; [[u8]] and copies nothing. ;; ;; join with an empty separator is concat, and concat is here anyway because -;; the empty (bytes "") a caller would have to write is the kind of argument +;; the empty (bytes-view "") a caller would have to write is the kind of argument ;; that reads like a mistake at the call site. (defn concat [parts [[u8]]] (Vec u8) (let [b (vec-new u8)] @@ -1655,7 +1656,7 @@ let source = {flan| b)) ;; Every non-overlapping occurrence, left to right, which is the rule that -;; makes (replace-bytes (bytes "aaa") (bytes "aa") (bytes "b")) answer "ba" and +;; makes (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b")) answer "ba" and ;; not "bb" or "b". ;; ;; An empty `from` matches nothing and the result is a copy of the input. The @@ -1764,10 +1765,10 @@ let source = {flan| p (clamp prec 0 9)] (cond (not (= x x)) - (append (addr b) (bytes "nan")) + (append (addr b) (bytes-view "nan")) (and (= x (* x 2.0)) (!= x 0.0)) - (append (addr b) (bytes (if (< x 0.0) "-inf" "inf"))) + (append (addr b) (bytes-view (if (< x 0.0) "-inf" "inf"))) :else (let [neg (< x 0.0) @@ -1879,7 +1880,7 @@ let source = {flan| ;; (embed-find (slice assets 0 (len assets)) "brush.png"). (defn embed-find [files [EmbedFile] name string] (Option [u8]) (dotimes [i (len files)] - (when (bytes=? (bytes (.name (at files i))) (bytes name)) + (when (bytes=? (bytes-view (.name (at files i))) (bytes-view name)) (return (Some (.data (at files i)))))) None) @@ -2268,7 +2269,7 @@ let source = {flan| (defn form-sym? [f Form name string] bool (match f - (Form.Sym s) (bytes=? (bytes s) (bytes name)) + (Form.Sym s) (bytes=? (bytes-view s) (bytes-view name)) _ false)) ;; Whether a form is the empty list, (). [form-items] cannot answer this: it diff --git a/lib/x86.ml b/lib/x86.ml index b3419cf..05c11d5 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -4589,7 +4589,13 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) Buffer.add_string out (Printf.sprintf "\t.section\t.init_array,\"aw\",@init_array\n\t.align\t8\n%s\ \t.quad\t%s\n\n" - (if dev then "\t.quad\tflan_dev_reg_enable\n" else "") data_sym); + (if dev then + (* The crash handler rides the same dev-only slot as the registry: + a segfault in a dev build parks the program instead of silently + ending the session, and release assembly stays byte-for-byte + what it was. *) + "\t.quad\tflan_dev_reg_enable\n\t.quad\tflan_dev_crash_enable\n" + else "") data_sym); (* The ABI marker, and only in a dev build: it exists for redefinition modules to bind against, a release build has no cells to load one into, and gating it here is what keeps a release build's assembly byte-for-byte diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index a56f74d..84cd82f 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -1829,3 +1829,135 @@ static void flan_reg_report(void) { "flan: the table overflowed, so this is a floor and not a " "count\n"); } + +/* ── A segfault in a dev session is a stop, not a silent death ───────── + * + * The dogfooding session this exists for: an in-place sort over + * (bytes "INSERTIONSORT") — the old zero-cost reinterpret — wrote into a + * string constant, and the session died with no message at all. The daemon + * runs the program's code in its own process, so the SIGSEGV took the + * compiler, the socket and the editor's session down together, and the + * program was not even told which address it touched. + * + * In a dev build the fault parks instead. SIGSEGV and SIGBUS are synchronous: + * the handler runs on the faulting thread, at the faulting instruction, with + * the shadow-stack chain intact — which is exactly the state an unhandled + * condition stops in. So after one line naming the address and the innermost + * Flan frame, the handler enters the same trap hook the runtime's six + * no-channel refusals use (flan_rt.c's rt_trap): the program stands still, + * the backtrace, locals and globals can all be read, a resume is refused + * with a reason, and the daemon stays alive serving evaluations. With no + * agent listening — flan_trap_hook NULL — the disposition is restored and + * the signal re-raised, so a standalone dev binary still dies with the exit + * code a segfault always had. + * + * The honest fine print, all of it deliberate for a dev-only path: + * + * - The break loop is not async-signal-safe (fprintf, nanosleep, the + * install queue). For a *synchronous* fault in program code this is the + * accepted trade every Lisp that maps SIGSEGV to a condition makes: the + * alternative is dying silently, which is the bug. A fault that lands + * inside malloc's own bookkeeping can deadlock the parked thread; the + * session it would have killed outright is still alive either way. + * - The handler runs on an alternate stack, sized well past SIGSTKSZ, + * because the commonest dev segfault is a stack overflow and a handler + * on the overflowed stack never runs. Thunks evaluated while parked run + * on that stack too, so it is a real stack, not a landing pad. + * - A fault inside the handler (or a second fault while parked) restores + * the default disposition and re-raises: one loud death, never a loop. + * - In a merged `flan dev' this shadows the OCaml runtime's own SIGSEGV + * handler, which it uses to turn daemon-side stack overflow into a + * Stack_overflow exception. That trade is accepted with eyes open: the + * program faulting is the case that happens, the daemon overflowing its + * OCaml stack is not. + * - Under ASan the sanitizer's handler is the better report and arrives + * armed before any constructor here; detected (the weak __asan_init) + * and left alone. + * + * Installed by a global constructor the compiler emits ONLY into dev builds, + * next to the one that arms the allocation registry — a release build never + * calls this, links no constructor naming it, and dies the way it always + * did. */ + +#include +#include + +extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen); +extern void __asan_init(void) __attribute__((weak)); + +static volatile sig_atomic_t flan_crash_entered; + +/* write(2) and byte-spelling only: the fault may have landed anywhere, + * including inside stdio. */ +static void crash_puts(const char *s, size_t n) { + ssize_t r = write(2, s, n); + (void)r; +} + +static void crash_hex(uintptr_t x) { + char b[2 + sizeof(uintptr_t) * 2]; + size_t i = sizeof b; + do { b[--i] = "0123456789abcdef"[x & 0xf]; x >>= 4; } while (x != 0); + b[--i] = 'x'; + b[--i] = '0'; + crash_puts(b + i, sizeof b - i); +} + +static void crash_handler(int sig, siginfo_t *si, void *uc) { + (void)uc; + if (flan_crash_entered++) goto die; + crash_puts("\nflan: ", 7); + if (sig == SIGBUS) crash_puts("SIGBUS", 6); else crash_puts("SIGSEGV", 7); + { + static const char touched[] = " \xe2\x80\x94 the program touched "; + crash_puts(touched, sizeof touched - 1); + } + crash_hex((uintptr_t)si->si_addr); + if (flan_frame_head != NULL && flan_frame_head->info != NULL) { + const flan_fninfo *fi = flan_frame_head->info; + crash_puts(" in ", 4); + crash_puts(fi->name, (size_t)fi->namelen); + crash_puts(" (", 2); + crash_puts(fi->loc, (size_t)fi->loclen); + crash_puts(")", 1); + } + { + static const char why[] = + "\nflan: a write through a read-only slice (bytes-view of a literal), " + "a null, or a stack overflow\n"; + crash_puts(why, sizeof why - 1); + } + if (flan_trap_hook != NULL) { + /* Parks for good, exactly like NullAllocator and the other no-channel + * traps: there is no address to resume *at* — the faulting instruction + * would fault again — so this is a place to stand and read. */ + if (sig == SIGBUS) + flan_trap_hook((const uint8_t *)"BusError", 8); + else + flan_trap_hook((const uint8_t *)"SegFault", 8); + } +die: + signal(sig, SIG_DFL); + raise(sig); +} + +void flan_dev_crash_enable(void) { + static int done; + struct sigaction sa; + stack_t ss; + if (done) return; + done = 1; + /* ASan's own SIGSEGV report is strictly better and already installed. */ + if (&__asan_init != NULL) return; + /* A real stack, not a landing pad: the park loop evaluates thunks here. */ + ss.ss_size = 1 << 20; + ss.ss_sp = malloc(ss.ss_size); + ss.ss_flags = 0; + if (ss.ss_sp == NULL || sigaltstack(&ss, NULL) != 0) return; + memset(&sa, 0, sizeof sa); + sa.sa_sigaction = crash_handler; + sa.sa_flags = SA_SIGINFO | SA_ONSTACK; + sigemptyset(&sa.sa_mask); + sigaction(SIGSEGV, &sa, NULL); + sigaction(SIGBUS, &sa, NULL); +} diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 0cc5b09..4864ec6 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1773,6 +1773,19 @@ void flan_vec_free(flan_vec *v, int64_t size, int64_t align, v->epoch = 0; } +/* (bytes s): a writable copy of a string's bytes, into a block the named + * allocator owns. The header the compiler hands in is a hidden temp — the + * caller's answer is a slice over the block — but it is a real Vec, so the + * registry note, the epoch word and free-all's reclaim all work on it the way + * they work on any Vec of u8. Element size and align are 1 by construction. */ +int8_t flan_bytes_dup(flan_vec *v, flan_allocator *a, const uint8_t *p, + int64_t n, const uint8_t *loc, int64_t loclen) { + if (!flan_vec_init(v, a, n, 1, 1, loc, loclen)) return 0; + if (n > 0) memcpy(v->ptr, p, (size_t)n); + v->len = n; + return 1; +} + int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a, int64_t size, int64_t align, const uint8_t *loc, int64_t loclen) { diff --git a/spec-memory.md b/spec-memory.md index 86520ef..f79d5df 100644 --- a/spec-memory.md +++ b/spec-memory.md @@ -698,9 +698,10 @@ the allocator cannot satisfy a request, the operation signals with `error`, whose type is `Never` (spec-conditions.md §2), inside a `restart-case` offering `retry`. This is one rule over *every* allocating -operation — `vec-new`, `map-new`, `push`, `put`, `reserve`, `clone` — so their -result types stay `(Vec T)`, `()`, `()` and so on, with no `Result` and no -out-parameter anywhere. +operation — `vec-new`, `map-new`, `push`, `put`, `reserve`, `clone`, and +`bytes` since it became a copy (2026-09-20; `bytes-view` is the free view) — +so their result types stay `(Vec T)`, `()`, `()` and so on, with no `Result` +and no out-parameter anywhere. What that buys, against the alternative: Odin's `append` returns an ignorable `Allocator_Error` (`base/runtime/core_builtin.odin:767`, diff --git a/spike/x86/p11-reversed-slice.flan b/spike/x86/p11-reversed-slice.flan index d276d4e..4e2ad00 100644 --- a/spike/x86/p11-reversed-slice.flan +++ b/spike/x86/p11-reversed-slice.flan @@ -18,7 +18,7 @@ ;;;; arguments and is not a number either optimiser can see, so the branch ;;;; cannot be folded away and the checker has no literal to object to. (defn main [args [string]] i32 - (let [s (bytes "hello") + (let [s (bytes-view "hello") hi (i32 (len args)) lo (+ hi 1)] (print (slice s lo hi)) diff --git a/spike/x86/p4-convention.flan b/spike/x86/p4-convention.flan index 58ca7f0..e719e6c 100644 --- a/spike/x86/p4-convention.flan +++ b/spike/x86/p4-convention.flan @@ -22,6 +22,6 @@ (print (sum3 v)) (println "") (print (sum3 w)) (println "") (print (eight 1 2 3 4 5 6 7 8)) (println "") - (print (taglen (bytes "hello"))) (println "") + (print (taglen (bytes-view "hello"))) (println "") (print (.z w)) (println "")) 0) diff --git a/test/programs/algorithms.flan b/test/programs/algorithms.flan index 052cdc9..23abeb8 100644 --- a/test/programs/algorithms.flan +++ b/test/programs/algorithms.flan @@ -85,13 +85,13 @@ ;; comes before "apple" because 'Z' is 90. A prefix comes before what extends ;; it, which is the case a loop running only to (len a) reads off the end ;; for, and 0x80 above 0x00 is the case a signed byte gets backwards. - (print (bytes (len args) 1) (i32 (bytes->i64 (bytes (at args 1)))) 0)] + (let [which (if (> (len args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0)] (cond (= which 1) ;; The refusal. The context here is the heap, which can free one diff --git a/test/programs/arith.flan b/test/programs/arith.flan index 4601e64..3f1fab5 100644 --- a/test/programs/arith.flan +++ b/test/programs/arith.flan @@ -31,7 +31,7 @@ (defvar wide f32 1e30) (defn main [args [string]] i32 - (let [n (i32 (bytes->i64 (bytes (at args 1)))) + (let [n (i32 (bytes->i64 (bytes-view (at args 1)))) ;; The most negative i64. No literal spells it — the reader parses the ;; digits and then negates, and the positive half does not fit — so it ;; is built, which also keeps it out of the constant folder's reach. diff --git a/test/programs/bounds-condition.flan b/test/programs/bounds-condition.flan index 3c5a34f..da621b2 100644 --- a/test/programs/bounds-condition.flan +++ b/test/programs/bounds-condition.flan @@ -104,7 +104,7 @@ (set (at grid 2) 12) (set (at grid 3) 13) - (let [s (bytes "hello") ; len 5 + (let [s (bytes-view "hello") ; len 5 v (vec-new i32)] (push v 100) (push v 200) diff --git a/test/programs/bounds.flan b/test/programs/bounds.flan index 228c519..ad63f0e 100644 --- a/test/programs/bounds.flan +++ b/test/programs/bounds.flan @@ -16,8 +16,8 @@ (defvar arr [3 i32]) (defn main [args [string]] i32 - (let [n (i32 (bytes->i64 (bytes (at args 1)))) - s (bytes "hello")] ; len 5 + (let [n (i32 (bytes->i64 (bytes-view (at args 1)))) + s (bytes-view "hello")] ; len 5 (cond ;; In bounds, including both edges: the last index, and a slice that ;; ends exactly at len. Neither may trap. diff --git a/test/programs/bytes-copy.flan b/test/programs/bytes-copy.flan new file mode 100644 index 0000000..d0c74df --- /dev/null +++ b/test/programs/bytes-copy.flan @@ -0,0 +1,38 @@ +;;;; (bytes s) copies, (bytes-view s) aliases — the ruling from the +;;;; INSERTIONSORT dogfooding session. The pin is the exact inverse of the +;;;; old aliasing: a write through the copy leaves the original string +;;;; printing unchanged, where the old (bytes s) either showed the write +;;;; through or trapped, depending on where the string's storage was. + +(defvar frame Allocator) + +(defn main [] i32 + ;; 1. The copy is writable and independent. Under the old reinterpret this + ;; second line printed ZNSERTIONSORT too (or the whole program died in + ;; .rodata) — the original staying itself is the whole of the change. + (let [s "INSERTIONSORT" + b (bytes s)] + (set (at b 0) \Z) + (println (string b)) ; ZNSERTIONSORT + (println s)) ; INSERTIONSORT + + ;; 2. A literal's copy is writable — the exact form that used to segfault + ;; at -O0 and silently do nothing at -O2. + (let [b (bytes "hi")] + (set (at b 0) \H) + (println (string b))) ; Hi + + ;; 3. The view still costs nothing and reads the string's own storage. + (let [v (bytes-view "abc")] + (println (len v)) ; 3 + (println (at v 2))) ; 99 + + ;; 4. (bytes s a) names the allocator, like (vec-new T a) and (clone v a): + ;; the copy's block comes from the arena and free-all reclaims it. + (set frame (arena-new 4096)) + (let [b (bytes "arena" frame)] + (set (at b 4) \A) + (println (string b))) ; arenA + (free-all frame) + (arena-destroy frame) + 0) diff --git a/test/programs/bytes-view-write.flan b/test/programs/bytes-view-write.flan new file mode 100644 index 0000000..23bfc59 --- /dev/null +++ b/test/programs/bytes-view-write.flan @@ -0,0 +1,19 @@ +;;;; A store through (bytes-view "literal") lands in the string constant's +;;;; own storage, which both backends emit read-only — LLVM as a `constant` +;;;; global, x86 in .rodata — so the write traps where it happens instead of +;;;; corrupting the literal. Pinned at -O0 on both backends, where the store +;;;; is really emitted; at -O2 LLVM deletes it as undefined behaviour, which +;;;; is why this program has no -O2 row. The trap itself (SIGSEGV on a +;;;; read-only page) is the defined consequence of the emission, not a bet on +;;;; anything further. +;;;; +;;;; If this ever exits 0, string data has become writable somewhere and the +;;;; read-only-by-convention story of bytes-view is silently gone. + +(defn main [] i32 + (let [v (bytes-view "INSERTIONSORT")] + (set (at v 0) \Z) + ;; Never reached: the store above traps. Printing anyway makes a failure + ;; loud — output where none was expected. + (print (string v)) + 0)) diff --git a/test/programs/bytes2.flan b/test/programs/bytes2.flan index 5117785..9a2a813 100644 --- a/test/programs/bytes2.flan +++ b/test/programs/bytes2.flan @@ -23,22 +23,22 @@ ;; from a trim that printed the wrong slice of length zero. (defn show-trim [s string] () (print "[") - (print (trim (bytes s))) + (print (trim (bytes-view s))) (print "]")) (defn main [] i32 - (show-idx (index-of-bytes (bytes "hello world") (bytes "world"))) ; 6, at the end - (show-idx (index-of-bytes (bytes "hello world") (bytes "hello"))) ; 0, at the start - (show-idx (index-of-bytes (bytes "hello world") (bytes "o w"))) ; 4, in the middle - (show-idx (index-of-bytes (bytes "banana") (bytes "na"))) ; 2, first of two - (show-idx (index-of-bytes (bytes "aaab") (bytes "aab"))) ; 1, after false starts + (show-idx (index-of-bytes (bytes-view "hello world") (bytes-view "world"))) ; 6, at the end + (show-idx (index-of-bytes (bytes-view "hello world") (bytes-view "hello"))) ; 0, at the start + (show-idx (index-of-bytes (bytes-view "hello world") (bytes-view "o w"))) ; 4, in the middle + (show-idx (index-of-bytes (bytes-view "banana") (bytes-view "na"))) ; 2, first of two + (show-idx (index-of-bytes (bytes-view "aaab") (bytes-view "aab"))) ; 1, after false starts (println "") - (show-idx (index-of-bytes (bytes "hello") (bytes "hellp"))) ; -1, last byte differs - (show-idx (index-of-bytes (bytes "hi") (bytes "hiya"))) ; -1, longer, no trap - (show-idx (index-of-bytes (bytes "") (bytes "a"))) ; -1, empty haystack - (show-idx (index-of-bytes (bytes "hello") (bytes ""))) ; 0, empty needle - (show-idx (index-of-bytes (bytes "") (bytes ""))) ; 0, both empty - (show-idx (index-of-bytes (bytes "hello") (bytes "hello"))) ; 0, whole string + (show-idx (index-of-bytes (bytes-view "hello") (bytes-view "hellp"))) ; -1, last byte differs + (show-idx (index-of-bytes (bytes-view "hi") (bytes-view "hiya"))) ; -1, longer, no trap + (show-idx (index-of-bytes (bytes-view "") (bytes-view "a"))) ; -1, empty haystack + (show-idx (index-of-bytes (bytes-view "hello") (bytes-view ""))) ; 0, empty needle + (show-idx (index-of-bytes (bytes-view "") (bytes-view ""))) ; 0, both empty + (show-idx (index-of-bytes (bytes-view "hello") (bytes-view "hello"))) ; 0, whole string (println "") (show-trim " hi ") ; [hi] @@ -61,35 +61,35 @@ ;; Accepted. The last is the round trip through %g that proves the value and ;; not merely the acceptance is right. - (print (match (parse-f64 (bytes "0")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "3.5")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "-3.5")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "+0.25")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1e3")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1.5E-2")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "12")) (Some v) v None -999.0)) + (print (match (parse-f64 (bytes-view "0")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "3.5")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "-3.5")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "+0.25")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1e3")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1.5E-2")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "12")) (Some v) v None -999.0)) (println "") ;; Refused. Every one of these is a number out of strtod, which is the point. - (print (match (parse-f64 (bytes "")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "abc")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1x")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes ".")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1e")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1e+")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes " 1")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "1 ")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "0x10")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "nan")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes "+")) (Some v) v None -999.0)) + (print (match (parse-f64 (bytes-view "")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "abc")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1x")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view ".")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1e")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1e+")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view " 1")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "1 ")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "0x10")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "nan")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view "+")) (Some v) v None -999.0)) (println "") ;; A trailing dot with no fraction is a C float literal and is accepted; a ;; leading one is too. Both are here because they are the boundary the ;; digit counter, not the position, decides. - (print (match (parse-f64 (bytes "1.")) (Some v) v None -999.0)) (print " ") - (print (match (parse-f64 (bytes ".5")) (Some v) v None -999.0)) + (print (match (parse-f64 (bytes-view "1.")) (Some v) v None -999.0)) (print " ") + (print (match (parse-f64 (bytes-view ".5")) (Some v) v None -999.0)) (println "") ;; Parsing a trimmed field, which is why both exist. - (print (match (parse-f64 (trim (bytes " 2.25 "))) (Some v) v None -999.0)) + (print (match (parse-f64 (trim (bytes-view " 2.25 "))) (Some v) v None -999.0)) (println "") 0) diff --git a/test/programs/dev-segv.flan b/test/programs/dev-segv.flan new file mode 100644 index 0000000..528263c --- /dev/null +++ b/test/programs/dev-segv.flan @@ -0,0 +1,17 @@ +;;;; The dogfooding crash, replayed on purpose: a write through a bytes-view +;;;; of a string literal lands in read-only memory and takes SIGSEGV. In a +;;;; dev session that used to kill the whole process — daemon, compiler and +;;;; socket together, with no message at all. The dev build's crash handler +;;;; turns it into the same park the no-channel traps take: one line naming +;;;; the address and the frame, then the break loop, with the daemon alive +;;;; and answering behind it. There is no restart to list — a faulting +;;;; instruction has nowhere to resume at — which is the same empty-list +;;;; shape dev-trap-null-alloc.flan pins for free-all. +(import agent "vendor:agent") + +(defn main [] i32 + (agent/start "/tmp/flan-dev-segv-fallback.sock") + (let [v (bytes-view "INSERTIONSORT")] + (set (at v 0) \Z) + (print (string v)) + 0)) diff --git a/test/programs/dyn-view.flan b/test/programs/dyn-view.flan index 14b013e..9845f03 100644 --- a/test/programs/dyn-view.flan +++ b/test/programs/dyn-view.flan @@ -55,7 +55,7 @@ (defvar rows [2 (Vec i64)]) (defn main [args [string]] i32 - (let [n (i32 (bytes->i64 (bytes (at args 1))))] + (let [n (i32 (bytes->i64 (bytes-view (at args 1))))] (cond (= n 0) (do diff --git a/test/programs/edn-provide.flan b/test/programs/edn-provide.flan index 318eaab..8f730f3 100644 --- a/test/programs/edn-provide.flan +++ b/test/programs/edn-provide.flan @@ -76,7 +76,7 @@ (print (.field d)) (print " in ") (println (.struct d))))] - (let [t (Tuning-of-bytes (bytes drifted) a)] + (let [t (Tuning-of-bytes (bytes-view drifted) a)] ;; The fields that were there are read, which is the other half of the ;; contract: a drifted file is reported, not refused. :speed is the one ;; that was missing and is zero. @@ -102,7 +102,7 @@ (print (.struct e)) (print ": ") (println (edn/error-message (.code e)))))] - (let [t (Tuning-of-bytes (bytes broken) a)] + (let [t (Tuning-of-bytes (bytes-view broken) a)] ;; Read anyway, and zeroed, which is the half a handler that carries on ;; is choosing. Printed so that "it signalled" and "it gave back nothing ;; usable" are two claims rather than one. diff --git a/test/programs/edn-read.flan b/test/programs/edn-read.flan index 39da26f..8e945e0 100644 --- a/test/programs/edn-read.flan +++ b/test/programs/edn-read.flan @@ -55,22 +55,22 @@ ;; The size of a set after the dedup, which is the whole of what the dedup can ;; be asked for. (defn set-size [src string] () - (println (len (edn/read (bytes src))))) + (println (len (edn/read (bytes-view src))))) ;; Malformed input, told apart from the document `nil` by the cursor — the ;; return value alone cannot say it, and this is the spelling that can. (defn malformed? [src string] bool - (let [c (edn/cursor (bytes src)) + (let [c (edn/cursor (bytes-view src)) t (edn/next (addr c)) v (edn/read-value (addr c) t)] ; the value is not the question here (not (edn/ok? (addr c))))) -;; A document in a buffer this program owns and can write to. (bytes "literal") +;; A document in a buffer this program owns and can write to. (bytes-view "literal") ;; is not that — a literal is constant data behind a writable-looking slice — ;; so the source is built with append and the write goes through as-slice. (defn survives-its-buffer [] () (let [buf (vec-new u8)] - (append (addr buf) (bytes "{:name \"level-1\" :xs [1 2]}")) + (append (addr buf) (bytes-view "{:name \"level-1\" :xs [1 2]}")) (let [src (as-slice buf) v (edn/read src)] (dotimes [i (len src)] diff --git a/test/programs/edn.flan b/test/programs/edn.flan index d9c845a..f57b773 100644 --- a/test/programs/edn.flan +++ b/test/programs/edn.flan @@ -41,7 +41,7 @@ :else "?")) (defn dump [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (edn/cursor b) t (edn/next (addr c))] (while (and (edn/ok? (addr c)) (!= (.kind t) edn/tok-eof)) @@ -59,7 +59,7 @@ ;; tokenizer that answered err-unexpected-byte for every one of these would ;; pass a test that only checked that it failed. (defn refusal [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (edn/cursor b)] (while (and (edn/ok? (addr c)) (!= (.kind (edn/next (addr c))) edn/tok-eof))) @@ -122,7 +122,7 @@ e)) (defn show-enemy [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (edn/cursor b) e (read-enemy (addr c))] (if (edn/ok? (addr c)) diff --git a/test/programs/files.flan b/test/programs/files.flan index adf8178..094dbf9 100644 --- a/test/programs/files.flan +++ b/test/programs/files.flan @@ -40,7 +40,7 @@ (make-directory "files-tmp") (println (file-exists? "files-tmp")) ; true - (barf "files-tmp/one.txt" (bytes "0123456789")) + (barf "files-tmp/one.txt" (bytes-view "0123456789")) (match (file-size "files-tmp/one.txt") (Some n) (println n) ; 10 None (println "missing")) @@ -64,7 +64,7 @@ (set last-op (.op c)) (make-directory "files-tmp/sub") (invoke-restart 'retry))] - (barf "files-tmp/sub/deep.txt" (bytes "deep"))) + (barf "files-tmp/sub/deep.txt" (bytes-view "deep"))) (println seen) ; 1 (println (= last-reason file-missing)) ; true (println (= last-op file-op-write)) ; true diff --git a/test/programs/format.flan b/test/programs/format.flan index 5005c41..6fdb5e1 100644 --- a/test/programs/format.flan +++ b/test/programs/format.flan @@ -87,11 +87,11 @@ ;; needs the integer part copied out before the fraction is rendered, because ;; both come through the runtime's one shared scratch buffer. (let [b (vec-new u8)] - (append (addr b) (bytes "fps ")) + (append (addr b) (bytes-view "fps ")) (let [f (format-f64 59.94 1)] (append (addr b) (as-slice f)) (free f)) - (append (addr b) (bytes " / frame ")) + (append (addr b) (bytes-view " / frame ")) (let [f (format-f64 0.0166667 4)] (append (addr b) (as-slice f)) (free f)) diff --git a/test/programs/generics.flan b/test/programs/generics.flan index 2912d1f..83f7aab 100644 --- a/test/programs/generics.flan +++ b/test/programs/generics.flan @@ -220,7 +220,7 @@ (println (or-else (max-of (slice fs 0 0)) 0.0)) (println (some? (index-of (slice ns 0 4) 18))) (println (some? (index-of (slice ns 0 4) 77))) - (println (some? (parse-i64 (bytes "12")))) + (println (some? (parse-i64 (bytes-view "12")))) ;; And at a $t that owns storage, which is the case the scalars above say ;; nothing about. What comes back is a *header* onto one of the two diff --git a/test/programs/json-provide.flan b/test/programs/json-provide.flan index ecb9441..80191bc 100644 --- a/test/programs/json-provide.flan +++ b/test/programs/json-provide.flan @@ -46,7 +46,7 @@ (print " in ") (println (.struct d))))] (let [c2 (Config-of-bytes - (bytes "{\"name\":\"x\",\"host\":\"h\",\"scale\":2.0,\"debug\":false,\"layers\":[1],\"window\":{\"w\":1,\"h\":1,\"origin\":{\"x\":0,\"y\":0}}}") + (bytes-view "{\"name\":\"x\",\"host\":\"h\",\"scale\":2.0,\"debug\":false,\"layers\":[1],\"window\":{\"w\":1,\"h\":1,\"origin\":{\"x\":0,\"y\":0}}}") a)] (println (.name c2)) (println (.port c2))))) diff --git a/test/programs/json.flan b/test/programs/json.flan index a3e2d6e..0f662a9 100644 --- a/test/programs/json.flan +++ b/test/programs/json.flan @@ -62,7 +62,7 @@ :else "?")) (defn dump [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (json/cursor b) t (json/next (addr c))] (while (and (json/ok? (addr c)) (!= (.kind t) json/tok-eof)) @@ -80,7 +80,7 @@ ;; tokenizer answering one generic error for all of these would pass a test ;; that only checked that it stopped. (defn refusal [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (json/cursor b)] (while (and (json/ok? (addr c)) (!= (.kind (json/next (addr c))) json/tok-eof))) @@ -258,7 +258,7 @@ ;; report what the cursor says. The position matters as much as the message — ;; a trailing comma reported at the opening brace would be useless. (defn reject [src string] () - (let [b (bytes src) + (let [b (bytes-view src) c (json/cursor b) t (json/next (addr c))] (read-value (addr c) t) @@ -405,7 +405,7 @@ ;; two lifetimes have to be separable for the scribble below to mean ;; anything. (let [buf (vec-new u8)] - (append (addr buf) (bytes doc)) + (append (addr buf) (bytes-view doc)) (with-allocator frame (let [v (read-doc (as-slice buf))] (println (describe v)) ; object diff --git a/test/programs/pkg-return.flan b/test/programs/pkg-return.flan index 2b42e09..6e76be6 100644 --- a/test/programs/pkg-return.flan +++ b/test/programs/pkg-return.flan @@ -20,7 +20,7 @@ (defn local [] Local (Local {.n 5})) (defn main [] i32 - (let [c (fresh (bytes "[1 2]")) + (let [c (fresh (bytes-view "[1 2]")) t (edn/next (addr c))] (print (.kind t)) (println "")) (print (.n (local))) (println "") diff --git a/test/programs/println.flan b/test/programs/println.flan index d77ad92..71b2cc8 100644 --- a/test/programs/println.flan +++ b/test/programs/println.flan @@ -46,7 +46,7 @@ ;; Blob row below shows -- the two are the same value printed two ways on ;; purpose, and that difference is the thing most likely to be "fixed". (println "plain string") - (println (bytes "plain bytes")) + (println (bytes-view "plain bytes")) (println 42) (println -7) diff --git a/test/programs/registry.flan b/test/programs/registry.flan index 04da9dc..63921dd 100644 --- a/test/programs/registry.flan +++ b/test/programs/registry.flan @@ -48,6 +48,17 @@ (free-all frame) (println (reg-live q)))) ; 0 either way + ;; 3. (bytes s) allocates — the copy is a block the registry sees, exactly + ;; as a Vec's is, where the old zero-cost reinterpret was invisible to + ;; every memory diagnostic because there was nothing to record. Nothing + ;; else is live by here — sections 1 and 2 both released — so the live + ;; count *is* the copy's block, and free-all takes it back to zero. + (let [b (bytes "copy" frame)] + (println (len b)) ; 4 — the string's length + (println (reg-count 1)) ; dev: 1 — the copy's block + (free-all frame) + (println (reg-count 1))) ; 0 either way + ;; Nothing is live by now except whatever the arena's own destroy leaves, so ;; the count is a statement about the table rather than about one address. (arena-destroy frame) diff --git a/test/programs/restarts.flan b/test/programs/restarts.flan index 7765f44..3a93acd 100644 --- a/test/programs/restarts.flan +++ b/test/programs/restarts.flan @@ -104,7 +104,7 @@ (defn main [args [string]] i32 ;; One argument selects a trap; none runs the table's case. (if (> (len args) 1) - (let [k (i32 (bytes->i64 (bytes (at args 1))))] + (let [k (i32 (bytes->i64 (bytes-view (at args 1))))] (cond (= k 1) (print (mismatched 90)) (= k 2) (print (mistyped 91)) diff --git a/test/programs/slurp.flan b/test/programs/slurp.flan index bb609d0..077085e 100644 --- a/test/programs/slurp.flan +++ b/test/programs/slurp.flan @@ -62,7 +62,7 @@ (println last-path) ; programs/assets/does-not-exist ;; ── barf, and reading back what it wrote ────────────────────────── - (barf "slurp-out.txt" (bytes "round trip\n")) + (barf "slurp-out.txt" (bytes-view "round trip\n")) (let [v (slurp "slurp-out.txt")] (println (len v)) ; 11 (print (string (as-slice v))) ; round trip @@ -76,7 +76,7 @@ (set seen (+ seen 1)) (set last-op (.op c)) (invoke-restart 'use-value "slurp-out.txt"))] - (barf "no-such-dir/x.txt" (bytes "second\n"))) + (barf "no-such-dir/x.txt" (bytes-view "second\n"))) (println seen) ; 1 (println (= last-op file-op-write)) ; true (let [v (slurp "slurp-out.txt")] @@ -93,7 +93,7 @@ [(FileError [c] (set seen (+ seen 1)) (set last-reason (.reason c)) - (barf "slurp-made.txt" (bytes "made by the handler\n")) + (barf "slurp-made.txt" (bytes-view "made by the handler\n")) (invoke-restart 'retry))] (let [v (slurp "slurp-made.txt")] (print (string (as-slice v))) ; made by the handler diff --git a/test/programs/string-eq.flan b/test/programs/string-eq.flan index 15883f5..8df7238 100644 --- a/test/programs/string-eq.flan +++ b/test/programs/string-eq.flan @@ -21,7 +21,7 @@ ;; so this pair shares no address and the same-pointer fast path cannot ;; fire -- what answers here is the byte loop, or the length check first ;; ruling nothing out since both are three bytes. - (let [heap (to-lower (bytes "ABC"))] + (let [heap (to-lower (bytes-view "ABC"))] (let [h (string (as-slice heap))] (println (= "abc" h)) ; true (println (!= "abc" h))) @@ -43,5 +43,5 @@ ;; lengths -- the one pair the same-pointer fast path would answer wrong on ;; if it ran before the length check instead of after. (let [s "abcd"] - (println (= s (string (slice (bytes s) 0 2))))) ; false + (println (= s (string (slice (bytes-view s) 0 2))))) ; false 0) diff --git a/test/programs/string-of-bytes.flan b/test/programs/string-of-bytes.flan index 93a2ef8..c1bc2bc 100644 --- a/test/programs/string-of-bytes.flan +++ b/test/programs/string-of-bytes.flan @@ -24,7 +24,7 @@ (print "[") (print s) (print "] ") - (print (len (bytes s))) + (print (len (bytes-view s))) (println "")) (defn main [] i32 @@ -35,29 +35,29 @@ (shows (string (i64->bytes 0))) ;; An empty slice. Length 0, and no read of the pointer. - (shows (string (slice (bytes "abc") 1 1))) + (shows (string (slice (bytes-view "abc") 1 1))) ;; A sub-view, whose length is not the underlying storage's. The bytes after ;; index 5 are still there and must not appear. - (let [s (bytes "hello world")] + (let [s (bytes-view "hello world")] (shows (string (slice s 0 5))) (shows (string (slice s 6 11))) (shows (string (slice s 11 11)))) - ;; Round trip: (bytes (string b)) is b, and both directions are the identity. + ;; Round trip: (bytes-view (string b)) is b, and both directions are the identity. (let [b (i64->bytes 1234567)] - (print (len (bytes (string b)))) + (print (len (bytes-view (string b)))) (println "")) ;; Across the declare-c boundary. The first is a sub-view — five bytes out of ;; eleven, the sixth of which is a space and not a NUL — so a shim that did ;; not copy would print "hello world" here. - (let [s (bytes "hello world")] + (let [s (bytes-view "hello world")] (print (if (>= (c-puts (string (slice s 0 5))) 0) "ok" "no")) (println "")) (print (if (>= (c-puts (string (i64->bytes 12345))) 0) "ok" "no")) (println "") ;; And an empty one: the shim's copy of a zero-length slice is "". - (print (if (>= (c-puts (string (slice (bytes "abc") 1 1))) 0) "ok" "no")) + (print (if (>= (c-puts (string (slice (bytes-view "abc") 1 1))) 0) "ok" "no")) (println "") 0) diff --git a/test/programs/strings.flan b/test/programs/strings.flan index 70d3767..df1a057 100644 --- a/test/programs/strings.flan +++ b/test/programs/strings.flan @@ -20,22 +20,22 @@ ;; i64->bytes on its own: two of its results cannot be held at once, and ;; these two numbers are both in the answer. (let [b (vec-new u8)] - (append (addr b) (bytes "x=")) + (append (addr b) (bytes-view "x=")) (append-i64 (addr b) 42) - (append (addr b) (bytes " y=")) + (append (addr b) (bytes-view " y=")) (append-i64 (addr b) -7) - (append (addr b) (bytes " r=")) + (append (addr b) (bytes-view " r=")) (append-f64 (addr b) 1.5) (show (addr b)) ; x=42 y=-7 r=1.5 (free b)) ;; concat over three parts, and over none -- the empty result rather than a ;; trap. - (let [parts [(bytes "one") (bytes "") (bytes "two")]] + (let [parts [(bytes-view "one") (bytes-view "") (bytes-view "two")]] (let [c (concat (slice parts 0 3))] (show (addr c)) ; onetwo (free c))) - (let [parts [(bytes "unused")]] + (let [parts [(bytes-view "unused")]] (let [c (concat (slice parts 0 0))] (println (len c)) ; 0 (free c))) @@ -43,26 +43,26 @@ ;; join: n parts, n-1 separators. The one-part case is the one that must not ;; emit a separator at all, and the zero-part case is the one a "append then ;; chop the tail" join gets wrong because there is no tail. - (let [parts [(bytes "a") (bytes "b") (bytes "c")]] - (let [j (join (slice parts 0 3) (bytes ", "))] + (let [parts [(bytes-view "a") (bytes-view "b") (bytes-view "c")]] + (let [j (join (slice parts 0 3) (bytes-view ", "))] (show (addr j)) ; a, b, c (free j)) - (let [j (join (slice parts 0 1) (bytes ", "))] + (let [j (join (slice parts 0 1) (bytes-view ", "))] (show (addr j)) ; a (free j)) - (let [j (join (slice parts 0 0) (bytes ", "))] + (let [j (join (slice parts 0 0) (bytes-view ", "))] (println (len j)) ; 0 (free j)) ;; An empty separator is concat. - (let [j (join (slice parts 0 3) (bytes ""))] + (let [j (join (slice parts 0 3) (bytes-view ""))] (show (addr j)) ; abc (free j))) ;; repeat, including zero times. - (let [r (repeat-bytes (bytes "ab") 3)] + (let [r (repeat-bytes (bytes-view "ab") 3)] (show (addr r)) ; ababab (free r)) - (let [r (repeat-bytes (bytes "ab") 0)] + (let [r (repeat-bytes (bytes-view "ab") 0)] (println (len r)) ; 0 (free r)) @@ -71,56 +71,56 @@ ;; -O2, and that is exactly why these exist. Digits and punctuation pass ;; through untouched, which is the range check a table-free version gets ;; wrong by shifting every byte. - (let [l (to-lower (bytes "Hello, World 42!"))] + (let [l (to-lower (bytes-view "Hello, World 42!"))] (show (addr l)) ; hello, world 42! (free l)) - (let [u (to-upper (bytes "Hello, World 42!"))] + (let [u (to-upper (bytes-view "Hello, World 42!"))] (show (addr u)) ; HELLO, WORLD 42! (free u)) ;; replace. "aaa" with "aa" -> "b" is the non-overlapping rule: the answer is ;; "ba", because the match consumes both a's and the scan resumes after them. - (let [r (replace-bytes (bytes "aaa") (bytes "aa") (bytes "b"))] + (let [r (replace-bytes (bytes-view "aaa") (bytes-view "aa") (bytes-view "b"))] (show (addr r)) ; ba (free r)) ;; A replacement longer than what it replaces, and one that is empty. - (let [r (replace-bytes (bytes "a,b,c") (bytes ",") (bytes " -- "))] + (let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view " -- "))] (show (addr r)) ; a -- b -- c (free r)) - (let [r (replace-bytes (bytes "a,b,c") (bytes ",") (bytes ""))] + (let [r (replace-bytes (bytes-view "a,b,c") (bytes-view ",") (bytes-view ""))] (show (addr r)) ; abc (free r)) ;; No occurrence is a copy, and an empty `from` is a copy -- the reading ;; where it matches everywhere is an infinite loop. - (let [r (replace-bytes (bytes "abc") (bytes "z") (bytes "!"))] + (let [r (replace-bytes (bytes-view "abc") (bytes-view "z") (bytes-view "!"))] (show (addr r)) ; abc (free r)) - (let [r (replace-bytes (bytes "abc") (bytes "") (bytes "!"))] + (let [r (replace-bytes (bytes-view "abc") (bytes-view "") (bytes-view "!"))] (show (addr r)) ; abc (free r)) ;; split. n separators, n+1 fields, always -- so the trailing empty field is ;; present, which is where Odin's own iterator and its allocating split ;; disagree with each other. - (let [f (split (bytes "a,b,c") \,)] + (let [f (split (bytes-view "a,b,c") \,)] (println (len f)) ; 3 (println (string (at f 0))) ; a (println (string (at f 2))) ; c (free f)) - (let [f (split (bytes "a,b,") \,)] + (let [f (split (bytes-view "a,b,") \,)] (println (len f)) ; 3 (println (len (at f 2))) ; 0 (free f)) - (let [f (split (bytes ",a") \,)] + (let [f (split (bytes-view ",a") \,)] (println (len f)) ; 2 (println (len (at f 0))) ; 0 (free f)) ;; No separator at all is one field, and the empty input is one empty field. - (let [f (split (bytes "abc") \,)] + (let [f (split (bytes-view "abc") \,)] (println (len f)) ; 1 (println (string (at f 0))) ; abc (free f)) - (let [f (split (bytes "") \,)] + (let [f (split (bytes-view "") \,)] (println (len f)) ; 1 (println (len (at f 0))) ; 0 (free f)) @@ -129,8 +129,8 @@ ;; round-trips through join, and the separator it rebuilds with is a ;; different one, so an implementation that handed back the original slice ;; would print the original string. - (let [f (split (bytes "a,b,c") \,)] - (let [j (join (as-slice f) (bytes "/"))] + (let [f (split (bytes-view "a,b,c") \,)] + (let [j (join (as-slice f) (bytes-view "/"))] (show (addr j)) ; a/b/c (free j)) (free f)) @@ -141,8 +141,8 @@ ;; releases the region, and arena-destroy hands it back. (let [a (arena-new 4096)] (with-allocator a - (let [parts [(bytes "in") (bytes "arena")]] - (let [j (join (slice parts 0 2) (bytes "-"))] + (let [parts [(bytes-view "in") (bytes-view "arena")]] + (let [j (join (slice parts 0 2) (bytes-view "-"))] (show (addr j)) ; in-arena ;; The free is written because the binding is dead after it either ;; way, and it keeps the block: an arena cannot release one, which diff --git a/test/programs/text.flan b/test/programs/text.flan index 1c93790..6488de4 100644 --- a/test/programs/text.flan +++ b/test/programs/text.flan @@ -10,47 +10,47 @@ (print (if b "t" "f"))) (defn main [] i32 - (show-bool (bytes=? (bytes "abc") (bytes "abc"))) ; t - (show-bool (bytes=? (bytes "abc") (bytes "abd"))) ; f same length - (show-bool (bytes=? (bytes "abc") (bytes "ab"))) ; f prefix, not equal - (show-bool (bytes=? (bytes "") (bytes ""))) ; t + (show-bool (bytes=? (bytes-view "abc") (bytes-view "abc"))) ; t + (show-bool (bytes=? (bytes-view "abc") (bytes-view "abd"))) ; f same length + (show-bool (bytes=? (bytes-view "abc") (bytes-view "ab"))) ; f prefix, not equal + (show-bool (bytes=? (bytes-view "") (bytes-view ""))) ; t (println "") - (show-bool (starts-with? (bytes "hello") (bytes "hel"))) ; t - (show-bool (starts-with? (bytes "hello") (bytes "llo"))) ; f matches the end - (show-bool (starts-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap - (show-bool (starts-with? (bytes "hello") (bytes ""))) ; t - (show-bool (starts-with? (bytes "hello") (bytes "hello"))) ; t + (show-bool (starts-with? (bytes-view "hello") (bytes-view "hel"))) ; t + (show-bool (starts-with? (bytes-view "hello") (bytes-view "llo"))) ; f matches the end + (show-bool (starts-with? (bytes-view "hi") (bytes-view "hiya"))) ; f longer, no trap + (show-bool (starts-with? (bytes-view "hello") (bytes-view ""))) ; t + (show-bool (starts-with? (bytes-view "hello") (bytes-view "hello"))) ; t (println "") - (show-bool (ends-with? (bytes "hello") (bytes "llo"))) ; t - (show-bool (ends-with? (bytes "hello") (bytes "hel"))) ; f matches the start - (show-bool (ends-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap - (show-bool (ends-with? (bytes "hello") (bytes ""))) ; t - (show-bool (ends-with? (bytes "hello") (bytes "hello"))) ; t + (show-bool (ends-with? (bytes-view "hello") (bytes-view "llo"))) ; t + (show-bool (ends-with? (bytes-view "hello") (bytes-view "hel"))) ; f matches the start + (show-bool (ends-with? (bytes-view "hi") (bytes-view "hiya"))) ; f longer, no trap + (show-bool (ends-with? (bytes-view "hello") (bytes-view ""))) ; t + (show-bool (ends-with? (bytes-view "hello") (bytes-view "hello"))) ; t (println "") ;; First occurrence, and None for a byte that is not there. - (print (match (index-of (bytes "banana") \a) (Some i) i None -1)) + (print (match (index-of (bytes-view "banana") \a) (Some i) i None -1)) (print " ") - (print (match (index-of (bytes "banana") \z) (Some i) i None -1)) + (print (match (index-of (bytes-view "banana") \z) (Some i) i None -1)) (print " ") - (print (match (index-of (bytes "") \a) (Some i) i None -1)) + (print (match (index-of (bytes-view "") \a) (Some i) i None -1)) (println "") ;; Accepted. - (print (match (parse-i64 (bytes "0")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "42")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "-42")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "+7")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "9007199254740993")) (Some v) v None -999)) + (print (match (parse-i64 (bytes-view "0")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "42")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "-42")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "+7")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "9007199254740993")) (Some v) v None -999)) (println "") ;; Refused. Each of these is a 0 out of strtoll, which is the point. - (print (match (parse-i64 (bytes "")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "abc")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "12x")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes "-")) (Some v) v None -999)) (print " ") - (print (match (parse-i64 (bytes " 1")) (Some v) v None -999)) + (print (match (parse-i64 (bytes-view "")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "abc")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "12x")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view "-")) (Some v) v None -999)) (print " ") + (print (match (parse-i64 (bytes-view " 1")) (Some v) v None -999)) (println "") (print (sign-f32 3.5)) (print " ") diff --git a/test/programs/utf8.flan b/test/programs/utf8.flan index a99bcab..85096d7 100644 --- a/test/programs/utf8.flan +++ b/test/programs/utf8.flan @@ -91,10 +91,10 @@ ;; Valid, one of each width. The empty slice is width 0 — the only input ;; that gets a 0, because every loop below advances by width and a 0 on a ;; malformed byte would hang instead of answering. - (show-dec (bytes "")) ; 0/0/f - (show-dec (bytes "A")) ; 65/1/t - (show-dec (bytes "é")) ; 233/2/t - (show-dec (bytes "日")) ; 26085/3/t + (show-dec (bytes-view "")) ; 0/0/f + (show-dec (bytes-view "A")) ; 65/1/t + (show-dec (bytes-view "é")) ; 233/2/t + (show-dec (bytes-view "日")) ; 26085/3/t (show-dec (slice emoji 0 4)) ; 128512/4/t (println "") @@ -112,30 +112,30 @@ ;; Truncated: a valid character cut short by the end of the slice, at both ;; possible cut points, and the interior of one taken on its own. - (show-dec (slice (bytes "日") 0 1)) ; lead byte alone - (show-dec (slice (bytes "日") 0 2)) ; lead plus one continuation - (show-dec (slice (bytes "日") 1 3)) ; starts mid-character - (show-dec (slice (bytes "é") 1 2)) ; a lone continuation from a literal + (show-dec (slice (bytes-view "日") 0 1)) ; lead byte alone + (show-dec (slice (bytes-view "日") 0 2)) ; lead plus one continuation + (show-dec (slice (bytes-view "日") 1 3)) ; starts mid-character + (show-dec (slice (bytes-view "é") 1 2)) ; a lone continuation from a literal (println "") ;; rune-start? is what a caller scans backwards with. - (show-bool (rune-start? (at (bytes "日") 0))) - (show-bool (rune-start? (at (bytes "日") 1))) + (show-bool (rune-start? (at (bytes-view "日") 0))) + (show-bool (rune-start? (at (bytes-view "日") 1))) (show-bool (rune-start? \A)) (println "") ;; Counting. The empty string is 0 and not 1; the mixed string is 8 runes ;; in 13 bytes, which is the whole distinction; and a malformed byte counts ;; as one, so a count never disagrees with what a renderer would draw. - (print (rune-count (bytes ""))) (print " ") - (print (rune-count (bytes "abc"))) (print " ") - (print (rune-count (bytes "héllo 日本"))) (print " ") - (print (len (bytes "héllo 日本"))) (print " ") + (print (rune-count (bytes-view ""))) (print " ") + (print (rune-count (bytes-view "abc"))) (print " ") + (print (rune-count (bytes-view "héllo 日本"))) (print " ") + (print (len (bytes-view "héllo 日本"))) (print " ") (print (rune-count (slice bad-tail 0 3))) (println "") - (show-bool (valid-utf8? (bytes ""))) - (show-bool (valid-utf8? (bytes "héllo 日本"))) + (show-bool (valid-utf8? (bytes-view ""))) + (show-bool (valid-utf8? (bytes-view "héllo 日本"))) (show-bool (valid-utf8? (slice surrogate 0 3))) (show-bool (valid-utf8? (slice overlong2 0 2))) (show-bool (valid-utf8? (slice bad-tail 0 3))) @@ -145,11 +145,11 @@ ;; rune-at: on a boundary, off a boundary, and out of range. Off a boundary ;; is None rather than a replacement character, which is where this is ;; stricter than Odin's rune_at. - (show-opt (rune-at (bytes "日本") 0)) ; 26085 - (show-opt (rune-at (bytes "日本") 3)) ; 26412 - (show-opt (rune-at (bytes "日本") 1)) ; -1, mid-character - (show-opt (rune-at (bytes "日本") 6)) ; -1, past the end - (show-opt (rune-at (bytes "") 0)) ; -1 + (show-opt (rune-at (bytes-view "日本") 0)) ; 26085 + (show-opt (rune-at (bytes-view "日本") 3)) ; 26412 + (show-opt (rune-at (bytes-view "日本") 1)) ; -1, mid-character + (show-opt (rune-at (bytes-view "日本") 6)) ; -1, past the end + (show-opt (rune-at (bytes-view "") 0)) ; -1 (println "") ;; rune-size, at every boundary and on both sides of it. @@ -208,19 +208,19 @@ ;; separator at all is one field rather than none. The empty input is the ;; case Odin's own iterator disagrees with its allocating split on — it is ;; one empty field here. - (show-split (bytes "a,b,c") \,) ; [a][b][c] - (show-split (bytes "a,,b") \,) ; [a][][b] - (show-split (bytes "abc") \,) ; [abc] - (show-split (bytes "") \,) ; [] - (show-split (bytes ",") \,) ; [][] - (show-split (bytes ",a") \,) ; [][a] - (show-split (bytes "a,") \,) ; [a][] + (show-split (bytes-view "a,b,c") \,) ; [a][b][c] + (show-split (bytes-view "a,,b") \,) ; [a][][b] + (show-split (bytes-view "abc") \,) ; [abc] + (show-split (bytes-view "") \,) ; [] + (show-split (bytes-view ",") \,) ; [][] + (show-split (bytes-view ",a") \,) ; [][a] + (show-split (bytes-view "a,") \,) ; [a][] (println "") ;; A field is a slice of the input, so trim and parse-i64 work straight off ;; one with nothing copied in between — which is the entire reason the ;; cursor shape exists. - (let [it (split-on-byte (bytes " 10 , 20 ,30") \,) + (let [it (split-on-byte (bytes-view " 10 , 20 ,30") \,) total (i64 0) going true] (while going @@ -249,17 +249,17 @@ ;; A non-ASCII byte must pass through both untouched, which is the claim ;; that "ASCII only" is a rule and not an oversight. - (show-i32 (i32 (lower-ascii (at (bytes "é") 0)))) - (show-i32 (i32 (upper-ascii (at (bytes "é") 0)))) + (show-i32 (i32 (lower-ascii (at (bytes-view "é") 0)))) + (show-i32 (i32 (upper-ascii (at (bytes-view "é") 0)))) (println "") - (show-bool (bytes-ci=? (bytes "Hello") (bytes "hELLO"))) ; t - (show-bool (bytes-ci=? (bytes "Hello") (bytes "hello!"))) ; f length first - (show-bool (bytes-ci=? (bytes "") (bytes ""))) ; t - (show-bool (bytes-ci=? (bytes "a") (bytes "b"))) ; f + (show-bool (bytes-ci=? (bytes-view "Hello") (bytes-view "hELLO"))) ; t + (show-bool (bytes-ci=? (bytes-view "Hello") (bytes-view "hello!"))) ; f length first + (show-bool (bytes-ci=? (bytes-view "") (bytes-view ""))) ; t + (show-bool (bytes-ci=? (bytes-view "a") (bytes-view "b"))) ; f ;; '@' is 'A'+32 apart from '`' the way a letter is from its own case, so a ;; fold written as a bit-xor would call these two equal. They are not. - (show-bool (bytes-ci=? (bytes "@") (bytes "`"))) ; f - (show-bool (bytes-ci=? (bytes "é") (bytes "é"))) ; t bytes match + (show-bool (bytes-ci=? (bytes-view "@") (bytes-view "`"))) ; f + (show-bool (bytes-ci=? (bytes-view "é") (bytes-view "é"))) ; t bytes match (println "") 0) diff --git a/test/programs/values.flan b/test/programs/values.flan index 0118047..1c09e93 100644 --- a/test/programs/values.flan +++ b/test/programs/values.flan @@ -15,7 +15,7 @@ (set (at arr 0) 77) (print (at c 0)) (println "")) ; 5 - (let [s (bytes "hello")] + (let [s (bytes-view "hello")] (let [v (slice s 1 3)] ; a view into the same bytes (print v) (println ""))) ; el 0) diff --git a/test/programs/virtual-controls-headless.flan b/test/programs/virtual-controls-headless.flan index c4a0762..80ace52 100644 --- a/test/programs/virtual-controls-headless.flan +++ b/test/programs/virtual-controls-headless.flan @@ -55,5 +55,5 @@ ;; write-stdout and i64->bytes are builtins (lib/check.ml), not prelude ;; functions, so this does not go through the printers. (write-stdout (i64->bytes (i64 (vc/hash-player)))) - (write-stdout (bytes "\n")) + (write-stdout (bytes-view "\n")) 0) diff --git a/test/programs/web-files.flan b/test/programs/web-files.flan index dcf5263..33cf395 100644 --- a/test/programs/web-files.flan +++ b/test/programs/web-files.flan @@ -30,6 +30,6 @@ ;; normally has not answered it. Leaving is the honest way out of a ;; save that cannot happen. (exit 0))] - (barf "web-files-out.txt" (bytes "state\n"))) + (barf "web-files-out.txt" (bytes-view "state\n"))) (println "wrote it") 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 71d33af..43a33e7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -653,6 +653,41 @@ let () = outputs "substring, trim and parse-f64" "programs/bytes2.flan" bytes2_out; outputs ~opt:"-O0" "substring, trim and parse-f64, -O0" "programs/bytes2.flan" bytes2_out; + (* (bytes s) copies and (bytes-view s) aliases — the INSERTIONSORT ruling. + The middle two lines are the pin: a write through the copy and the + original printing unchanged after it, the exact inverse of the old + reinterpret. All three build shapes, because the old behaviour differed + *by* build shape (trap at -O0, silent no-op at -O2) and the copy must + not. *) + let bytes_copy_out = + "ZNSERTIONSORT\nINSERTIONSORT\nHi\n3\n99\narenA\n" + in + outputs "bytes copies, bytes-view aliases" "programs/bytes-copy.flan" + bytes_copy_out; + outputs ~opt:"-O0" "bytes copies, bytes-view aliases, -O0" + "programs/bytes-copy.flan" bytes_copy_out; + outputs ~x86:true "bytes copies, bytes-view aliases, --x86" + "programs/bytes-copy.flan" bytes_copy_out; + (* The other half of the same ruling: a store through a bytes-view of a + literal traps, identically on both backends, because both emit string + data read-only. -O0 only — at -O2 LLVM deletes the store as UB, so + there is nothing there to pin except the UB itself. 139 is the shell's + 128+SIGSEGV. *) + let dies_segv name path ~x86 = + let exe = compile ~opt:"-O0" ~x86 path in + let code, text = run exe None in + if code <> 139 || text <> "" then begin + incr failures; + Printf.printf + "FAIL %s\n got: %S (exit %d)\n wanted: %S (exit 139)\n" + name text code "" + end; + (try Sys.remove exe with Sys_error _ -> ()) + in + dies_segv "a write through bytes-view traps, -O0" + "programs/bytes-view-write.flan" ~x86:false; + dies_segv "a write through bytes-view traps, --x86" + "programs/bytes-view-write.flan" ~x86:true; (* (string b). The conversion emits nothing — String and Slice _ are the same %slice — so the rows are about length and ownership rather than arithmetic: a number round-tripped, an empty slice, sub-views whose @@ -1246,11 +1281,11 @@ let () = — memcheck still says nothing — it makes the same read *answerable*, by a different tool. The two must not be blurred. *) outputs "registry, dev" ~dev:true "programs/registry.flan" - "1\n1\n0\n1\n0\n0\n"; + "1\n1\n0\n1\n0\n4\n1\n0\n0\n"; outputs "registry, release" "programs/registry.flan" - "0\n0\n0\n0\n0\n0\n"; + "0\n0\n0\n0\n0\n4\n0\n0\n0\n"; outputs "registry, release -O0" ~opt:"-O0" "programs/registry.flan" - "0\n0\n0\n0\n0\n0\n"; + "0\n0\n0\n0\n0\n4\n0\n0\n0\n"; (* free-all on an allocator that does not offer it traps rather than doing nothing, because "I released the region" and "I leaked the region" must not be the same program text. Its own case for the same reason the diff --git a/test/test_dev.ml b/test/test_dev.ml index c9e9574..1ef0b4e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -1675,6 +1675,15 @@ let () = in trap_park "free-all" "dev-trap-free-all.flan" "NoFreeAll" [ "continue" ]; trap_park "null allocator" "dev-trap-null-alloc.flan" "NullAllocator" []; + (* And the one that used to be a silent death rather than an exit code: + SIGSEGV. The author's dogfooding session sorted (bytes "INSERTIONSORT") + in place — the old aliasing bytes — and the session vanished without a + word. The dev build's crash handler (flan_dev_crash_enable) enters the + same trap hook the six no-channel refusals use, so everything trap_park + asserts for them holds here too: stopped and describable, an eval still + answered, a resume refused. The program writes through bytes-view, + which is the surviving spelling of that crash. *) + trap_park "segfault" "dev-segv.flan" "SegFault" []; (* ── The locals of a stopped frame ─────────────────────────────── *) diff --git a/test/test_flan.ml b/test/test_flan.ml index 1d9d57f..4298f15 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -950,6 +950,7 @@ let () = runs no passes over it. *) infers "array-fill of nothing" "(array-fill [0] 1)" "[0 i32]"; infers "bytes of a string" "(bytes \"hi\")" "[u8]"; + infers "bytes-view of a string" "(bytes-view \"hi\")" "[u8]"; infers "len is i32" "(len (bytes \"hi\"))" "i32"; infers "slice of a slice" "(slice (bytes \"hi\") 0 1)" "[u8]"; infers "parse text to f64" "(bytes->f64 (bytes \"1.5\"))" "f64"; diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index 09a124e..033ec54 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -434,8 +434,8 @@ let () = ~why:"flan_bytes_to_i64 or flan_bytes_to_f64 is reading off the end of \ a negative-length slice again — see clamp_len in flan_rt.c." "(defn main [args [string]] i32\n\ - \ (let [s (bytes \"42\")\n\ - \ n (i32 (bytes->i64 (bytes (at args 1))))]\n\ + \ (let [s (bytes-view \"42\")\n\ + \ n (i32 (bytes->i64 (bytes-view (at args 1))))]\n\ \ (print (bytes->i64 (slice s n 1)))\n\ \ (println \"\"))\n\ \ 0)\n"; diff --git a/vendor/edn/edn.flan b/vendor/edn/edn.flan index a0eec3b..8b13c4b 100644 --- a/vendor/edn/edn.flan +++ b/vendor/edn/edn.flan @@ -483,10 +483,10 @@ (token c tok-set-open lo lo lo) (error-token c))) - (bytes=? (slice s (+ lo 1) hi) (bytes "inst")) + (bytes=? (slice s (+ lo 1) hi) (bytes-view "inst")) (do (fail c err-inst lo) (error-token c)) - (bytes=? (slice s (+ lo 1) hi) (bytes "uuid")) + (bytes=? (slice s (+ lo 1) hi) (bytes-view "uuid")) (do (fail c err-uuid lo) (error-token c)) :else @@ -510,9 +510,9 @@ (set (.pos c) hi) (let [text (slice s lo hi)] (cond - (bytes=? text (bytes "nil")) (token c tok-nil lo hi lo) - (bytes=? text (bytes "true")) (token c tok-bool lo hi lo) - (bytes=? text (bytes "false")) (token c tok-bool lo hi lo) + (bytes=? text (bytes-view "nil")) (token c tok-nil lo hi lo) + (bytes=? text (bytes-view "true")) (token c tok-bool lo hi lo) + (bytes=? text (bytes-view "false")) (token c tok-bool lo hi lo) :else (token c tok-symbol lo hi lo))))))) ;; ── Reading values out of a token ─────────────────────────────────── @@ -533,16 +533,16 @@ (defn bool-of [t Token] (Option bool) (if (= (.kind t) tok-bool) - (Some (bytes=? (.text t) (bytes "true"))) + (Some (bytes=? (.text t) (bytes-view "true"))) None)) (defn text=? [t Token s string] bool - (bytes=? (.text t) (bytes s))) + (bytes=? (.text t) (bytes-view s))) ;; A keyword whose name is s. The leading colon is not part of `text`, so this ;; is written (keyword=? t "hp") and not (keyword=? t ":hp"). (defn keyword=? [t Token s string] bool - (and (= (.kind t) tok-keyword) (bytes=? (.text t) (bytes s)))) + (and (= (.kind t) tok-keyword) (bytes=? (.text t) (bytes-view s)))) ;; ── Reading past a value ──────────────────────────────────────────── diff --git a/vendor/edn/provide.flan b/vendor/edn/provide.flan index 4d2e95f..8a9b36c 100644 --- a/vendor/edn/provide.flan +++ b/vendor/edn/provide.flan @@ -59,8 +59,8 @@ (defn joined [a string b string] string (let [v (vec-new u8)] - (append (addr v) (bytes a)) - (append (addr v) (bytes b)) + (append (addr v) (bytes-view a)) + (append (addr v) (bytes-view b)) (string (as-slice v)))) (defn joined3 [a string b string c string] string @@ -117,7 +117,7 @@ (Derived {.ty ty .decls decls .reader reader .bad ""})) (defn bad? [d Derived] bool - (> (len (bytes (.bad d))) 0)) + (> (len (bytes-view (.bad d))) 0)) ;; ── The scalars a generated reader calls ──────────────────────────── ;; @@ -486,7 +486,7 @@ ;; ── Comparing and rendering a type form ───────────────────────────── (defn same-type? [a Form b Form] bool - (bytes=? (bytes (render a)) (bytes (render b)))) + (bytes=? (bytes-view (render a)) (bytes-view (render b)))) ;; A type form as text, for the refusals. Only the shapes this file builds — a ;; name, a number, `(Vec T)`, `(Map K V)` and `[n T]` — because nothing else @@ -511,10 +511,10 @@ ;; A float is deliberately absent and the checker says why: NaN is not equal to ;; itself, so there is no equality for a map to hash. (defn key-type? [t Form] bool - (let [s (bytes (render t))] - (or (bytes=? s (bytes "i64")) - (or (bytes=? s (bytes "bool")) - (bytes=? s (bytes "string")))))) + (let [s (bytes-view (render t))] + (or (bytes=? s (bytes-view "i64")) + (or (bytes=? s (bytes-view "bool")) + (bytes=? s (bytes-view "string")))))) ;; ── The macro ─────────────────────────────────────────────────────── ;; diff --git a/vendor/json/json.flan b/vendor/json/json.flan index dac0839..a186b08 100644 --- a/vendor/json/json.flan +++ b/vendor/json/json.flan @@ -615,11 +615,11 @@ (set (.pos c) hi) (let [text (slice s lo hi)] (cond - (bytes=? text (bytes "null")) (token c tok-null lo hi lo) - (bytes=? text (bytes "true")) (token c tok-bool lo hi lo) - (bytes=? text (bytes "false")) (token c tok-bool lo hi lo) - (bytes=? text (bytes "NaN")) (do (fail c err-nan-inf lo) (error-token c)) - (bytes=? text (bytes "Infinity")) (do (fail c err-nan-inf lo) (error-token c)) + (bytes=? text (bytes-view "null")) (token c tok-null lo hi lo) + (bytes=? text (bytes-view "true")) (token c tok-bool lo hi lo) + (bytes=? text (bytes-view "false")) (token c tok-bool lo hi lo) + (bytes=? text (bytes-view "NaN")) (do (fail c err-nan-inf lo) (error-token c)) + (bytes=? text (bytes-view "Infinity")) (do (fail c err-nan-inf lo) (error-token c)) :else (do (fail c err-bare-word lo) (error-token c))))) :else @@ -646,7 +646,7 @@ (defn bool-of [t Token] (Option bool) (if (= (.kind t) tok-bool) - (Some (bytes=? (.text t) (bytes "true"))) + (Some (bytes=? (.text t) (bytes-view "true"))) None)) ;; ── The one call that allocates ───────────────────────────────────── diff --git a/vendor/json/provide.flan b/vendor/json/provide.flan index af0c56c..23a0dae 100644 --- a/vendor/json/provide.flan +++ b/vendor/json/provide.flan @@ -44,8 +44,8 @@ (defn joined [a string b string] string (let [v (vec-new u8)] - (append (addr v) (bytes a)) - (append (addr v) (bytes b)) + (append (addr v) (bytes-view a)) + (append (addr v) (bytes-view b)) (string (as-slice v)))) (defn joined3 [a string b string c string] string @@ -94,7 +94,7 @@ (Derived {.ty ty .decls decls .reader reader .bad ""})) (defn bad? [d Derived] bool - (> (len (bytes (.bad d))) 0)) + (> (len (bytes-view (.bad d))) 0)) (defn with-decl [decls [Form] d Form] [Form] (form-append decls (form-cons d (form-nil)))) @@ -347,7 +347,7 @@ ;; The generated reader's key test. Against the raw interior, which is the ;; whole of why a name with an escape in it is refused above. (defn key=? [t Token s string] bool - (bytes=? (.text t) (bytes s))) + (bytes=? (.text t) (bytes-view s))) (defn has-escape? [s [u8]] bool (dotimes [i (len s)] @@ -380,7 +380,7 @@ ;; ── Comparing and rendering a type form ───────────────────────────── (defn same-type? [a Form b Form] bool - (bytes=? (bytes (render a)) (bytes (render b)))) + (bytes=? (bytes-view (render a)) (bytes-view (render b)))) ;; A type form as text, for the refusals. Only the shapes this file builds — a ;; name and `(Vec T)` — because nothing else ever reaches it. diff --git a/web/examples/structs.flan b/web/examples/structs.flan index 299e744..d48c9ca 100644 --- a/web/examples/structs.flan +++ b/web/examples/structs.flan @@ -11,7 +11,7 @@ (set (.pos c) (+ (.pos c) 1))) ; field access derefs one level (defn main [] () - (let [c (Cursor {.src (bytes "hi")})] ; pos omitted, so pos is 0 + (let [c (Cursor {.src (bytes-view "hi")})] ; pos omitted, so pos is 0 (print (peek (addr c))) (println "") (advance (addr c)) (print (peek (addr c))) (println "")))