diff --git a/lib/prelude.ml b/lib/prelude.ml index 6c5d18a..cd8fca5 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -132,6 +132,103 @@ let source = {flan| (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/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 80143e3..a34bde7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -123,6 +123,26 @@ let () = 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. *)