flan/lib/prelude.ml
Joseph Ferano 9e0ae3a4ce The compiler can dlopen now, and Form is declared; the expander is not written
Running a macro means compiling it and loading it into the compiler, and the
step that reads as small in NEXT.md is not: OCaml has no dlopen for ELF, and
lib/dune had no foreign_stubs. So the boundary is built first and the expander
not at all. lib/dynload_stubs.c is the whole of it — dlopen, dlsym, a
four-argument call into a macro thunk, and a peek/poke family, because OCaml
cannot address the raw memory a Form image has to be laid out in.

Nothing aggregate crosses to C. The unions lane verified a union's memory
layout against clang, which is a different claim from LLVM's convention for an
aggregate passed or returned by value in hand-written IR, so Emit.macro_thunk
wraps every macro in void(ptr,i64,ptr,ptr): the slice is built and the result
stored on the LLVM side, and the compiler's side is four pointers.

Build.macro_module links the runtime in rather than declaring it external, so
the module has no undefined symbols and the compiler's own link needs no
-rdynamic. That is the difference from Build.shared, whose host is a running
Flan program.

defunion Form and the list-building surface quasiquote will desugar into are in
the prelude. Form mirrors Form.value and not Form.t: no loc field, so the
compiler stamps the call site's location onto everything a macro returns.

The compiler builds. dune test was not run, and Form's layout is asserted
nowhere — NEXT.md's new handoff section says what the three numbers are, what
the next two commits should be, and the four decisions this made that the
design did not settle.
2026-09-12 17:18:26 +07:00

921 lines
43 KiB
OCaml
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(** 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: BoyerMoore 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))})))
|flan}
let file = "<prelude>"
let forms () = Reader.read_all ~file source