parse-i64 in Flan, because strtoll answers 0 four different ways
bytes->i64 is strtoll behind a primitive, and strtoll returns 0 for "", for "abc", for a lone "-", and for the "12" in "12x". None of those is distinguishable from a real 0, so any program that parses input it did not write is already wrong and has no way to find out. parse-i64 takes the whole slice or refuses it and says so with None. It is also the version that answers the same on wasm32: strtoll is libc's and locale-sensitive, which is the same argument that put the PRNG in the prelude rather than leaving it to rand(). The byte predicates are over [u8] rather than over string on purpose. (bytes s) is one call at the call site, and in exchange one copy of each function serves strings and byte slices both — which is as near a generic as this gets. Each tests its length before it slices, and `and` short-circuits, so a prefix longer than the subject answers false instead of tripping the slice bounds check. sign-f32 and lerp are the only two numeric helpers here, because they are the only two that decide something. clamp is (min hi (max lo x)) and abs is (max x (- 0 x)) over builtins that already exist — a prelude wrapper is a function emitted into every program to save a caller nothing. sign-f32 answers 0.0 for NaN, which is a choice and is written down. lerp is the weighted sum and not a + t*(b - a): the latter does not land on b exactly at t = 1.0, and a position that never quite arrives is what interpolation gets bug reports for. floor, ceil and round are deliberately absent. (f32 (i32 x)) is fptosi, which is poison out of range, and shipping that as a documented limitation is the same class of bug NEXT.md already records twice under Sharp edges. Correct lowering is llvm.floor.f32 in emit.ml, which is not this lane. sqrt is absent for a different reason: it is an extern to libm, and what libm means on wasm32 is a decision the FFI owns, not the prelude. rand-i32-range answers lo for an empty or reversed range rather than dividing by zero, which is immediate undefined behaviour and not merely a wrong number. Both range functions draw exactly one rand-u32 and neither changes it, so the sand hash still pins the generator; the new test pins the derivations off a fixed seed, which nothing else would have caught.
This commit is contained in:
parent
84e170b349
commit
7fcda905ff
@ -132,6 +132,103 @@ let source = {flan|
|
|||||||
(dotimes [i (len s)]
|
(dotimes [i (len s)]
|
||||||
(set t (+ t (i64 (at s i)))))
|
(set t (+ t (i64 (at s i)))))
|
||||||
t))
|
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}
|
|flan}
|
||||||
|
|
||||||
let file = "<prelude>"
|
let file = "<prelude>"
|
||||||
|
|||||||
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)
|
||||||
@ -123,6 +123,26 @@ let () =
|
|||||||
in
|
in
|
||||||
outputs "slice algorithms" "programs/slices.flan" slices_out;
|
outputs "slice algorithms" "programs/slices.flan" slices_out;
|
||||||
outputs ~opt:"-O0" "slice algorithms, -O0" "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
|
(* 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
|
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. *)
|
not displace the one outside it, and the stack is restored after. *)
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user