Joseph Ferano
4fe2f36d98
Finishing the text family the previous lane started. All three are over [u8] and none of them allocates, which is what decides their shapes. trim answers a slice of its input. That is the only shape available without an allocator, and it is also the better one: there is no new storage, only a narrower view of the caller's, so the result dies with its owner and trimming modifies nothing. Both loops test (< lo hi), because an all-whitespace input otherwise walks lo past hi and (slice s lo hi) traps on a reversed range - the same trap the bounds table already asserts on. That input is in the case list. index-of-bytes is naive and stays naive. Boyer-Moore wants a skip table sized by the needle, which is an array, which is an allocation. The empty needle answers Some 0 so that index-of-bytes and starts-with? agree on every needle, and the length test returns before the loop so a needle longer than the haystack cannot build a window off the end. parse-f64 splits the work where the two halves actually differ: the grammar is Flan's and the rounding is libc's. parse-i64 is entirely Flan because strtoll's answers are wrong for a caller - 0 for "", 0 for "abc", 12 for "12x" - and not because decimal-to-binary conversion is suspect. Reimplementing correctly rounded conversion is a different and much larger problem than rejecting junk, and IEEE-754 already guarantees strtod gives the same bits everywhere. So this validates the whole slice and only a slice that is entirely a number reaches bytes->f64. Every refusal in the table - "", "abc", "1x", ".", "1e", " 1", "1 ", "0x10", "nan" - is a plausible number out of strtod. Two caveats, both written into the source rather than discovered later. The locale worry that keeps parse-i64 in Flan does apply to strtod's decimal point, and is moot only because nothing in the runtime calls setlocale; if that stops being true this is what breaks. And the length is capped at 511 because flan_bytes_to_f64 truncates there - a validator that approved 600 digits would be approving a different number than the one strtod reads. digit? and space? exist because parse-f64 and trim need them, and calc-me loses its own byte-identical digit?. One top-level namespace makes the second definition an error rather than a shadow, which is the rule doing its job: two copies that later drift apart is exactly what it prevents.
345 lines
14 KiB
OCaml
345 lines
14 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 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))))
|
||
;; ── 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
|