flan/lib/prelude.ml

(** The milestone-2 prelude, written in Flan.

    Printing is deliberately *not* a primitive (plan.org, Milestone-2
    primitives): [write-stdout] is the one output primitive and everything
    above it is Flan. That is what keeps a second backend cheap — a primitive
    is the only thing implemented twice.

    It lives here as a string rather than as a file because there is no package
    loader yet; at milestone 3 it becomes an ordinary [core:] package and this
    module goes away. The acceptance programs may call anything defined here.

    No printing function is here at all any more. [print] and [println] are
    the whole printing surface, and neither is a function: both are
    compiler-provided and structural, a walk over the concrete type at the
    call site (check.ml, and the walk itself in render.ml). That is plan.org's
    Milestone 5 item, and it needed none of the rest of milestone 5 -- there
    is nothing to dispatch on at run time and no user-supplied printer to
    choose between, so no type variables are involved. The earlier note here
    said a single [println] had to wait for generics; it did not.

    The per-type family that used to live here -- [print-str], [print-i64],
    [print-f64], [print-bytes], [print-line], [newline] -- is gone, and [print]
    is strictly the better call for every one of them. [print] is the same walk
    as [println] without the trailing newline, so it covers the no-newline case
    that was the family's remaining excuse (see [show] in
    test/programs/slices.flan). And because this language has no implicit
    widening, [(print-i64 x)] forced an explicit [(i64 x)] at every site;
    [(print x)] takes the value as it is. That is not only shorter: the cast
    through the signed printer turned a [u64] above 2^63 into a negative
    number, where [print] routes it through [flan_u64_to_bytes] and prints what
    it actually holds. *)

let source = {flan|
;; The condition every allocating operation signals when the allocator cannot
;; satisfy a request — spec-memory.md, "Allocation failure". It is here rather
;; than built by the checker because it is an ordinary value struct and the
;; checker already knows how to build one of those; nothing about it is
;; special except who signals it.
;;
;; Fixed numeric fields and no rendered message, because formatting would
;; allocate and this is the one path that must not. :allocator is the
;; allocator's address, which is its identity — the same thing the epoch hangs
;; off — so a handler can tell which region ran out. Rendering happens in the
;; handler or the break loop, where a working allocator is known.
(defstruct StorageExhausted [bytes i64 align i64 allocator i64])

;; A breakpoint. (pause) stops the program where it stands and hands it to the
;; break loop, with the whole stack under it readable — C-c C-b lists the
;; frames, TAB opens one, and taking `continue` resumes at the call.
;;
;; It is spelled `pause` and not `break` because `break` is reserved for
;; leaving a loop (parse.ml refuses it by name, with the milestone), and a
;; breakpoint and a loop exit in the same word would be the worst kind of
;; collision: both are legal in the same place and mean opposite things.
;;
;; Nothing in the compiler knows about this. It is `error` under a
;; `restart-case`, which is exactly what a breakpoint is in a language that
;; already has conditions: the break loop is entered because nothing handled
;; the condition, and `continue` is an ordinary restart whose body is empty, so
;; taking it returns here and the caller carries on. A handler-bind above it
;; can therefore also intercept a Pause and decline to stop, which is the
;; behaviour a release build wants and gets for free.
(defstruct Pause [])

(defn pause []
  (restart-case (error (Pause {}))
    (continue [] (do))))

;; A seeded PRNG in Flan rather than libc's, because a grid hash is only a
;; regression test if the sequence is byte-identical on native and wasm32
;; (plan.org, RNG is ours). PCG-XSH-RR 32: one u64 LCG step per draw, folded
;; down to 32 bits by an xorshift and rotated by the state's top five bits.
(defvar rand-state u64 6364136223846793005)

(defn rand-seed [seed u64]
  (set rand-state (+ (* seed 6364136223846793005) 1442695040888963407)))

(defn rand-u32 [] u32
  (let [s rand-state]
    (set rand-state (+ (* s 6364136223846793005) 1442695040888963407))
    ;; The rotate is masked to 5 bits: a 32-bit shift by 32 is poison in LLVM,
    ;; and r = 0 is the case that would ask for it.
    (let [x (u32 (>> (bit-xor (>> s 18) s) 27))
          r (u32 (>> s 59))]
      (bit-or (>> x r) (<< x (bit-and (- 32 r) 31))))))

;; In [0, 1). The divisor is 2^32 exactly, so the result never reaches 1.0.
(defn rand-f32 [] f32
  (/ (f32 (rand-u32)) 4294967296.0))

;; ── Slice algorithms, all in place ────────────────────────────────────
;;
;; One family per element type, because there are no generics: each of these
;; is a *copy* per element type, and the set below is i32 (what indices, ids
;; and tile values are), f32 (what positions, velocities and weights are) and
;; [u8] (what a field coming out of `split` is).
;;
;; A slice is ptr+len and non-owning, so these mutate the storage they were
;; handed: sorting (slice grid 4 9) sorts those five elements of grid and
;; leaves the rest alone. That was originally forced — there was no allocator
;; to return a new sequence from — and it stays the right shape now that there
;; is one, because sorting a thing you already own should not allocate. The
;; allocating tier is further down, and a caller sorts a Vec by sorting
;; (as-slice v).
;;
;; **map, filter, reduce and a sort taking a comparator are here now**, in a
;; section of their own after the f32 family. They were blocked on *function
;; values* and not on generics, which is why they arrived without generics:
;; a (Fn [T ...] R) is an ordinary parameter type. What they are still one
;; copy per element type for *is* generics — sum-i32 and sum-f32 are the same
;; shape and the same argument — so the set is the same i32 and f32 the rest of
;; this family covers.

(defn swap-i32! [s [i32]  i i32  j i32]
  (let [t (at s i)]
    (set (at s i) (at s j))
    (set (at s j) t)))

(defn reverse-i32! [s [i32]]
  (let [i 0
        j (- (len s) 1)]
    (while (< i j)
      (swap-i32! s i j)
      (set i (+ i 1))
      (set j (- j 1)))))

;; Insertion sort: in place, no recursion, no auxiliary array and no
;; comparison function — quicksort would want a stack and mergesort a buffer,
;; and neither exists. Ascending, and stable, though with no payload type to
;; carry that is not yet observable.
(defn sort-i32! [s [i32]]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        ;; `and` short-circuits, which is load-bearing: at j = 0 the left test
        ;; fails and (at s -1) is never evaluated, so this does not trap.
        (while (and (> j 0) (> (at s (- j 1)) (at s j)))
          (swap-i32! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

;; The first index holding x. None rather than -1, because Option is what the
;; language has and a sentinel index is the bug this avoids.
(defn index-of-i32 [s [i32]  x i32] (Option i32)
  (dotimes [i (len s)]
    (when (= (at s i) x)
      (return (Some i))))
  None)

;; None for an empty slice: there is no least i32 that is also an honest
;; answer, and returning one would be a value the caller cannot tell from a
;; real element.
(defn min-i32 [s [i32]] (Option i32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (min m (at s i))))
      (Some m))))

(defn max-i32 [s [i32]] (Option i32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (max m (at s i))))
      (Some m))))

;; Accumulates in i64 and each element is widened explicitly — there is no
;; implicit widening anywhere in the language, and summing a screenful of i32
;; into an i32 is how a total silently wraps.
(defn sum-i32 [s [i32]] i64
  (let [t (i64 0)]
    (dotimes [i (len s)]
      (set t (+ t (i64 (at s i)))))
    t))

;; ── The same family over f32 ──────────────────────────────────────────
;;
;; sort-i32! was the only sort in the language, which is what NEXT.md's second
;; tier means by "a sort that is not integers-only". This is the second, and it
;; is a copy and not an abstraction — see the note above on why.
;;
;; One caveat that has no counterpart in the i32 family, because it cannot
;; arise there: **a NaN in the input makes the order undefined.** Every
;; comparison against a NaN is false, so the insertion loop never moves one and
;; never moves anything past one; what comes out is sorted within each run
;; between NaNs and not sorted across them. That is what C's qsort with a naive
;; comparator does too. The fix is not to have NaNs in the array — which is
;; also the only fix, since there is no ordering of the reals that a NaN sits
;; anywhere in.

(defn swap-f32! [s [f32]  i i32  j i32]
  (let [t (at s i)]
    (set (at s i) (at s j))
    (set (at s j) t)))

(defn reverse-f32! [s [f32]]
  (let [i 0
        j (- (len s) 1)]
    (while (< i j)
      (swap-f32! s i j)
      (set i (+ i 1))
      (set j (- j 1)))))

(defn sort-f32! [s [f32]]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        (while (and (> j 0) (> (at s (- j 1)) (at s j)))
          (swap-f32! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

;; None for an empty slice, exactly as min-i32 does. A NaN in the input is not
;; special-cased and propagates the same way it does through the builtins: the
;; comparison fails, so the running value simply does not change.
(defn min-f32 [s [f32]] (Option f32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (min m (at s i))))
      (Some m))))

(defn max-f32 [s [f32]] (Option f32)
  (if (= (len s) 0)
    None
    (let [m (at s 0)]
      (dotimes [i (len s)]
        (set m (max m (at s i))))
      (Some m))))

;; Accumulates in f64 and widens each element explicitly, which is sum-i32's
;; argument in its floating form and a stronger one: summing a screenful of f32
;; in f32 does not wrap, it *absorbs* — once the running total is large enough,
;; adding a small element rounds to no change at all, and the answer is silently
;; short rather than obviously wrong. An f64 accumulator has 29 more bits of
;; mantissa and pushes that failure out of reach of any array a game holds.
(defn sum-f32 [s [f32]] f64
  (let [t 0.0]
    (dotimes [i (len s)]
      (set t (+ t (f64 (at s i)))))
    t))

;; ── The ones that take a function ─────────────────────────────────────
;;
;; map, filter, reduce and a comparator sort, which were the four the previous
;; tier could not write. The blocker was function values and not generics, and
;; the difference shows in what arrived and what did not: these take a
;; (Fn [T ...] R) as an ordinary parameter and needed nothing else, and they
;; are still one copy per element type because *that* is the generics half.
;;
;; Two rules, both inherited rather than invented here:
;;
;; 1. **The in-place ones stay in place.** map! writes back into the slice it
;;    was handed, for the same reason sort-i32! does — a slice is non-owning,
;;    and transforming a thing you already own should not allocate. A map that
;;    produces a *different* element type is not here: it would be one copy per
;;    ordered pair of types, which is the point at which a per-type family
;;    stops being honest.
;; 2. **filter allocates and the caller frees**, like everything in the
;;    building tier: (free v), or let a (free-all a) take the region.
;;
;; The function is passed by name — this is a Lisp-1, so a bare defn name is
;; the function — or written inline as an (fn [x] ...), whose parameter types
;; come from the parameter it is being passed to. It may not capture: an fn is
;; lifted into a function of its own and sees its parameters and the globals
;; and nothing else.

(defn map-i32! [s [i32]  f (Fn [i32] i32)]
  (dotimes [i (len s)]
    (set (at s i) (f (at s i)))))

(defn map-f32! [s [f32]  f (Fn [f32] f32)]
  (dotimes [i (len s)]
    (set (at s i) (f (at s i)))))

;; The general fold, of which sum-i32 is the special case with the + written
;; in. The accumulator comes first in the step, which is the order that reads
;; as (f acc x) and the order Odin's slice.reduce uses.
(defn reduce-i32 [s [i32]  init i32  f (Fn [i32 i32] i32)] i32
  (let [acc init]
    (dotimes [i (len s)]
      (set acc (f acc (at s i))))
    acc))

(defn reduce-f32 [s [f32]  init f32  f (Fn [f32 f32] f32)] f32
  (let [acc init]
    (dotimes [i (len s)]
      (set acc (f acc (at s i))))
    acc))

;; A new Vec holding the elements the predicate kept, in the order they were
;; in. Owned by the caller.
(defn filter-i32 [s [i32]  keep? (Fn [i32] bool)] (Vec i32)
  (let [v (vec-new i32)]
    (dotimes [i (len s)]
      (when (keep? (at s i))
        (push v (at s i))))
    v))

(defn filter-f32 [s [f32]  keep? (Fn [f32] bool)] (Vec f32)
  (let [v (vec-new f32)]
    (dotimes [i (len s)]
      (when (keep? (at s i))
        (push v (at s i))))
    v))

;; The same insertion sort sort-i32! is, with the one comparison it had written
;; in replaced by the one it is told. before? answers "does a come before b",
;; so passing (fn [a b] (< a b)) is ascending and reversing it is descending —
;; and a caller wanting a key rather than an order writes the comparison.
;;
;; It is stable exactly as sort-i32! is: the loop stops the moment before? says
;; no, so equal elements never swap past each other. A before? that is not a
;; strict weak ordering — one answering true for both (a b) and (b a) — is the
;; caller's mistake and shows up as an order, not as a loop: the inner while is
;; bounded by j reaching 0 whatever the comparison says.
(defn sort-i32-by! [s [i32]  before? (Fn [i32 i32] bool)]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        ;; `and` short-circuits, so (at s -1) is never evaluated at j = 0.
        (while (and (> j 0) (before? (at s j) (at s (- j 1))))
          (swap-i32! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

(defn sort-f32-by! [s [f32]  before? (Fn [f32 f32] bool)]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        (while (and (> j 0) (before? (at s j) (at s (- j 1))))
          (swap-f32! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

;; ── Bytes ─────────────────────────────────────────────────────────────
;;
;; Over [u8] and not over string, so (bytes 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.

(defn bytes=? [a [u8]  b [u8]] bool
  (if (!= (len a) (len b))
    false
    (do
      (dotimes [i (len a)]
        (when (!= (at a i) (at b i))
          (return false)))
      true)))

;; The length test comes first and `and` short-circuits, so the slice is only
;; built once it is known to be in bounds — otherwise a prefix longer than the
;; string would trap rather than answer false.
(defn starts-with? [s [u8]  p [u8]] bool
  (and (<= (len p) (len s))
       (bytes=? (slice s 0 (len p)) p)))

(defn ends-with? [s [u8]  p [u8]] bool
  (and (<= (len p) (len s))
       (bytes=? (slice s (- (len s) (len p)) (len s)) p)))

(defn index-of-byte [s [u8]  b u8] (Option i32)
  (dotimes [i (len s)]
    (when (= (at s i) b)
      (return (Some i))))
  None)

;; The whole slice is an integer, or it is None. bytes->i64 is strtoll, which
;; answers 0 for "" and for "abc" and stops at the first junk byte in "12x" —
;; three wrong answers a caller cannot tell from a real 12. This is also the
;; one that has to be Flan rather than the primitive: strtoll is locale- and
;; libc-dependent, and a parser in the language gives the same answer on
;; wasm32 as on native for the same reason rand-f32 does.
;; Overflow wraps, as all arithmetic here does; it is not reported.
(defn parse-i64 [s [u8]] (Option i64)
  (let [i 0
        n (i64 0)
        neg false]
    (when (= (len s) 0)
      (return None))
    (when (or (= (at s 0) \-) (= (at s 0) \+))
      (set neg (= (at s 0) \-))
      (set i 1))
    (when (= i (len s))
      (return None))                     ; a lone sign is not a number
    (while (< i (len s))
      (let [b (at s i)]
        (when (or (< b \0) (> b \9))
          (return None))
        (set n (+ (* n 10) (i64 (- b \0)))))
      (set i (+ i 1)))
    (if neg (Some (- 0 n)) (Some n))))

;; ── Numbers ───────────────────────────────────────────────────────────
;;
;; Only the ones that encode a decision. abs is (max x (- 0 x)); a wrapper over
;; that is a function emitted into every program to save a caller nothing. The
;; one honest caveat on that abs: at the least representable integer it
;; answers itself, because the negation wraps. That is what every two's-complement abs does, a
;; function here would do it too, and the only fix is not to hand it that
;; value — so it is written down rather than wrapped.
;;
;; The float abs is the same one-liner, (max x (- 0.0 x)), and it is not
;; wrapped for the same reason — but the caveat above does not carry over, so
;; it is not inherited by silence. f32 negation is exact at every value, there
;; is no least representable float that negates to itself, and the two edge
;; inputs both come out right: -0.0 answers +0.0 (the max picks the subtracted
;; side, since neither zero is greater than the other), and a NaN answers a
;; NaN (every comparison fails, so the same max picks the subtracted side,
;; which is still a NaN). There is nothing left for a function to fix.

;; clamp is a macro and not a function, and the reason is the objection above
;; turned around rather than dropped. min and max are builtins that work at
;; every numeric type; a clamp *function* cannot, because there are no
;; generics, so it would be one copy per type — a clamp-i32, a clamp-f32, a
;; clamp-i64 — each emitted into every program to save a caller eleven
;; characters. A macro is type-agnostic for free and emits nothing at all: what
;; the program contains after expansion is the (min hi (max lo x)) the caller
;; would have written.
;;
;; Each of x, lo and hi appears exactly once in the expansion, so nothing here
;; is evaluated twice and an argument with a side effect behaves as it reads.
;;
;; lo above hi is not checked, and the answer there is hi — the outer min wins.
;; That is the same rule Odin's clamp follows and there is nowhere better to
;; put a complaint: a macro has no error facility (see `unless` at the foot of
;; this file), so a diagnostic would have to be a run-time one, in the one
;; construct whose whole point is that it costs nothing at run time.
(defmacro clamp [args]
  (if (!= (len args) 3)
    `(clamp-takes-a-value-a-low-and-a-high)
    `(min ~(at args 2) (max ~(at args 1) ~(at args 0)))))

;; Zero for zero, and zero for NaN — neither is positive nor negative, so
;; neither comparison fires. A caller that needs to know which it got should
;; be testing for NaN, not reading a sign.
(defn sign-f32 [x f32] f32
  (cond
    (> x 0.0) 1.0
    (< x 0.0) -1.0
    :else     0.0))

;; Written as the weighted sum and not as a + t*(b - a): the second form does
;; not return b exactly at t = 1.0 once rounding is involved, and a position
;; that does not arrive is the bug an interpolation gets reported for.
(defn lerp [a f32  b f32  t f32] f32
  (+ (* (- 1.0 t) a) (* t b)))

;; ── More of the RNG ───────────────────────────────────────────────────
;;
;; Both draw exactly one rand-u32, so the sequence a program consumes is the
;; same one; neither touches the generator.

;; [lo, hi). An empty or reversed range answers lo — a defined value rather
;; than a remainder by zero, which is immediate undefined behaviour and not a
;; wrong number. The span must fit in i32, since hi - lo is computed there.
;; One draw, and therefore modulo bias: the low (2^32 % span) values of the
;; range come up very slightly more often. Rejection sampling would remove it
;; and would consume an unpredictable number of draws, which is the one thing
;; this generator exists not to do.
(defn rand-i32-range [lo i32  hi i32] i32
  (if (<= hi lo)
    lo
    (+ lo (i32 (% (rand-u32) (u32 (- hi lo)))))))

;; [lo, hi), because rand-f32 never reaches 1.0.
(defn rand-f32-range [lo f32  hi f32] f32
  (+ lo (* (rand-f32) (- hi lo))))

;; ── Rounding, and the one thing that is not Flan ──────────────────────
;;
;; All three answer an f32 and take the f32 path, because that is what a
;; position, a tile coordinate and a velocity are here. f64 versions wait for
;; a program that wants them, for the same reason the f32 slice algorithms do.
;;
;; The cast to i32 truncates toward zero, which is the only rounding mode the
;; language has, so each of these is that cast plus the correction the mode
;; does not make. Three inputs would make the cast itself undefined and each
;; is named before it happens: NaN (which fails every comparison, so it is
;; tested for by (not (= x x)) and nothing else), and the two infinities,
;; which are caught by the magnitude test. Above 2^23 an f32 has no fractional
;; bits left at all, so returning x there is not an approximation — it is the
;; answer — and it doubles as the guard that keeps the cast inside i32.

;; Zero is returned as itself rather than through the cast, which would turn
;; -0.0 into +0.0. That is one line for a value most callers never look at,
;; and it is here because floorf is specified to return it: a sign of zero is
;; how a caller recovers which side a position approached from once the
;; magnitude has already been rounded away.
(defn floor-f32 [x f32] f32
  (if (or (not (= x x))
          (>= x 8388608.0)
          (<= x -8388608.0)
          (= x 0.0))
    x
    (let [t (f32 (i32 x))]
      (if (> t x) (- t 1.0) t))))

;; One deviation from C's ceilf, written down rather than branched around:
;; between -1.0 and 0.0 this answers +0.0 where IEEE asks for -0.0, because
;; the outer (- 0.0 …) is a subtraction and not a negation. Nothing here reads
;; the sign of a zero; a caller that does should test the input instead.
(defn ceil-f32 [x f32] f32
  (- 0.0 (floor-f32 (- 0.0 x))))

;; Half away from zero, which is C's round and not the even-tie rule: -2.5
;; goes to -3. Written as floor of the *magnitude* and mirrored, because
;; (floor-f32 (+ x 0.5)) is wrong twice over — it is half-*up* rather than
;; half-away for negatives, and at the largest f32 below 0.5 the addition
;; itself rounds to 1.0 and answers 1 for a number under a half.
(defn round-f32 [x f32] f32
  (let [m (if (< x 0.0) (- 0.0 x) x)
        f (floor-f32 m)
        r (if (>= (- m f) 0.5) (+ f 1.0) f)]
    (if (< x 0.0) (- 0.0 r) r)))

;; sqrt is the one function in this file that is not Flan, and it is a
;; `declare` rather than a body for a reason that is not laziness. Every other
;; number here is reachable from the four operations and a cast; a square root
;; is not. Newton's method needs a starting guess, a good one comes from
;; reinterpreting the exponent bits, and the language has no bit-cast between
;; f32 and u32 — only value-preserving casts. Without it the iteration needs a
;; scaling loop to normalise, converges slowly from a poor guess, and produces
;; a result that is *close*, which is exactly what a standard library must not
;; hand back. IEEE-754 makes sqrt correctly rounded, so libm's answer is the
;; same bit pattern on native and on wasm32 — the byte-identical property that
;; keeps rand-u32 in Flan is, for this one, an argument for going out to C.
;;
;; The cost is one `declare` line in every module, which LLVM drops where it
;; is unused, and one -lm on every link, which build.ml now passes. That flag
;; is not optional and not obvious: at -O2 LLVM folds most sqrtf calls into
;; the hardware instruction and nothing is left to resolve, so this appears to
;; link without it and then fails at -O0, where the call survives.
;;
;; The better fix belongs to the compiler and not here: llvm.sqrt.f32 as a
;; builtin in check.ml and emit.ml is one instruction with no symbol at all.
(declare sqrt-f32 [x f32] f32 "sqrtf")

;; sin and cos go out to libm too, and the argument is *not* the one above —
;; it is weaker, and which way it is weaker is the thing to know before
;; calling them. IEEE-754 requires sqrt to be correctly rounded, which is why
;; sqrtf's answer is the same bit pattern wherever it runs. It requires
;; nothing of the kind for sinf and cosf: each implementation is free to be a
;; fraction of an ulp off in its own direction, and glibc, musl and wasi-libc
;; do differ. So these two are the one place in this file where native and
;; wasm32 may not agree bit for bit, and a program whose output is hashed
;; across targets — the sand grid of plan.org's "RNG is ours", which is why
;; rand-u32 above is written in Flan and not called out of libc — must not
;; route that hash through a sine.
;;
;; They are here anyway, because the alternative on offer today is worse: a
;; caller that wants an angle writes the same two `declare` lines at the top
;; of its own file (examples/core-input-gestures-testbed.flan did, before
;; this), which is the identical libm call with the identical caveat and
;; nobody's name on it. One copy with the caveat written down beats a copy per
;; file with none.
;;
;; The fix, if a program ever does need trig that agrees across targets, is a
;; body rather than a declare: Cody-Waite reduction onto [-pi/4, pi/4] and a
;; minimax polynomial, which is reachable from the four operations and
;; floor-f32 and would therefore be exactly as reproducible as rand-u32. That
;; is a numerics job with its own accuracy budget, and it waits for a program
;; that needs it.
(declare sin-f32 [x f32] f32 "sinf")
(declare cos-f32 [x f32] f32 "cosf")

;; atan2 and pow inherit the paragraph above in full, and not the sqrt one.
;; IEEE-754 requires nothing of atan2f or powf either, so these are the third
;; and fourth places in this file where native and wasm32 may disagree in the
;; last bit, and the sand-grid rule stands unchanged: a hash compared across
;; targets must not be routed through any of the four.
;;
;; They are here for the reason the trig pair is. Without them a program that
;; wants a heading or a falloff curve writes the identical two declare lines at
;; the top of its own file, which is the same libm call with the same caveat
;; and nobody's name on it.
;;
;; atan2's y comes first, as it does in C, and the order is the answer rather
;; than a convention: knowing the quadrant of (y, x) is the whole of what it
;; has over (atan (/ y x)), and it is recovered from the two signs. It is
;; defined at x = 0, where the division is not.
;;
;; One caveat of pow-f32's own, because it is the one that gets reported as a
;; bug: it is not exact at integer exponents. powf goes through a logarithm,
;; so (pow-f32 10.0 2.0) is 100.0 or the float next to it depending on the
;; libm, and an index computed by casting that to i32 is off by one on the
;; wrong side. A small integer power is a multiplication, and should be
;; written as one.
(declare atan2-f32 [y f32  x f32] f32 "atan2f")
(declare pow-f32 [x f32  y f32] f32 "powf")

;; ── Byte classes ──────────────────────────────────────────────────────
;;
;; ASCII only, and deliberately: a byte is a byte here, there is no code point
;; type, and a UTF-8 continuation byte is not a digit under any locale. Both
;; exist because something below needs them — parse-f64 the first, trim the
;; second — and both are what a caller writing a tokenizer reaches for anyway.

(defn digit? [b u8] bool
  (and (>= b \0) (<= b \9)))

(defn space? [b u8] bool
  (or (= b \space) (= b \tab) (= b \newline) (= b \return)))

;; ── More of the bytes family ──────────────────────────────────────────

;; Substring search, first occurrence. The length test is first and returns
;; before the loop, so a needle longer than the haystack answers None rather
;; than building a slice that runs off the end. An empty needle is Some 0,
;; which is the answer that makes (index-of-bytes s p) agree with
;; (starts-with? s p) on every p.
;;
;; Naive, O(n·m), and that is the deliberate choice: Boyer–Moore wants a skip
;; table, which is an array sized by the needle, which is an allocation.
(defn index-of-bytes [s [u8]  p [u8]] (Option i32)
  (when (> (len p) (len s))
    (return None))
  (let [last (- (len s) (len p))
        i 0]
    (while (<= i last)
      (when (bytes=? (slice s i (+ i (len p))) p)
        (return (Some i)))
      (set i (+ i 1))))
  None)

;; Returns a slice *of the input*, which is the whole reason trim can exist
;; without an allocator: there is no new storage, only a narrower view of the
;; caller's. It follows that the result dies with its owner, and that trimming
;; does not modify anything.
;;
;; The two loops both test (< lo hi), so an all-whitespace input walks lo up
;; to hi and stops there, and the result is the empty slice. Without that test
;; lo would pass hi and (slice s lo hi) would be a reversed range, which traps.
(defn trim [s [u8]] [u8]
  (let [lo 0
        hi (len s)]
    (while (and (< lo hi) (space? (at s lo)))
      (set lo (+ lo 1)))
    (while (and (< lo hi) (space? (at s (- hi 1))))
      (set hi (- hi 1)))
    (slice s lo hi)))

;; The grammar is Flan's and the rounding is libc's, which is a split and not
;; a dodge. parse-i64 is entirely Flan because strtoll's *answers* are wrong
;; for a caller — 0 for "", 0 for "abc", 12 for "12x" — and reproducing
;; correct-to-the-last-bit decimal-to-binary conversion is a different problem
;; from rejecting junk. So this validates the whole slice first, and only a
;; slice that is entirely a number is handed to bytes->f64; every string this
;; returns Some for is one strtod converts exactly, correctly rounded, and
;; identically everywhere, because that much IEEE-754 requires.
;;
;; The locale worry that keeps parse-i64 in Flan does apply to strtod's
;; decimal point — and is moot here because nothing in the runtime calls
;; setlocale, so the program stays in the C locale for its whole life. If that
;; ever stops being true this function is the thing that breaks.
;;
;; Accepts [+-]? digits [. digits] [eE [+-] digits], needing at least one
;; mantissa digit; refuses "", ".", "1e", "nan", "0x10", " 1" and "1 ". The
;; 511 cap is flan_bytes_to_f64's buffer: past it the shim truncates, and a
;; validator that said yes to 600 digits would be approving a different
;; number than the one strtod reads.
(defn parse-f64 [s [u8]] (Option f64)
  (let [i 0
        digits 0]
    (when (or (= (len s) 0) (> (len s) 511))
      (return None))
    (when (or (= (at s 0) \-) (= (at s 0) \+))
      (set i 1))
    (while (and (< i (len s)) (digit? (at s i)))
      (set i (+ i 1))
      (set digits (+ digits 1)))
    (when (and (< i (len s)) (= (at s i) \.))
      (set i (+ i 1))
      (while (and (< i (len s)) (digit? (at s i)))
        (set i (+ i 1))
        (set digits (+ digits 1))))
    (when (= digits 0)
      (return None))                     ; "." and "+" and "e5" are not numbers
    (when (and (< i (len s)) (or (= (at s i) \e) (= (at s i) \E)))
      (set i (+ i 1))
      (when (and (< i (len s)) (or (= (at s i) \-) (= (at s i) \+)))
        (set i (+ i 1)))
      (let [e 0]
        (while (and (< i (len s)) (digit? (at s i)))
          (set i (+ i 1))
          (set e (+ e 1)))
        (when (= e 0)
          (return None))))               ; a lone exponent marker
    ;; Trailing junk is the case strtod is silent about, so the position has
    ;; to land exactly on the end.
    (if (= i (len s)) (Some (bytes->f64 s)) None)))

;; ── UTF-8 ─────────────────────────────────────────────────────────────
;;
;; Ported from Odin's core/unicode/utf8/utf8.odin, which is the one corner of
;; a string library that is allocation-free by construction: decoding is
;; classification, and every answer it gives is a number. Everything else in
;; Odin's core/strings takes `allocator := context.allocator`, which is why
;; this corner came first and the rest waited; most of that rest is ported now
;; and lives in the building section below. core/fmt is still absent, and the
;; reason it stays absent is not allocation — see the refusal list at the foot
;; of this file.
;;
;; Odin's 256-entry accept_sizes table becomes a cond over the lead byte here.
;; The table is the cache-friendly form and the cond is the one you can check
;; by reading, and nothing in a game decodes UTF-8 in a hot loop — DrawText
;; hands the bytes straight to raylib.
;;
;; The four rules that table encodes, and which a hand-written decoder gets
;; wrong one at a time:
;;
;;   0x80..0xc1   never a lead byte. 0x80..0xbf are continuation bytes, and
;;                0xc0 and 0xc1 could only ever begin an *overlong* two-byte
;;                spelling of an ASCII character — the encoding that lets
;;                "\xc0\xaf" smuggle a "/" past a check for one.
;;   0xe0         second byte 0xa0..0xbf and not 0x80..0xbf; the low half is
;;                the overlong three-byte range.
;;   0xed         second byte 0x80..0x9f. The high half is U+D800..U+DFFF,
;;                the UTF-16 surrogates, which are not scalar values.
;;   0xf0, 0xf4   second byte 0x90..0xbf and 0x80..0x8f: overlong below,
;;                and past U+10FFFF above. 0xf5..0xff lead nothing at all.
;;
;; A rune is an i32 and not a type of its own. That is Odin's answer too —
;; its `rune` is a four-byte integer distinguished only by a flag on the
;; basic-type row (src/types.cpp, the Basic_rune entry) — so nothing in the
;; checker has to learn a new type for any of this.

;; One deliberate divergence from Odin, and it is the parse-i64 argument over
;; again. Odin's decode_rune answers RUNE_ERROR — U+FFFD — for malformed
;; bytes, and U+FFFD is a perfectly real code point that a well-formed string
;; may contain, so a caller cannot tell a decoded replacement character from a
;; failure to decode. This carries `ok` instead, and leaves `code` 0 when it
;; is false.
;;
;; `width` is 1 on a malformed byte and 0 only for an empty input. That is
;; Odin's rule and it is load-bearing rather than cosmetic: every loop below
;; advances by `width`, so a 0 there on a bad byte is an infinite loop, not a
;; wrong number.
(defstruct Rune [code i32  width i32  ok bool])

(defn rune-start? [b u8] bool
  (!= (bit-and b 0xc0) 0x80))

(defn decode-rune [s [u8]] Rune
  (when (= (len s) 0)
    (return (Rune {.code 0 .width 0 .ok false})))
  (let [b0 (at s 0)]
    (when (< b0 0x80)
      (return (Rune {.code (i32 b0) .width 1 .ok true})))
    ;; size 0 means "this byte cannot lead"; lo/hi are the *second* byte's
    ;; accepted range, which is the only place the overlong and surrogate
    ;; rules live. Bytes three and four are always 0x80..0xbf.
    (let [size 0
          lo (u8 0x80)
          hi (u8 0xbf)]
      (cond
        (< b0 0xc2)  (set size 0)
        (<= b0 0xdf) (set size 2)
        (= b0 0xe0)  (do (set size 3) (set lo (u8 0xa0)))
        (<= b0 0xec) (set size 3)
        (= b0 0xed)  (do (set size 3) (set hi (u8 0x9f)))
        (<= b0 0xef) (set size 3)
        (= b0 0xf0)  (do (set size 4) (set lo (u8 0x90)))
        (<= b0 0xf3) (set size 4)
        (= b0 0xf4)  (do (set size 4) (set hi (u8 0x8f)))
        :else        (set size 0))
      (when (= size 0)
        (return (Rune {.code 0 .width 1 .ok false})))
      ;; A sequence cut off by the end of the slice. Width 1, so a caller
      ;; scanning a buffer boundary makes progress instead of stalling.
      (when (> size (len s))
        (return (Rune {.code 0 .width 1 .ok false})))
      (let [b1 (at s 1)]
        (when (or (< b1 lo) (> b1 hi))
          (return (Rune {.code 0 .width 1 .ok false})))
        (when (= size 2)
          (return (Rune {.code (bit-or (<< (i32 (bit-and b0 0x1f)) 6)
                                       (i32 (bit-and b1 0x3f)))
                         .width 2 .ok true})))
        (let [b2 (at s 2)]
          (when (or (< b2 0x80) (> b2 0xbf))
            (return (Rune {.code 0 .width 1 .ok false})))
          (when (= size 3)
            (return (Rune {.code (bit-or (bit-or (<< (i32 (bit-and b0 0x0f)) 12)
                                                 (<< (i32 (bit-and b1 0x3f)) 6))
                                         (i32 (bit-and b2 0x3f)))
                           .width 3 .ok true})))
          (let [b3 (at s 3)]
            (when (or (< b3 0x80) (> b3 0xbf))
              (return (Rune {.code 0 .width 1 .ok false})))
            (Rune {.code (bit-or (bit-or (<< (i32 (bit-and b0 0x07)) 18)
                                         (bit-or (<< (i32 (bit-and b1 0x3f)) 12)
                                                 (<< (i32 (bit-and b2 0x3f)) 6)))
                                 (i32 (bit-and b3 0x3f)))
                   .width 4 .ok true})))))))

;; Decode at a byte offset. None when the offset is not on a rune boundary or
;; the bytes there are malformed, which is stricter than Odin's rune_at — that
;; one hands back RUNE_ERROR and the caller carries on with a wrong character.
(defn rune-at [s [u8]  i i32] (Option i32)
  (if (or (< i 0) (>= i (len s)))
    None
    (let [r (decode-rune (slice s i (len s)))]
      (if (.ok r) (Some (.code r)) None))))

;; Counted through decode-rune rather than through a second walk of its own.
;; Odin keeps a separate rune_count_in_bytes that re-implements the size
;; table; two copies of that classification is two places for the surrogate
;; rule to be right in only one of them.
;;
;; A malformed byte counts as one, which is what a replacement-character
;; renderer would draw, so this agrees with what the screen shows.
(defn rune-count [s [u8]] i32
  (let [i 0
        n 0]
    (while (< i (len s))
      (let [r (decode-rune (slice s i (len s)))]
        (set i (+ i (.width r)))
        (set n (+ n 1))))
    n))

(defn valid-utf8? [s [u8]] bool
  (let [i 0]
    (while (< i (len s))
      (let [r (decode-rune (slice s i (len s)))]
        (when (not (.ok r))
          (return false))
        (set i (+ i (.width r)))))
    true))

;; How many bytes this code point encodes to, or None if it is not a scalar
;; value. Odin's rune_size answers -1 for the refusals; a sentinel index is
;; exactly what index-of-i32 avoids above, so this is an Option like the rest
;; of the file.
(defn rune-size [code i32] (Option i32)
  (cond
    (< code 0)                              None
    (<= code 0x7f)                          (Some 1)
    (<= code 0x7ff)                         (Some 2)
    (and (>= code 0xd800) (<= code 0xdfff)) None
    (<= code 0xffff)                        (Some 3)
    (<= code 0x10ffff)                      (Some 4)
    :else                                   None))

;; Encoding is the one operation here whose result is not a slice of its
;; input, because the bytes it makes existed nowhere before. With no allocator
;; the only shape left is Odin's own allocation-free one — strings.Builder
;; built by builder_from_bytes over a caller's backing array (builder.odin,
;; builder_from_bytes: "Uses Nil Allocator - Does NOT allocate") — reduced to
;; its essential case: write into a buffer the caller owns, and say how much
;; was written.
;;
;; None rather than a partial write when the buffer is short, and None rather
;; than Odin's silent substitution of U+FFFD for an invalid rune. Odin's
;; encode_rune rewrites a surrogate or an out-of-range value to the
;; replacement character and reports success; the caller then finds three
;; bytes of U+FFFD in its buffer and no indication that it asked for something
;; else. Nothing is written at all when this answers None.
(defn encode-rune! [dst [u8]  code i32] (Option i32)
  (match (rune-size code)
    None None
    (Some w)
    (if (> w (len dst))
      None
      (do
        (cond
          (= w 1)
          (set (at dst 0) (u8 code))
          (= w 2)
          (do (set (at dst 0) (u8 (bit-or 0xc0 (>> code 6))))
              (set (at dst 1) (u8 (bit-or 0x80 (bit-and code 0x3f)))))
          (= w 3)
          (do (set (at dst 0) (u8 (bit-or 0xe0 (>> code 12))))
              (set (at dst 1) (u8 (bit-or 0x80 (bit-and (>> code 6) 0x3f))))
              (set (at dst 2) (u8 (bit-or 0x80 (bit-and code 0x3f)))))
          :else
          (do (set (at dst 0) (u8 (bit-or 0xf0 (>> code 18))))
              (set (at dst 1) (u8 (bit-or 0x80 (bit-and (>> code 12) 0x3f))))
              (set (at dst 2) (u8 (bit-or 0x80 (bit-and (>> code 6) 0x3f))))
              (set (at dst 3) (u8 (bit-or 0x80 (bit-and code 0x3f))))))
        (Some w)))))

;; ── Splitting ─────────────────────────────────────────────────────────
;;
;; The iterator, which owns nothing. `split` returning a sequence of fields has
;; to allocate that sequence, and it does — it is in the building section below
;; — but this stays the right call whenever you do not want to own the result:
;; it is Odin's split_by_byte_iterator (strings.odin), a cursor holding the
;; rest of the input and handing back one field at a time. Every field is a
;; slice *of the caller's bytes*; nothing is copied, nothing is owned, and
;; there is no free to remember. `split` is built on exactly this.
;;
;; One divergence, and it is a wart of Odin's rather than a decision. Odin's
;; iterator stops on an empty final field, so "a,b," iterates a and b and the
;; trailing empty field is lost — while Odin's own allocating strings.split
;; returns ["a", "b", ""] for the same input. The two disagree. This follows
;; split: n separators always yield n+1 fields, an empty input yields one
;; empty field, and `rest` is exhausted only after the last one is taken. That
;; is the rule you can state without exceptions, and the one a caller counting
;; comma-separated columns needs.
(defstruct Split [rest [u8]  sep u8  more bool])

(defn split-on-byte [s [u8]  sep u8] Split
  (Split {.rest s .sep sep .more true}))

(defn split-next! [it (Ptr Split)] (Option [u8])
  (when (not (.more it))
    (return None))
  (match (index-of-byte (.rest it) (.sep it))
    (Some i)
    (let [field (slice (.rest it) 0 i)]
      (set (.rest it) (slice (.rest it) (+ i 1) (len (.rest it))))
      (Some field))
    None
    (let [field (.rest it)]
      (set (.more it) false)
      (set (.rest it) (slice (.rest it) (len (.rest it)) (len (.rest it))))
      (Some field))))

;; ── ASCII case ────────────────────────────────────────────────────────
;;
;; Byte in, byte out, and *not* a function over a slice. Odin's to_lower and
;; to_upper both allocate a new string (core/strings/conversion.odin) and so do
;; the ones in the building section below; these are the forms that allocate
;; nothing, and they stay the right call when a copy is not wanted — folding a
;; 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
;; "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):
;;
;;   -O0   the store is emitted against the constant and the program takes
;;         SIGSEGV.
;;   -O2   LLVM deletes the store as undefined behaviour and the program
;;         carries on and prints "Hi".
;;
;; 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.
;;
;; 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 (ß
;; upcases to SS), and it is locale-dependent (Turkish dotless ı). A byte
;; table that pretended otherwise would be wrong in the quiet way.
(defn lower-ascii [b u8] u8
  (if (and (>= b \A) (<= b \Z)) (+ b 32) b))

(defn upper-ascii [b u8] u8
  (if (and (>= b \a) (<= b \z)) (- b 32) b))

;; Case-insensitive comparison as a fold over both inputs, which is the useful
;; half of to_lower and needs no storage at all: comparing two lowered copies
;; is what a caller wanted, and this is that answer without either copy.
(defn bytes-ci=? [a [u8]  b [u8]] bool
  (if (!= (len a) (len b))
    false
    (do
      (dotimes [i (len a)]
        (when (!= (lower-ascii (at a i)) (lower-ascii (at b i)))
          (return false)))
      true)))

;; ── Ordering byte slices, and sorting them ────────────────────────────
;;
;; The third element type the slice family covers, and the one a caller of
;; `split` actually has: a [[u8]] of fields, wanting to come out in order.
;;
;; The order is bytewise-lexicographic — memcmp's, and the one every sane
;; sorted format uses. It is explicitly *not* alphabetical and not a collation:
;; "Zebra" sorts before "apple" because 'Z' is 90 and 'a' is 97, and a
;; non-ASCII byte sorts by its UTF-8 encoding, which for code points happens to
;; agree with code-point order and for anything a human would call alphabetical
;; does not. A locale-aware comparison is not a byte operation at all, for the
;; same reasons the ASCII-case note above gives.
;;
;; The comparison is over u8 and therefore unsigned, which is the bug a version
;; written over a signed byte type has: 0x80 would compare *below* 0x00 and
;; every multi-byte character would sort before every ASCII one.
;;
;; A prefix sorts before what extends it — "ab" before "abc" — which falls out
;; of running to the shorter length and then comparing lengths, and is the case
;; a loop written to (len a) alone reads off the end for.
(defn bytes<? [a [u8]  b [u8]] bool
  (let [n (min (len a) (len b))]
    (dotimes [i n]
      (when (!= (at a i) (at b i))
        (return (< (at a i) (at b i)))))
    (< (len a) (len b))))

(defn swap-bytes! [s [[u8]]  i i32  j i32]
  (let [t (at s i)]
    (set (at s i) (at s j))
    (set (at s j) t)))

;; The same insertion sort as sort-i32!, over the same in-place contract: the
;; *slices* move, never the bytes they point at, so this sorts a [[u8]] of
;; fields borrowed from one buffer without touching the buffer. Stable, and
;; here that is observable — two equal fields are two distinct slices of
;; different parts of the input, and a caller can see which one came first.
(defn sort-bytes! [s [[u8]]]
  (let [i 1]
    (while (< i (len s))
      (let [j i]
        (while (and (> j 0) (bytes<? (at s j) (at s (- j 1))))
          (swap-bytes! s (- j 1) j)
          (set j (- j 1))))
      (set i (+ i 1)))))

;; ── 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))

;; ── A number with a precision ─────────────────────────────────────────
;;
;; The one formatting job the runtime cannot do. f64->bytes is snprintf "%g",
;; which is six significant digits and switches to exponent notation on its
;; own: a frame time of 0.0166667 is what a caller wanted two decimals of, and
;; 1.23457e+06 is what a score looks like once it passes a million. There is no
;; precision to pass it, and there cannot be — it renders into one shared
;; static buffer in the runtime, which is the same reason two of its results
;; cannot be held at once.
;;
;; This returns a Vec, so neither problem is inherited. It uses i64->bytes
;; twice and the two calls are strictly sequential — the integer part is copied
;; into the Vec before the fraction is rendered — which is the discipline the
;; shared buffer requires and the one append-i64! exists to make automatic.
;;
;; Half away from zero, the same rule round-f32 follows, applied at the last
;; digit kept. That is not bit-for-bit printf: printf rounds the *binary* value
;; to nearest-even at the decimal digit, and this rounds the decimal expansion
;; half-up, so a value sitting exactly on a half — 0.999995 at five places —
;; comes out 1.00000 here and may come out 0.99999 there. Choosing the rule the
;; rest of this file already uses beats matching a libc whose answer is not the
;; same on every target anyway.
;;
;; Precision is clamped to 0..9 rather than refused. 10^9 is the largest power
;; of ten that leaves room in the f64 product below, and a precision argument
;; is almost always a literal, so a refusal would be a run-time condition for a
;; mistake visible in the source.
;;
;; It is the `clamp` macro two hundred lines up, and this is the call that
;; proves a prelude function may call a prelude macro — which it could not
;; until macro.ml grew its bootstrap reduction. The cycle it breaks: a macro
;; module is compiled *from* the prelude, so a prelude function calling a macro
;; would have to be compiled into the very module that expands it. For that one
;; build the prelude drops every defn that reaches a macro, this one included.
;; A prelude *macro* may still not call a macro, and says so by name.
;;
;; Three inputs do not have decimal expansions and are named before the cast
;; that would be undefined on them: NaN, which fails every comparison and is
;; therefore tested with (not (= x x)) and nothing else, and the two
;; infinities, which are the values satisfying (= x (* x 2.0)) away from zero.
;; A magnitude past 9e18 has no fractional bits left at all and would not fit
;; in the i64 the integer part is carried in, so it falls back to f64->bytes —
;; which is the honest answer there rather than an approximation of one.
;;
;; -0.0 prints as "0.00": the sign test is (< x 0.0), which -0.0 fails. A
;; caller that needs the sign of a zero should not be reading it out of text.
(defn format-f64 [x f64  prec i32] (Vec u8)
  (let [b (vec-new u8)
        p (clamp prec 0 9)]
    (cond
      (not (= x x))
      (append! (addr b) (bytes "nan"))

      (and (= x (* x 2.0)) (!= x 0.0))
      (append! (addr b) (bytes (if (< x 0.0) "-inf" "inf")))

      :else
      (let [neg (< x 0.0)
            m (if neg (- 0.0 x) x)]
        (if (>= m 9.0e18)
          (append! (addr b) (f64->bytes x))
          (let [scale (i64 1)]
            (dotimes [i p]
              (set scale (* scale 10)))
            ;; The split is exact: (i64 m) truncates toward zero and m is
            ;; non-negative here, and the subtraction of an integer from the
            ;; float it came from is exact at every magnitude an f64 can hold.
            ;; Only the scaling below rounds, and it rounds a value already
            ;; under 1.
            (let [ip (i64 m)
                  fr (i64 (+ (* (- m (f64 ip)) (f64 scale)) 0.5))]
              ;; The carry, which is the bug this shape is otherwise written
              ;; with: 0.999995 at five places scales to exactly 100000, which
              ;; is not a fraction at all — it is the next integer, and without
              ;; this line it prints as "0.100000".
              (when (>= fr scale)
                (set fr 0)
                (set ip (+ ip 1)))
              ;; The sign goes on separately, because the integer part is a
              ;; magnitude: -0.5 at one place has an integer part of 0, and
              ;; i64->bytes of 0 has no sign to carry.
              (when neg
                (push b \-))
              (append-i64! (addr b) ip)
              (when (> p 0)
                (push b \.)
                ;; Left-padded with zeros to exactly p digits. fr is under
                ;; scale by the carry above, so it never needs more, and
                ;; without the padding 1.005 at three places prints "1.5".
                (let [d (i64->bytes fr)]
                  (dotimes [i (- p (len d))]
                    (push b \0))
                  (append! (addr b) d))))))))
    b))

;; ── Still refused, and what the reason is now ─────────────────────────
;;
;; This list used to be one sentence long — every entry needed to produce bytes
;; that did not exist in its input, and there was no allocator. That sentence
;; stopped being true when `Vec` landed, and most of the list has moved up into
;; the building section above: join, concat, split, to-lower, to-upper, repeat
;; and replace are all written now, and `string-from-bytes` turned out to be
;; the `string` builtin all along — (string (as-slice v)) is the round trip,
;; and the layouts being identical is exactly why it is free.
;;
;; What is left is refused for four *different* reasons, which is why they are
;; named separately rather than under one heading.
;;
;;   pad, center           Nothing. These are three lines each over repeat-bytes
;;                         and concat, and they are absent only because no
;;                         caller has asked. Write them when one does.
;;   format, sprintf       A format *string* — Odin's fmt.aprintf family. It
;;                         needs variadic arguments of mixed type, which is a
;;                         function-value and generics question, not an
;;                         allocation one. format-f64 above is the piece of it
;;                         that was actually wanted, and `print`/`println` are
;;                         already the structural walk over any one value.
;;   map that changes the  Generics, and only that. map!, filter, reduce and
;;   element type          sort-by! landed the day function values did — see
;;                         "The ones that take a function" above — at i32 and
;;                         f32, the two element types the rest of that family
;;                         covers. A map from [i32] to [f32] is the one shape
;;                         that did not come with them, because it is one copy
;;                         per *ordered pair* of types rather than per type,
;;                         which is where a per-type family stops being honest.
;;   map-keys, map-values  Generics — and the reason changed, which is the
;;                         point of naming them separately. It used to be the
;;                         missing Map iterator; `map-next!` is that iterator
;;                         and walking a map is expressible now. What a defn
;;                         still cannot say is (defn map-keys [m {K V}] (Vec K)):
;;                         a prelude function has to name its types, and there
;;                         is no K. The loop is three lines at the call site,
;;                         where K is known, and that is where it stays until
;;                         there are generics.
;;
;;   Builder               Not refused — declined. strings.Builder in Odin
;;                         wraps a [dynamic]u8; here the (Vec u8) *is* that and
;;                         already has push, so the struct would be a move-only
;;                         wrapper whose only method is the one it wraps. What
;;                         was missing was appending a run of bytes, and
;;                         `append!` above is that.
;; ── Files: embedding, slurp and barf ──────────────────────────────────
;;
;; One entry per file in an (embed-dir "...") — Odin's Load_Directory_File
;; (base/runtime/core.odin), which is the same two fields for the same reason:
;; a directory embed is only useful if you can find one file in it by the name
;; it had on disk.
;;
;; `data` points into the program's own .rodata, exactly as a string literal
;; does, so an embed costs nothing at run time and nothing at startup. It is
;; also read-only, and the same trap the ASCII-case note above measures applies
;; here: a store through it either segfaults at -O0 or is deleted at -O2. To
;; get a mutable copy, clone the bytes into a Vec.
(defstruct EmbedFile [name string  data [u8]])

;; A linear scan, deliberately. A directory embed is tens of entries, the scan
;; is over names already in cache-warm .rodata, and the alternative — a
;; compile-time perfect hash — is a build-time map with its own failure modes
;; that nothing here has asked for. If a program ever embeds thousands of
;; files, sort-and-bisect is the next step and it does not change this type.
;;
;; It takes a slice rather than the array (embed-dir) answers, because an array
;; length is part of its type and there are no generics: write
;; (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))
      (return (Some (.data (at files i))))))
  None)

;; The condition slurp and barf signal — spec-conditions.md, and the same shape
;; StorageExhausted has: a value struct on the signalling frame's stack, fixed
;; fields, no rendered message. `path` is the path that failed, which is a
;; string literal or a string the handler itself supplied, so naming it costs
;; no allocation either.
;;
;; One type rather than a family, because conditions have no hierarchy today
;; (spec-conditions.md §1) and a family would need one handler clause per
;; member to say "any file error". The parent link NEXT.md decides on is the
;; answer to that, and it is not built; when it is, these reasons can become
;; types without any call site changing.
(defstruct FileError [path string  op i32  reason i32])

(defconst file-op-read i32 0)
(defconst file-op-write i32 1)

(defconst file-missing i32 1)
(defconst file-denied i32 2)
(defconst file-io i32 3)
;; What `barf` signals on the web target, every time. Decision 2: writing is
;; desktop-only, and it signals rather than refusing at build time (Flan has no
;; conditional compilation, so isolating code to desktop is not expressible) or
;; silently doing nothing (which is how a save file disappears with nothing
;; said).
(defconst file-unsupported i32 4)

;; ── Form: what a macro takes and what it answers ──────────────────────
;;
;; The reader's output, mirrored on the Flan side, because a macro is a
;; function [Form] -> Form and there is no interpreter: running one means
;; compiling it and dlopening it into the compiler. So the compiler and the
;; loaded macro have to agree on the *layout* of a Form, not merely on its
;; shape. lib/form.ml is the other half of this declaration and the two are
;; edited together.
;;
;; It mirrors Form.value and not Form.t: there is no `loc` field. A macro
;; cannot invent a source location and should not carry one, so the compiler
;; stamps the *call site's* location onto every node of what a macro returns.
;; That is the structural version of "keep the source location of the call
;; site attached to what a macro produces", and it is what the queued
;; structured-error work will read.
;;
;; Case order is the tag order (BUILT.md, unions), so this list is a layout
;; contract with lib/expand.ml's marshaller and may not be reordered.
(defunion Form
  [(Sym   [s string])
   (Kw    [s string])
   (Int   [i i64])
   (Float [x f64])
   (Str   [s string])
   (Byte  [b i32])
   (List  [xs [Form]])
   (Vec   [xs [Form]])
   (Map   [xs [Form]])])

;; The list-building surface quasiquote desugars into. Three functions and no
;; more: `form-nil` starts one, `form-cons` puts a form on the front, and
;; `form-append` is what ~@ splices with. Everything else — a vector literal,
;; a length, an index — is already the language's.
;;
;; Each allocates a fresh (Vec Form) and hands back a borrow of it that
;; outlives the call. That is a leak, on purpose: a macro runs inside the
;; compiler, its result is read after it returns, and the whole expansion is
;; bounded by the size of the program being compiled. `drop` is what would
;; change this, and it does not exist.
(defn form-nil [] [Form]
  (let [v (vec-new Form)]
    (as-slice v)))

(defn form-cons [x Form  rest [Form]] [Form]
  (let [v (vec-new Form)]
    (push v x)
    (dotimes [i (len rest)]
      (push v (at rest i)))
    (as-slice v)))

(defn form-append [a [Form]  b [Form]] [Form]
  (let [v (vec-new Form)]
    (dotimes [i (len a)]
      (push v (at a i)))
    (dotimes [i (len b)]
      (push v (at b i)))
    (as-slice v)))

;; The rest of a macro's arguments, which is what a variadic body is: a macro
;; takes one parameter, the slice of the forms at its call site.
(defn form-rest [xs [Form]  from i32] [Form]
  (let [v (vec-new Form)
        i from]
    (while (< i (len xs))
      (push v (at xs i))
      (set i (+ i 1)))
    (as-slice v)))

;; A name no reader can produce. `~` is a delimiter now (it opens an unquote),
;; so no symbol coming out of read_all can contain one, and a gensym therefore
;; cannot collide with a name someone wrote. Non-hygienic expansion with an
;; explicit gensym is the settled decision (plan.org, open decision 2); this is
;; the escape hatch that makes it liveable.
;;
;; The counter lives in the loaded module rather than in the compiler, which is
;; the one place this departs from NEXT.md's sketch. A module is dlopened once
;; per compiler process and every macro in a program shares it, so the counter
;; is process-wide in practice; a second module would restart it, and the day
;; there is one, the fix is to seed this from the module's index.
(defvar gensym-n i64 0)

(defn gensym [] Form
  (set gensym-n (+ gensym-n 1))
  (let [v (vec-new u8)]
    (push v 126)   ; ~
    (push v 103)   ; g
    (let [d (i64->bytes gensym-n)]
      (dotimes [i (len d)]
        (push v (at d i))))
    (Form.Sym {.s (string (as-slice v))})))

;; ── The first special form to stop being one ──────────────────────────
;;
;; plan.org milestone 5 says when, unless, until, cond and dotimes are special
;; forms only until macros land. This is the one that moved, and it is here to
;; show that the move is possible and cheap, not because it was the most
;; valuable of the five: it is the one no other part of the prelude uses, so
;; moving it cannot make the prelude depend on the expander that compiles it.
;;
;; The expansion is exactly what parse.ml built by hand until now -- an if over
;; (not test) with the body in a do -- so every test written against the
;; special form is a test of this, unchanged.
;;
;; The one thing the compiler could say and this cannot is a reason. A macro
;; has no error facility: it runs inside the compiler and anything it signals
;; aborts the compile with no location. So a malformed (unless) answers a name
;; nothing defines, and the report is "unknown name unless-takes-a-test-and-a-
;; body" at the call site, which is the right place and the wrong sentence.
;; That is the next thing a macro needs and it is written down in NEXT.md.
(defmacro unless [args]
  (if (< (len args) 2)
    `(unless-takes-a-test-and-a-body)
    `(if (not ~(at args 0)) (do ~@(form-rest args 1)))))

|flan}

let file = "<prelude>"

(* The bootstrap hook, and the whole of why a prelude function may now call a
   prelude macro.

   [Check.program] prepends this file to every program, and a macro module is
   built by running [Check.program] over the prelude — so a prelude function
   that calls a macro cannot be compiled *into the very module that would
   expand it*. That is a cycle, not an ordering mistake, and it is broken by
   making the prelude smaller for exactly the one build that cannot afford it:
   while a macro module is being built, [Macro] installs a reduction here that
   drops every [defn] depending, directly or transitively, on a macro. A
   *macro* that lands in that set is refused by name — see [Macro.reduce].

   A ref rather than a parameter because the readers are [Check.program] and
   [Parse.prelude_types], neither of which can be told, and because [Macro]
   sits above both and cannot be depended on from here. *)
let bootstrap : (Form.t list -> Form.t list) ref = ref (fun fs -> fs)

let forms () = !bootstrap (Reader.read_all ~file source)