(** 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 ────────────────────────────────────
;;
;; Over [i32] and nothing else. There are no generics, so one of these per
;; element type is one *copy* per element type, emitted into every program;
;; i32 is the type indices, ids and tile values already have, and f32 copies
;; wait until a program actually wants them.
;;
;; 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 is the whole reason the shape is in-place —
;; there is no allocator to return a new sequence from.

(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))

;; ── 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. clamp is (min hi (max lo x)) over two
;; builtins and abs is (max x (- 0 x)); a wrapper over those 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.

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

;; ── 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 and all of core/fmt takes `allocator :=
;; context.allocator`, and is therefore refused below rather than ported.
;;
;; 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 ─────────────────────────────────────────────────────────
;;
;; `split` returning a sequence of fields must allocate the sequence, and
;; there is no allocator — so it is refused by name at the bottom of this
;; file, and this is the shape that survives. It is Odin's
;; split_by_byte_iterator (strings.odin): a cursor holding the rest of the
;; input, handing back one field at a time. Every field is a slice *of the
;; caller's bytes*; nothing is copied and nothing is owned.
;;
;; 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), which
;; is not available here; the obvious substitute — lowering a [u8] in place —
;; is a trap, 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)))

;; ── Refused, by name ──────────────────────────────────────────────────
;;
;; Every one of these needs to produce bytes that did not exist in its input,
;; and there is no allocator, so each is absent rather than approximated.
;; None of them is hard to write once `(Vec u8)` and an allocator exist; all
;; of them are impossible to write honestly today.
;;
;;   join, concat          build one buffer out of several inputs.
;;   to-lower, to-upper    a new string, per Odin's conversion.odin. The
;;                         byte-wise and folding-comparison forms above are
;;                         what is available without one.
;;   split                 the *sequence* of fields is itself an allocation.
;;                         split-on-byte / split-next! above is the same
;;                         information with no sequence to own.
;;   replace, repeat, pad  same reason as join.
;;   string-from-bytes     a [u8] cannot become a `string` here even though
;;                         the layouts are identical; see the report.
;;   format, sprintf       Odin's fmt.aprintf family, all allocating.
;;   Builder               strings.Builder is (defstruct Builder [buf
;;                         (Vec u8)]), which spec-memory.md already makes
;;                         move-only by the rule that a struct containing a
;;                         Vec is move-only. It needs the Vec, not a spec
;;                         change.
;; ── 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>"

let forms () = Reader.read_all ~file source