diff --git a/lib/prelude.ml b/lib/prelude.ml index cb427e8..cd8fca5 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -56,6 +56,179 @@ let source = {flan| (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 two 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. + +;; 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. +(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)))) |flan} let file = "" diff --git a/test/programs/slices.flan b/test/programs/slices.flan new file mode 100644 index 0000000..4d53d91 --- /dev/null +++ b/test/programs/slices.flan @@ -0,0 +1,84 @@ +;;;; The prelude's in-place slice algorithms. +;;;; +;;;; Every input here is chosen so that a wrong implementation passes nothing. +;;;; The sort input is unsorted, has duplicates, has negatives and has an odd +;;;; length, so a comparison with the wrong sense, an off-by-one that drops the +;;;; last element, and a swap that loses an equal key all show up. The second +;;;; sort is reverse-sorted, which is the worst case for insertion sort and the +;;;; case a no-op comparison would pass. The third sorts a *subslice* and then +;;;; prints the whole owning array: a slice is ptr+len into its owner, so the +;;;; five elements inside the range must be sorted and the three outside it +;;;; must be untouched. That last one is the property that dies silently if a +;;;; slice parameter ever starts being copied. + +(defvar xs [7 i32]) +(defvar ys [5 i32]) +(defvar zs [8 i32]) + +(defn show [s [i32]] + (dotimes [i (len s)] + (when (> i 0) (print-str " ")) + (print-i64 (i64 (at s i)))) + (newline)) + +(defn load-xs [] + (set (at xs 0) 5) + (set (at xs 1) -3) + (set (at xs 2) 5) + (set (at xs 3) 0) + (set (at xs 4) 12) + (set (at xs 5) -3) + (set (at xs 6) 7)) + +(defn main [] i32 + (load-xs) + (show (slice xs 0 (len xs))) ; 5 -3 5 0 12 -3 7 + + ;; Reading the whole slice, before anything reorders it. + (print-i64 (sum-i32 (slice xs 0 (len xs)))) (newline) ; 23 + (print-i64 (i64 (match (min-i32 (slice xs 0 (len xs))) (Some v) v None 99))) + (newline) ; -3 + (print-i64 (i64 (match (max-i32 (slice xs 0 (len xs))) (Some v) v None 99))) + (newline) ; 12 + ;; First index, not the last: 5 appears at 0 and at 2. + (print-i64 (i64 (match (index-of-i32 (slice xs 0 (len xs)) 5) + (Some v) v None -1))) + (newline) ; 0 + (print-i64 (i64 (match (index-of-i32 (slice xs 0 (len xs)) 4) + (Some v) v None -1))) + (newline) ; -1 + ;; An empty slice has no least element, and None is the answer. + (print-i64 (i64 (match (min-i32 (slice xs 3 3)) (Some v) v None 99))) + (newline) ; 99 + + ;; Reverse of an odd-length slice: the middle element stays put. + (reverse-i32! (slice xs 0 (len xs))) + (show (slice xs 0 (len xs))) ; 7 -3 12 0 5 -3 5 + ;; And of a two-element one, the smallest case that can actually move. + (reverse-i32! (slice xs 0 2)) + (show (slice xs 0 (len xs))) ; -3 7 12 0 5 -3 5 + + (load-xs) + (sort-i32! (slice xs 0 (len xs))) + (show (slice xs 0 (len xs))) ; -3 -3 0 5 5 7 12 + + ;; Reverse-sorted: the case a comparison that never fires would pass. + (set (at ys 0) 5) (set (at ys 1) 4) (set (at ys 2) 3) + (set (at ys 3) 2) (set (at ys 4) 1) + (sort-i32! (slice ys 0 (len ys))) + (show (slice ys 0 (len ys))) ; 1 2 3 4 5 + + ;; A subslice, with the elements on both sides left alone. + (set (at zs 0) 100) (set (at zs 1) 9) (set (at zs 2) -1) + (set (at zs 3) 9) (set (at zs 4) 4) (set (at zs 5) 0) + (set (at zs 6) 200) (set (at zs 7) 300) + (sort-i32! (slice zs 1 6)) + (show (slice zs 0 (len zs))) ; 100 -1 0 4 9 9 200 300 + + ;; Degenerate lengths must do nothing rather than run off an end. + (sort-i32! (slice zs 0 0)) + (reverse-i32! (slice zs 0 0)) + (sort-i32! (slice zs 2 3)) + (reverse-i32! (slice zs 2 3)) + (show (slice zs 0 (len zs))) ; 100 -1 0 4 9 9 200 300 + 0) diff --git a/test/programs/text.flan b/test/programs/text.flan new file mode 100644 index 0000000..aab05e4 --- /dev/null +++ b/test/programs/text.flan @@ -0,0 +1,83 @@ +;;;; The prelude's byte predicates, parse-i64, and the two number helpers. +;;;; +;;;; The cases are chosen so a wrong implementation fails one: a prefix longer +;;;; than the string (which must answer false, not trap), the empty prefix and +;;;; the whole string as its own prefix, a prefix that matches at the wrong +;;;; end, and for parse-i64 every shape strtoll answers 0 for — "", "abc", +;;;; "12x", "-" — each of which a caller could not tell from a real 0. + +(defn show-bool [b bool] + (print-str (if b "t" "f"))) + +(defn main [] i32 + (show-bool (bytes=? (bytes "abc") (bytes "abc"))) ; t + (show-bool (bytes=? (bytes "abc") (bytes "abd"))) ; f same length + (show-bool (bytes=? (bytes "abc") (bytes "ab"))) ; f prefix, not equal + (show-bool (bytes=? (bytes "") (bytes ""))) ; t + (newline) + + (show-bool (starts-with? (bytes "hello") (bytes "hel"))) ; t + (show-bool (starts-with? (bytes "hello") (bytes "llo"))) ; f matches the end + (show-bool (starts-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap + (show-bool (starts-with? (bytes "hello") (bytes ""))) ; t + (show-bool (starts-with? (bytes "hello") (bytes "hello"))) ; t + (newline) + + (show-bool (ends-with? (bytes "hello") (bytes "llo"))) ; t + (show-bool (ends-with? (bytes "hello") (bytes "hel"))) ; f matches the start + (show-bool (ends-with? (bytes "hi") (bytes "hiya"))) ; f longer, no trap + (show-bool (ends-with? (bytes "hello") (bytes ""))) ; t + (show-bool (ends-with? (bytes "hello") (bytes "hello"))) ; t + (newline) + + ;; First occurrence, and None for a byte that is not there. + (print-i64 (i64 (match (index-of-byte (bytes "banana") \a) (Some i) i None -1))) + (print-str " ") + (print-i64 (i64 (match (index-of-byte (bytes "banana") \z) (Some i) i None -1))) + (print-str " ") + (print-i64 (i64 (match (index-of-byte (bytes "") \a) (Some i) i None -1))) + (newline) + + ;; Accepted. + (print-i64 (match (parse-i64 (bytes "0")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "42")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "-42")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "+7")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "9007199254740993")) (Some v) v None -999)) + (newline) + ;; Refused. Each of these is a 0 out of strtoll, which is the point. + (print-i64 (match (parse-i64 (bytes "")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "abc")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "12x")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes "-")) (Some v) v None -999)) (print-str " ") + (print-i64 (match (parse-i64 (bytes " 1")) (Some v) v None -999)) + (newline) + + (print-f64 (f64 (sign-f32 3.5))) (print-str " ") + (print-f64 (f64 (sign-f32 -3.5))) (print-str " ") + (print-f64 (f64 (sign-f32 0.0))) + (newline) + + ;; t = 1.0 must return b exactly, which a + t*(b - a) does not always do. + (print-f64 (f64 (lerp 0.0 10.0 0.0))) (print-str " ") + (print-f64 (f64 (lerp 0.0 10.0 0.25))) (print-str " ") + (print-f64 (f64 (lerp 0.0 10.0 1.0))) (print-str " ") + (print-f64 (f64 (lerp 2.0 -2.0 0.5))) + (newline) + + ;; The RNG ranges, off a fixed seed, so the numbers are the sequence and not + ;; just "something in range". An empty range answers lo and must not divide. + (rand-seed 7) + (dotimes [i 5] + (when (> i 0) (print-str " ")) + (print-i64 (i64 (rand-i32-range 10 20)))) + (newline) + (print-i64 (i64 (rand-i32-range 5 5))) (print-str " ") + (print-i64 (i64 (rand-i32-range 5 -5))) + (newline) + (rand-seed 7) + (dotimes [i 3] + (when (> i 0) (print-str " ")) + (print-f64 (f64 (rand-f32-range 0.0 1.0)))) + (newline) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 14bb5ad..a34bde7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -109,6 +109,40 @@ let () = outputs "value semantics" "programs/values.flan" values_out; outputs "machine surface" "programs/machine.flan" machine_out; outputs "unit main exits 0" "programs/unit-main.flan" "ok\n"; + (* The prelude's slice algorithms. Every assertion here is over an input a + wrong implementation fails: unsorted with duplicates, negatives and an + odd length; a reverse-sorted slice; and a sort of a subslice whose + neighbours must be untouched, which is the in-place, ptr+len claim + itself. At -O0 as well — a slice parameter is an alloca of a two-word + struct, and mem2reg is exactly what would hide it being copied. *) + let slices_out = + "5 -3 5 0 12 -3 7\n23\n-3\n12\n0\n-1\n99\n\ + 7 -3 12 0 5 -3 5\n-3 7 12 0 5 -3 5\n\ + -3 -3 0 5 5 7 12\n1 2 3 4 5\n\ + 100 -1 0 4 9 9 200 300\n100 -1 0 4 9 9 200 300\n" + in + outputs "slice algorithms" "programs/slices.flan" slices_out; + outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out; + (* The byte predicates, parse-i64, and the two number helpers. The refused + parse-i64 cases are every shape strtoll answers 0 for — "", "abc", + "12x", "-", " 1" — so a None there is the whole reason the function is + Flan and not the bytes->i64 primitive. The RNG lines pin the actual + sequence off a fixed seed rather than just a range, which is the only + way a later change to the derivation gets caught; rand-u32 itself is + pinned by the sand hash. *) + let text_out = + "tfft\ntfftt\ntfftt\n\ + 1 -1 -1\n\ + 0 42 -42 7 9007199254740993\n\ + -999 -999 -999 -999 -999\n\ + 1 -1 0\n\ + 0 2.5 10 0\n\ + 11 14 12 14 15\n5 5\n\ + 0.793725 0.324519 0.0835023\n" + in + outputs "bytes, parsing and numbers" "programs/text.flan" text_out; + outputs ~opt:"-O0" "bytes, parsing and numbers, -O0" "programs/text.flan" + text_out; (* handler-bind and signal, spec-conditions.md §1 and §2: signal returns Unit and carries on, an unhandled one is a no-op, a nested frame does not displace the one outside it, and the stack is restored after. *)