flan/test/programs/algorithms.flan
Joseph Ferano 2e203f64b8 bytes copies, bytes-view aliases, and a dev-session segfault parks
The INSERTIONSORT crash, all three rulings (FIX.org 2026-09-20):

- (bytes s) allocates a writable copy through the allocator surface —
  context or (bytes s a), StorageExhausted with retry, a registry note in
  dev builds (flan_bytes_dup, lowered like vec-new). (bytes-view s) is the
  old zero-cost reinterpret, renamed, read-only by convention; every
  in-repo reader swept over to it. (string b) unchanged.
- String constants were already read-only on both backends at -O0; now
  pinned — bytes-copy.flan rows on LLVM/-O0/--x86, and dies_segv rows
  asserting the write-through-view trap on both backends.
- A dev build installs a SIGSEGV/SIGBUS handler by the same dev-only
  constructor slot that arms the registry: one line naming the address and
  the innermost frame, then the trap-hook park — stopped, not dead, the
  daemon serving. No agent: message and re-raise. Release builds untouched.
  Pinned by trap_park over dev-segv.flan.
2026-09-20 23:12:42 +07:00

121 lines
5.5 KiB
Plaintext

;;;; The slice family at its second and third element types.
;;;;
;;;; sort was the only sort in the language. These are the other two, and
;;;; they are copies rather than an abstraction: map, filter, reduce and a sort
;;;; taking a comparator all need a *function value*, which check.ml refuses
;;;; with "a function type is not implemented yet -- milestone 5". So the
;;;; honest form is the concrete one, and the claim this file makes is only
;;;; that the concrete ones are right.
(defn show-f32 [s [f32]] ()
(dotimes [i (len s)]
(print (at s i))
(print " "))
(println ""))
(defn show-fields [s [[u8]]] ()
(dotimes [i (len s)]
(print (string (at s i)))
(print " "))
(println ""))
(defn main [] i32
;; Every float literal is cast. A literal defaults to f64 and an array
;; literal has no context to say otherwise -- a let has no type annotation --
;; so [3.5 -1.0] is an [f64] and (sort) refuses it by type. The cast is
;; the only spelling available today.
;;
;; sort: duplicates, negatives, a zero and an odd length, which is the
;; input shape the i32 sort is tested on for the same reasons.
(let [xs [(f32 3.5) (f32 -1.0) (f32 0.0) (f32 3.5) (f32 -2.25) (f32 10.0) (f32 0.5)]]
(sort (slice xs 0 7))
(show-f32 (slice xs 0 7))) ; -2.25 -1 0 0.5 3.5 3.5 10
;; In place and ptr+len: sorting a subslice leaves its neighbours alone. That
;; is the whole content of the in-place claim, and a version that copied
;; would pass every test above and fail this one.
(let [xs [(f32 9.0) (f32 4.0) (f32 3.0) (f32 2.0) (f32 1.0) (f32 9.0)]]
(sort (slice xs 1 5))
(show-f32 (slice xs 0 6))) ; 9 1 2 3 4 9
;; Already sorted, reverse sorted, and a single element -- the three inputs
;; where an insertion loop with the comparison the wrong way round still
;; looks plausible.
(let [xs [(f32 1.0) (f32 2.0) (f32 3.0)]]
(sort (slice xs 0 3))
(show-f32 (slice xs 0 3))) ; 1 2 3
(let [xs [(f32 3.0) (f32 2.0) (f32 1.0)]]
(sort (slice xs 0 3))
(show-f32 (slice xs 0 3))) ; 1 2 3
(let [xs [(f32 7.0)]]
(sort (slice xs 0 1))
(show-f32 (slice xs 0 1))) ; 7
;; The empty slice must not read (at s -1).
(let [xs [(f32 7.0)]]
(sort (slice xs 0 0))
(show-f32 (slice xs 0 0))) ;
(let [xs [(f32 1.0) (f32 2.0) (f32 3.0) (f32 4.0)]]
(reverse (slice xs 0 4))
(show-f32 (slice xs 0 4))) ; 4 3 2 1
;; min, max and sum. The empty slice is None for the first two -- there is no
;; least f32 that is also an honest answer -- and the sum accumulates in f64,
;; which is why 16777216 + 1 does not absorb here the way it would in f32.
(let [xs [(f32 3.5) (f32 -1.0) (f32 10.0)]]
(match (min-of (slice xs 0 3)) (Some m) (print m) None (print "none"))
(print " ")
(match (max-of (slice xs 0 3)) (Some m) (print m) None (print "none"))
(print " ")
(print (sum-f32 (slice xs 0 3)))
(println "")) ; -1 10 12.5
(let [xs [(f32 1.0)]]
(match (min-of (slice xs 0 0)) (Some m) (print m) None (print "none"))
(print " ")
(print (sum-f32 (slice xs 0 0)))
(println "")) ; none 0
;; The accumulator's width, made visible. 2^24 is where an f32 stops having
;; a bit for 1, so an f32 running total absorbs both of these and the
;; difference below is 0. In f64 they both land, and it is 2.
(let [xs [(f32 16777216.0) (f32 1.0) (f32 1.0)]]
(print (- (sum-f32 (slice xs 0 3)) 16777216.0))
(println "")) ; 2
;; bytes<? is bytewise and unsigned, and explicitly not alphabetical: "Zebra"
;; comes before "apple" because 'Z' is 90. A prefix comes before what extends
;; it, which is the case a loop running only to (len a) reads off the end
;; for, and 0x80 above 0x00 is the case a signed byte gets backwards.
(print (bytes<? (bytes-view "a") (bytes-view "b"))) (print " ") ; true
(print (bytes<? (bytes-view "b") (bytes-view "a"))) (print " ") ; false
(print (bytes<? (bytes-view "a") (bytes-view "a"))) (print " ") ; false
(print (bytes<? (bytes-view "ab") (bytes-view "abc"))) (print " ") ; true
(print (bytes<? (bytes-view "abc") (bytes-view "ab"))) (print " ") ; false
(print (bytes<? (bytes-view "") (bytes-view "a"))) (print " ") ; true
(print (bytes<? (bytes-view "Zebra") (bytes-view "apple"))) ; true
(println "")
;; 0x00 below 0x80, which is the pair a comparison over a *signed* byte gets
;; backwards -- and there is no \x escape in the reader, so these are built
;; as u8 arrays rather than written as string literals.
(let [lo [(u8 0)]
hi [(u8 128)]]
(print (bytes<? (slice lo 0 1) (slice hi 0 1))) (print " ") ; true
(print (bytes<? (slice hi 0 1) (slice lo 0 1))) ; false
(println ""))
;; sort-bytes over the fields split out of one buffer. The slices move and
;; the bytes never do, so this sorts a borrowed view of a string literal --
;; which an in-place byte sort could not, since a literal lives in .rodata.
(let [f (split (bytes-view "pear,apple,Fig,apple,banana") \,)]
(sort-bytes (as-slice f))
(show-fields (as-slice f)) ; Fig apple apple banana pear
(free f))
;; And the round trip the whole second tier is for: split, sort, join.
(let [f (split (bytes-view "delta,alpha,charlie,bravo") \,)]
(sort-bytes (as-slice f))
(let [j (join (as-slice f) (bytes-view " < "))]
(println (string (as-slice j))) ; alpha < bravo < charlie < delta
(free j))
(free f))
0)