diff --git a/lib/prelude.ml b/lib/prelude.ml index cb427e8..6c5d18a 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -56,6 +56,82 @@ 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)) |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/test_acceptance.ml b/test/test_acceptance.ml index 14bb5ad..80143e3 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -109,6 +109,20 @@ 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; (* 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. *)