diff --git a/lib/prelude.ml b/lib/prelude.ml index 059d186..9de2d1e 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -791,6 +791,166 @@ let source = {flan| (return false))) true))) +;; ── Building bytes, which is the tier that needed an allocator ──────── +;; +;; Everything above this line is slice-based and allocation-free, because when +;; it was written there was nothing to allocate from. Everything below it +;; *returns new storage*, which is the whole difference, and there are three +;; rules that hold for all of it. +;; +;; **The result is owned and the caller frees it.** Each of these hands back a +;; (Vec u8) or a (Vec [u8]), which is move-only: it goes with the call that +;; takes it, and nothing is released at scope exit — not at the end of a let, +;; not at the end of a function (spec-memory.md, "When storage is released"). +;; A caller writes (free v) or lets a (free-all a) take the whole region. +;; +;; **The allocator is the context's, and `with-allocator` is the override.** +;; spec-memory.md makes allocation use the current implicit allocator and +;; forbids falling back to a hidden global one. (vec-new) and (map-new) take an +;; optional trailing allocator because the checker builds them; a Flan defn has +;; fixed arity and cannot, so the choice here was an allocator parameter on +;; every one of these signatures or none. None: a caller wanting a frame arena +;; writes (with-allocator a (join parts sep)) and the Vec records the arena, so +;; the free and the clone never need it named again. +;; +;; **No Result, anywhere.** Running out of storage signals StorageExhausted +;; under a `retry` restart and no allocating operation returns an error +;; (spec-memory.md, "Allocation failure"), so these signatures say what they +;; produce and nothing about how they might fail. + +;; The builder. It is not a type: strings.Builder in Odin is a struct wrapping +;; a [dynamic]u8, and here the (Vec u8) *is* that, with push already on it — a +;; wrapper would be a move-only struct owning a Vec whose only method is the +;; one the Vec already has. What was actually missing is appending a run of +;; bytes rather than one, and that is this. +;; +;; It takes a (Ptr (Vec u8)) and not a (Vec u8), and the difference is not +;; style: a Vec parameter *moves*, so (append! b s) taking one by value would +;; consume the caller's builder on the first call and refuse the second. +(defn append! [b (Ptr (Vec u8)) s [u8]] + (dotimes [i (len s)] + (push (deref b) (at s i)))) + +;; The two number appends, and they are the reason this shape is worth having +;; rather than a formatter that answers a slice. i64->bytes and f64->bytes +;; render into one shared static buffer in the runtime, so two of their results +;; cannot be held at once and (concat [(i64->bytes a) (i64->bytes b)]) is two +;; views of the same bytes — the second call overwrote the first. These copy +;; out of that buffer before returning, so the hazard ends at the call: a +;; builder can hold as many numbers as it likes. +(defn append-i64! [b (Ptr (Vec u8)) n i64] + (append! b (i64->bytes n))) + +(defn append-f64! [b (Ptr (Vec u8)) x f64] + (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 +;; [[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 +;; that reads like a mistake at the call site. +(defn concat [parts [[u8]]] (Vec u8) + (let [b (vec-new u8)] + (dotimes [i (len parts)] + (append! (addr b) (at parts i))) + b)) + +;; n parts yield n-1 separators, and the empty slice of parts yields the empty +;; result rather than a leading separator — which is the off-by-one a join +;; written as "append part then separator, then chop the tail" gets wrong on +;; exactly that input, because there is no tail to chop. +(defn join [parts [[u8]] sep [u8]] (Vec u8) + (let [b (vec-new u8)] + (dotimes [i (len parts)] + (when (> i 0) + (append! (addr b) sep)) + (append! (addr b) (at parts i))) + b)) + +(defn repeat-bytes [s [u8] n i32] (Vec u8) + (let [b (vec-new u8)] + (dotimes [i n] + (append! (addr b) s)) + b)) + +;; The allocating halves of the ASCII case pair. The note above lower-ascii +;; explains why lowering a [u8] *in place* is a trap — a string literal is +;; emitted into .rodata, so the store either segfaults at -O0 or is deleted at +;; -O2 — and this is the shape that has no such hole: the bytes it writes are +;; its own. +(defn to-lower [s [u8]] (Vec u8) + (let [b (vec-new u8)] + (dotimes [i (len s)] + (push b (lower-ascii (at s i)))) + b)) + +(defn to-upper [s [u8]] (Vec u8) + (let [b (vec-new u8)] + (dotimes [i (len s)] + (push b (upper-ascii (at s i)))) + 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 +;; not "bb" or "b". +;; +;; An empty `from` matches nothing and the result is a copy of the input. The +;; alternative reading — that it matches at every position — is what turns this +;; into an infinite loop, and Odin's replace guards the same case for the same +;; reason. +;; +;; The guard is an `if` and not an early `(return b)`, which is not a style +;; choice: returning a Vec *moves* it, and the move analysis is a dead set over +;; the whole function, so a `return b` on one branch kills the binding for the +;; `b` at the foot of the other. One exit, one move. +(defn replace-bytes [s [u8] from [u8] to [u8]] (Vec u8) + (let [b (vec-new u8) + i 0] + (if (= (len from) 0) + (append! (addr b) s) + (while (< i (len s)) + (match (index-of-bytes (slice s i (len s)) from) + (Some k) + (do + (append! (addr b) (slice s i (+ i k))) + (append! (addr b) to) + (set i (+ i k (len from)))) + None + (do + (append! (addr b) (slice s i (len s))) + (set i (len s)))))) + b)) + +;; A (Vec [u8]) cannot be written at a let, and this one-line function is where +;; the type is said instead. (vec-new) takes its element type as a *bare +;; symbol* — check.ml's vec_new_elem resolves one name and nothing else — so +;; (vec-new [u8]) is not accepted, and a let has no type annotation to say it +;; the other way. A return type does say it. That is a compiler gap rather than +;; a language decision, and it is written down in NEXT.md. +(defn slices-new [] (Vec [u8]) (vec-new)) + +;; split, which the file used to refuse by name. The fields are slices *of the +;; input* and not copies, so nothing here owns bytes and the result dies with +;; whatever `s` pointed at — a (Vec (Vec u8)) is the shape that would own them +;; and it is refused outright, because a Vec's elements are copied and released +;; bytewise and an owner cannot survive that. +;; +;; The rule is split-on-byte's, unchanged and worth restating: n separators +;; always yield n+1 fields, so the empty input yields one empty field and a +;; trailing separator yields a trailing empty one. That is Odin's allocating +;; strings.split and not Odin's iterator, which disagree with each other. +(defn split [s [u8] sep u8] (Vec [u8]) + (let [v (slices-new) + it (split-on-byte s sep) + going true] + (while going + (match (split-next! (addr it)) + (Some f) (push v f) + None (set going false))) + v)) + ;; ── Refused, by name ────────────────────────────────────────────────── ;; ;; Every one of these needs to produce bytes that did not exist in its input, diff --git a/test/programs/strings.flan b/test/programs/strings.flan new file mode 100644 index 0000000..d1e441a --- /dev/null +++ b/test/programs/strings.flan @@ -0,0 +1,152 @@ +;;;; The prelude's second tier: the functions that return new storage. +;;;; +;;;; Every one of these was refused by name in prelude.ml until there was an +;;;; allocator to return a Vec from, and this file is the corpus that says the +;;;; refusals are lifted. The cases are chosen the way the slice-algorithm +;;;; tests were: each is an input a plausible wrong version gets wrong. +;;;; +;;;; Everything allocated here is freed, even though leaking is defined +;;;; behaviour (spec-memory.md), because this file is the example people copy. + +;;; A (Vec u8) printed as text, without the caller writing the two-step every +;;; time. as-slice borrows -- it copies ptr+len and never the elements -- so v +;;; is still the owner afterwards and is still free-able. +(defn show [v (Ptr (Vec u8))] + (println (string (as-slice (deref v))))) + +(defn main [] i32 + ;; The builder. Three appends and two numbers into one Vec, which is the + ;; case the shared static scratch buffer in the runtime makes impossible for + ;; 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-i64! (addr b) 42) + (append! (addr b) (bytes " y=")) + (append-i64! (addr b) -7) + (append! (addr b) (bytes " 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 [c (concat (slice parts 0 3))] + (show (addr c)) ; onetwo + (free c))) + (let [parts [(bytes "unused")]] + (let [c (concat (slice parts 0 0))] + (println (len c)) ; 0 + (free c))) + + ;; 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 ", "))] + (show (addr j)) ; a, b, c + (free j)) + (let [j (join (slice parts 0 1) (bytes ", "))] + (show (addr j)) ; a + (free j)) + (let [j (join (slice parts 0 0) (bytes ", "))] + (println (len j)) ; 0 + (free j)) + ;; An empty separator is concat. + (let [j (join (slice parts 0 3) (bytes ""))] + (show (addr j)) ; abc + (free j))) + + ;; repeat, including zero times. + (let [r (repeat-bytes (bytes "ab") 3)] + (show (addr r)) ; ababab + (free r)) + (let [r (repeat-bytes (bytes "ab") 0)] + (println (len r)) ; 0 + (free r)) + + ;; The allocating case pair. The input is a string literal, which lives in + ;; .rodata -- an in-place lower would either segfault at -O0 or be deleted at + ;; -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!"))] + (show (addr l)) ; hello, world 42! + (free l)) + (let [u (to-upper (bytes "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"))] + (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 " -- "))] + (show (addr r)) ; a -- b -- c + (free r)) + (let [r (replace-bytes (bytes "a,b,c") (bytes ",") (bytes ""))] + (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 "!"))] + (show (addr r)) ; abc + (free r)) + (let [r (replace-bytes (bytes "abc") (bytes "") (bytes "!"))] + (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") \,)] + (println (len f)) ; 3 + (println (string (at f 0))) ; a + (println (string (at f 2))) ; c + (free f)) + (let [f (split (bytes "a,b,") \,)] + (println (len f)) ; 3 + (println (len (at f 2))) ; 0 + (free f)) + (let [f (split (bytes ",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") \,)] + (println (len f)) ; 1 + (println (string (at f 0))) ; abc + (free f)) + (let [f (split (bytes "") \,)] + (println (len f)) ; 1 + (println (len (at f 0))) ; 0 + (free f)) + + ;; The fields are slices of the input and nothing was copied: this one + ;; 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 "/"))] + (show (addr j)) ; a/b/c + (free j)) + (free f)) + + ;; The allocator is the context's, so with-allocator moves the whole tier + ;; into an arena -- which is the answer to the fixed arity of a defn, and the + ;; reason none of these takes an allocator argument. free-all releases every + ;; one of them at once, including the Vec still bound below it. + (let [a (arena-new 4096)] + (with-allocator a + (let [parts [(bytes "in") (bytes "arena")]] + (let [j (join (slice parts 0 2) (bytes "-"))] + (show (addr j)) ; in-arena + ;; Not freed: an arena cannot release one block, and free-all is + ;; what releases this. + (free j)))) + (free-all a) + (arena-destroy a)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 098c3df..cf62871 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -452,6 +452,32 @@ let () = outputs "vec" "programs/vec.flan" vec_out; outputs ~opt:"-O0" "vec, -O0" "programs/vec.flan" vec_out; outputs ~dev:true "vec, dev" "programs/vec.flan" vec_out; + (* The prelude's second tier: the functions that return new storage, every + one of which the prelude used to refuse by name for want of an + allocator. The cases are the ones that separate a correct version from a + lucky one — join over zero and one parts, where the separator count is + -1 and 0; "aaa" with "aa" -> "b", which is "ba" only if the match is + non-overlapping; an empty `from` to replace, which is an infinite loop + under the other reading; and split's trailing and leading empty fields, + which is where Odin's iterator and Odin's own allocating split disagree. + The builder line holds two rendered integers and a float at once, which + is precisely what the runtime's shared static scratch makes impossible + for i64->bytes on its own. + + The dev run earns its place here more than most: it is the one that + checks a container's recorded allocator epoch, so it is what would catch + one of these Vecs being used after the arena under it was released. *) + let strings_out = + "x=42 y=-7 r=1.5\nonetwo\n0\na, b, c\na\n0\nabc\nababab\n0\n\ + hello, world 42!\nHELLO, WORLD 42!\n\ + ba\na -- b -- c\nabc\nabc\nabc\n\ + 3\na\nc\n3\n0\n2\n0\n1\nabc\n1\n0\na/b/c\nin-arena\n" + in + outputs "string building" "programs/strings.flan" strings_out; + outputs ~opt:"-O0" "string building, -O0" "programs/strings.flan" + strings_out; + outputs ~dev:true "string building, dev" "programs/strings.flan" + strings_out; (* A debug build, because [dty] is a separate path from everything above: [outputs ~dev:true] goes through the cells, not through DWARF, and a type with no arm there dies at emit rather than being merely undebugged.