830 lines
40 KiB
OCaml
830 lines
40 KiB
OCaml
(** 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)
|
||
|
||
|flan}
|
||
|
||
let file = "<prelude>"
|
||
|
||
let forms () = Reader.read_all ~file source
|