Slice algorithms and number parsing, in Flan
The standard library's first real content beyond printers. Everything is in-place over a slice, because there is no allocator and nowhere to put a copy - and a slice aliases its owner's storage, so sorting one sorts the original. No generics means no single sort. Each is spelled per concrete type, which is a cost paid deliberately rather than worked around. parse-i64 is written in Flan rather than bound to strtoll, which answers 0 for an empty string, for a string of letters, and for a genuine zero, and reports overflow through errno.
This commit is contained in:
commit
b34cd6de58
173
lib/prelude.ml
173
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 = "<prelude>"
|
||||
|
||||
84
test/programs/slices.flan
Normal file
84
test/programs/slices.flan
Normal file
@ -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)
|
||||
83
test/programs/text.flan
Normal file
83
test/programs/text.flan
Normal file
@ -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)
|
||||
@ -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. *)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user