flan/test/programs/algorithms.flan
Joseph Ferano 26c53e0a19 Every defn in the tree states its return type, and Unit is written ()
The mechanical half, ahead of the parser change that needs it. tools/unit-return.py
fills the empty slot with () and rewrites Unit as () wherever a type is spelled --
(Fn [i32] Unit), (Map i32 Unit), a return type written out.

Deciding whether a defn already had a return type is the whole difficulty, and
the script does it the way parse.ml did: is_type_form is transcribed rather than
improved, because being identical to the parser it replaces is what makes the
sweep meaning-preserving. It is re-runnable, so the lanes that branched before
this can have the same pass at merge:

    python3 tools/unit-return.py .
    python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \
        test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el
    python3 tools/unit-return.py --raw-ml lib/prelude.ml
    python3 tools/unit-return.py --in-html web/index.html

-v logs every defn it saw and what it decided, which is how a sweep of 440 sites
gets reviewed at all. Embedded modes pool a file's type declarations across all
its fragments, because a snippet split across concatenation -- decls ^ "(defn f
[s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled
names count only in bare-symbol position, for the same reason the prelude's do.
A fragment that cuts off mid-form is skipped rather than guessed at. Five sites
in test_flan.ml still needed a hand, and they are in this commit.

Two things ride along because the sweep needs them: parse.ml reads a lone () as
the return type of a function with no body, which was not a shape the old
optional slot could produce; and the map refusals name () rather than Unit, since
that is now the spelling a caller wrote.
2026-09-12 23:06:40 +07:00

121 lines
5.5 KiB
Plaintext

;;;; The slice family at its second and third element types.
;;;;
;;;; sort-i32! 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-f32!) refuses it by type. The cast is
;; the only spelling available today.
;;
;; sort-f32!: 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-f32! (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-f32! (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-f32! (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-f32! (slice xs 0 3))
(show-f32 (slice xs 0 3))) ; 1 2 3
(let [xs [(f32 7.0)]]
(sort-f32! (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-f32! (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-f32! (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-f32 (slice xs 0 3)) (Some m) (print m) None (print "none"))
(print " ")
(match (max-f32 (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-f32 (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 "a") (bytes "b"))) (print " ") ; true
(print (bytes<? (bytes "b") (bytes "a"))) (print " ") ; false
(print (bytes<? (bytes "a") (bytes "a"))) (print " ") ; false
(print (bytes<? (bytes "ab") (bytes "abc"))) (print " ") ; true
(print (bytes<? (bytes "abc") (bytes "ab"))) (print " ") ; false
(print (bytes<? (bytes "") (bytes "a"))) (print " ") ; true
(print (bytes<? (bytes "Zebra") (bytes "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 "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 "delta,alpha,charlie,bravo") \,)]
(sort-bytes! (as-slice f))
(let [j (join (as-slice f) (bytes " < "))]
(println (string (as-slice j))) ; alpha < bravo < charlie < delta
(free j))
(free f))
0)