(** 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 overloading: [print-f64] and [print-str] name the type, because
    compile-time overloading before the checker is stable is how a small
    language stops being one. A single [println] is milestone 5. *)

let source = {flan|
(defn print-bytes [b [u8]]
  (write-stdout b))

(defn print-str [s string]
  (write-stdout (bytes s)))

(defn print-f64 [x f64]
  (write-stdout (f64->bytes x)))

(defn print-i64 [x i64]
  (write-stdout (i64->bytes x)))

(defn newline []
  (write-stdout (bytes "\n")))

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

;; Prints s and then a newline. Takes a string, not an Option or an any —
;; there is nothing to dispatch on yet.
(defn print-line [s string]
  (print-str s)
  (newline))

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

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

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

let file = "<prelude>"

let forms () = Reader.read_all ~file source