JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

The prelude's per-type families collapse: 22 functions become 10, 27 become 16

Browse Source 
swap!, reverse!, sort!, sort-by!, index-of, min-of, max-of, map!,
reduce and filter, each written once over $t. Every call site in the
corpus moves with them.

min-of and max-of are not min and max because min and max are builtins
over two or more numbers and nothing shadows a builtin. These reduce a
slice, which is a different operation at a different arity.

sort-bytes! did not collapse into sort!, and the reason is the point of
the predicates: a [u8] is not ordered? and cannot be, because < is an
instruction and comparing two slices lexicographically is a loop. It is
sort-by! with bytes<? written in, one line, keeping its name and its
stability note. sum-i32/sum-f32 and append-i64!/append-f64! stay for the
reasons the spike gave.

Not what the notes predicted: none of the ten collapses on a signature
change alone. filter and reduce need copyable? because the checker
demands it - reduce's accumulator at (Vec i32) is a double move - and
the rest declare it because a slice of owning elements would have them
duplicating headers.
This commit is contained in:
Joseph Ferano 2026-09-13 14:49:11 +07:00
parent b438a71031
commit dad725afe4
15 changed files with 480 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lib/check.ml
View File

@ -4756,14 +4756,46 @@ and generic_call ctx ~want loc name vars pats pret args =
vars;
let cparams = List.map (subst_ty !subst) pats in
let cret = subst_ty !subst pret in
if List.exists generic_ty cparams || generic_ty cret then
if List.exists generic_ty cparams || generic_ty cret then begin
(* One generic function calling another at its *own* variable, seen from
the abstract pass over the caller's body — [sort-by!] calling [swap!]
at [t]. There is no copy to make yet: [t] is not a type. The node is
built so the call still type-checks and is thrown away with the rest of
the abstract pass; the real copy is generated when the caller is
instantiated and the same call site resolves [t] to a concrete type. *)
instantiated and the same call site resolves [t] to a concrete type.
But the callee's [where] clause is answerable here, and has to be. The
whole promise of the abstract pass is that a generic's refusals arrive
at its definition; if the predicate were left to the instantiation,
[(defn f [x $t] () (sort! [x]))] would be accepted at its definition
and refused at whichever call site first instantiated it — a refusal in
code the caller did not write, which is the thing the pass exists to
avoid. So the caller has to declare at least what the callee asks for,
and [pred_entails] means [ordered?] covers a callee wanting
[copyable?] without anyone writing both. *)
(match Hashtbl.find_opt ctx.env.generics name with
| None -> ()
| Some gfn ->
List.iter
(fun (p : Ast.pred) ->
match List.assoc_opt p.Ast.pvar !subst with
| Some (Types.Var v) when not (declares ctx.env.tvpreds v p.Ast.pname) ->
Loc.failk "check/predicate-not-carried" loc
"%s is written {:where (%s $%s)}, and this call passes the \
type variable %s, which nothing here declares %s. Add \
{:where (%s $%s)} to this function's own clause — a \
predicate a body relies on has to be carried by every \
signature between it and the call site"
name p.Ast.pname p.Ast.pvar v p.Ast.pname p.Ast.pname v
| Some t when not (generic_ty t) && not (pred_holds p.Ast.pname t) ->
Loc.failk "check/predicate-unsatisfied" loc
"%s is written {:where (%s $%s)}, and this call passes %s, \
which is not %s"
name p.Ast.pname p.Ast.pvar (Types.to_string t) p.Ast.pname
| _ -> ())
gfn.Ast.fwhere);
expect loc ~want (mk loc cret (Tast.Call (name, targs)))
end
else
let sym = instantiate ctx.env loc name vars !subst cparams cret in
expect loc ~want (mk loc cret (Tast.Call (sym, targs)))

349
lib/prelude.ml
View File

@ -145,37 +145,109 @@ let source = {flan|
;; shape and the same argument — so the set is the same i32 and f32 the rest of
;; this family covers.
(defn swap-i32! [s [i32] i i32 j i32] ()
;; ── One family, over one type variable ────────────────────────────────
;;
;; What used to be a copy per element type. A [$t] binds a type variable in
;; the signature and every call site instantiates the body at the types it
;; passes, so [(sort! xs)] over a [i32] and over a [f32] are two emitted
;; bodies from one written one.
;;
;; **Two things in the signatures are not decoration.**
;;
;; [{:where (ordered? $t)}] is what lets the body write [<] at all. A type
;; variable supports only what it is declared to support — an unconstrained
;; one is refused at the *definition*, not at some later call site — and
;; [ordered?] is the predicate that admits [<], [<=], [>], [>=], [min] and
;; [max]. It admits [=] and [copyable?] too: every type the language orders is
;; a number or an enum, so it is equatable and it is not move-only.
;;
;; [{:where (copyable? $t)}] is the opt-out from the other default. A type
;; variable is **move-only** until it says otherwise, because move is the
;; stricter rule and assuming it can only refuse a valid program rather than
;; admit a broken one: [reduce]'s accumulator is read into [f] and then
;; assigned again, which is correct at [i32] and a double move at [(Vec i32)],
;; and the checker cannot tell which until it substitutes. So the ones that
;; hold an element in a local say [copyable?] and the ones that only move
;; elements between slots do not.
;;
;; **What did not collapse, and why it should not.** [sum-i32] and [sum-f32]
;; widen their element into [i64] and [f64]; "the wider type $t accumulates
;; into" is a type-level function, which is a constraint system of a different
;; kind, and a generic [sum] that took its accumulator and its [+] would just
;; be [reduce]. [append-i64!] and [append-f64!] are two different primitives.
;; [sort-bytes!] needs [bytes<?] rather than [<] — a [[u8]] is not [ordered?]
;; and cannot be — so it is [sort-by!] with the comparison written in, and it
;; keeps its name because the stability contract in its comment is worth
;; keeping attached to something.
(defn swap! [s [$t] i i32 j i32] ()
{:where (copyable? $t)}
(let [t (at s i)]
(set (at s i) (at s j))
(set (at s j) t)))
(defn reverse-i32! [s [i32]] ()
(defn reverse! [s [$t]] ()
{:where (copyable? $t)}
(let [i 0
j (- (len s) 1)]
(while (< i j)
(swap-i32! s i j)
(swap! 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]] ()
;; Insertion sort: in place, no recursion, no auxiliary array — 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.
;;
;; One caveat that only arises at f32: **a NaN in the input makes the order
;; undefined.** Every comparison against a NaN is false, so the insertion loop
;; never moves one and never moves anything past one; what comes out is sorted
;; within each run between NaNs and not sorted across them. That is what C's
;; qsort with a naive comparator does too, and the only fix is not to have
;; NaNs in the array — there is no ordering of the reals a NaN sits anywhere
;; in.
(defn sort! [s [$t]] ()
{:where (ordered? $t)}
(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)
(swap! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
;; The same insertion sort, with the one comparison it had written in replaced
;; by the one it is told. before? answers "does a come before b", so passing
;; (fn [a b] (< a b)) is ascending and reversing it is descending — and a
;; caller wanting a key rather than an order writes the comparison.
;;
;; It is stable exactly as sort! is: the loop stops the moment before? says
;; no, so equal elements never swap past each other. A before? that is not a
;; strict weak ordering — one answering true for both (a b) and (b a) — is the
;; caller's mistake and shows up as an order, not as a loop: the inner while
;; is bounded by j reaching 0 whatever the comparison says.
;;
;; This one needs no [ordered?]: the comparison it cannot have is the
;; comparison it is given. It is the shape every generic had to take before
;; predicates existed, and it stays because passing a comparison is a real
;; thing to want and not only a workaround.
(defn sort-by! [s [$t] before? (Fn [$t $t] bool)] ()
{:where (copyable? $t)}
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
(swap! 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)
(defn index-of [s [$t] x $t] (Option i32)
{:where (equal? $t)}
(dotimes [i (len s)]
(when (= (at s i) x)
(return (Some i))))
@ -183,8 +255,16 @@ let source = {flan|
;; 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)
;; real element. A NaN in the input is not special-cased and propagates the
;; way it does through the builtins — the comparison fails, so the running
;; value simply does not change.
;;
;; Named min-of rather than min because [min] and [max] are builtins over two
;; or more numbers, and a defn cannot shadow a builtin: nothing shadows [+]
;; either. These reduce a slice, which is a different operation with a
;; different arity, so the different name is honest rather than a workaround.
(defn min-of [s [$t]] (Option $t)
{:where (ordered? $t)}
(if (= (len s) 0)
None
(let [m (at s 0)]
@ -192,7 +272,8 @@ let source = {flan|
(set m (min m (at s i))))
(Some m))))
(defn max-i32 [s [i32]] (Option i32)
(defn max-of [s [$t]] (Option $t)
{:where (ordered? $t)}
(if (= (len s) 0)
None
(let [m (at s 0)]
@ -200,6 +281,54 @@ let source = {flan|
(set m (max m (at s i))))
(Some m))))
;; map! writes back into the slice it was handed, for the same reason sort!
;; does — a slice is non-owning, and transforming a thing you already own
;; should not allocate. A map that produces a *different* element type is not
;; here: it is two type variables and a second signature, and nothing has
;; wanted it.
(defn map! [s [$t] f (Fn [$t] $t)] ()
{:where (copyable? $t)}
(dotimes [i (len s)]
(set (at s i) (f (at s i)))))
;; The general fold, of which sum-i32 is the special case with the + written
;; in. The accumulator comes first in the step, which is the order that reads
;; as (f acc x) and the order Odin's slice.reduce uses.
(defn reduce [s [$t] init $t f (Fn [$t $t] $t)] $t
{:where (copyable? $t)}
(let [acc init]
(dotimes [i (len s)]
(set acc (f acc (at s i))))
acc))
;; A new Vec holding the elements the predicate kept, in the order they were
;; in. Owned by the caller: (free v), or let a (free-all a) take the region.
;;
;; This is the one that proves the containers and the generics compose. It
;; allocates — (vec-new t), push, returns (Vec t) — and the type-erased Vec
;; runtime needed no change at all, because SizeOf and AlignOf are computed at
;; the instantiation site, where the element type is concrete.
(defn filter [s [$t] keep? (Fn [$t] bool)] (Vec $t)
{:where (copyable? $t)}
(let [v (vec-new t)]
(dotimes [i (len s)]
(when (keep? (at s i))
(push v (at s i))))
v))
;; ── The per-type layer that stays ─────────────────────────────────────
;;
;; sum is the one shape a type variable cannot express, and it is worth being
;; precise about why rather than leaving two near-identical functions looking
;; like an oversight. Each of these *widens*: sum-i32 accumulates in i64 and
;; sum-f32 in f64, with an explicit cast per element, because there is no
;; implicit widening anywhere in the language and summing a screenful into the
;; element's own type is how a total silently wraps or absorbs. "The wider
;; type $t accumulates into" is a function from types to types — an associated
;; type, or a constraint system of a kind {:where} is not — and a generic sum
;; that took its accumulator and its + as parameters would be reduce, which is
;; above.
;; 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.
@ -209,167 +338,19 @@ let source = {flan|
(set t (+ t (i64 (at s i)))))
t))
;; ── The same family over f32 ──────────────────────────────────────────
;;
;; sort-i32! was the only sort in the language, which is what NEXT.md's second
;; tier means by "a sort that is not integers-only". This is the second, and it
;; is a copy and not an abstraction — see the note above on why.
;;
;; One caveat that has no counterpart in the i32 family, because it cannot
;; arise there: **a NaN in the input makes the order undefined.** Every
;; comparison against a NaN is false, so the insertion loop never moves one and
;; never moves anything past one; what comes out is sorted within each run
;; between NaNs and not sorted across them. That is what C's qsort with a naive
;; comparator does too. The fix is not to have NaNs in the array — which is
;; also the only fix, since there is no ordering of the reals that a NaN sits
;; anywhere in.
(defn swap-f32! [s [f32] i i32 j i32] ()
(let [t (at s i)]
(set (at s i) (at s j))
(set (at s j) t)))
(defn reverse-f32! [s [f32]] ()
(let [i 0
j (- (len s) 1)]
(while (< i j)
(swap-f32! s i j)
(set i (+ i 1))
(set j (- j 1)))))
(defn sort-f32! [s [f32]] ()
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (> (at s (- j 1)) (at s j)))
(swap-f32! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
;; None for an empty slice, exactly as min-i32 does. A NaN in the input is not
;; special-cased and propagates the same way it does through the builtins: the
;; comparison fails, so the running value simply does not change.
(defn min-f32 [s [f32]] (Option f32)
(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-f32 [s [f32]] (Option f32)
(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 f64 and widens each element explicitly, which is sum-i32's
;; argument in its floating form and a stronger one: summing a screenful of f32
;; in f32 does not wrap, it *absorbs* — once the running total is large enough,
;; adding a small element rounds to no change at all, and the answer is silently
;; short rather than obviously wrong. An f64 accumulator has 29 more bits of
;; mantissa and pushes that failure out of reach of any array a game holds.
;; argument in its floating form and a stronger one: summing a screenful of
;; f32 in f32 does not wrap, it *absorbs* — once the running total is large
;; enough, adding a small element rounds to no change at all, and the answer
;; is silently short rather than obviously wrong. An f64 accumulator has 29
;; more bits of mantissa and pushes that failure out of reach of any array a
;; game holds.
(defn sum-f32 [s [f32]] f64
(let [t 0.0]
(dotimes [i (len s)]
(set t (+ t (f64 (at s i)))))
t))
;; ── The ones that take a function ─────────────────────────────────────
;;
;; map, filter, reduce and a comparator sort, which were the four the previous
;; tier could not write. The blocker was function values and not generics, and
;; the difference shows in what arrived and what did not: these take a
;; (Fn [T ...] R) as an ordinary parameter and needed nothing else, and they
;; are still one copy per element type because *that* is the generics half.
;;
;; Two rules, both inherited rather than invented here:
;;
;; 1. **The in-place ones stay in place.** map! writes back into the slice it
;; was handed, for the same reason sort-i32! does — a slice is non-owning,
;; and transforming a thing you already own should not allocate. A map that
;; produces a *different* element type is not here: it would be one copy per
;; ordered pair of types, which is the point at which a per-type family
;; stops being honest.
;; 2. **filter allocates and the caller frees**, like everything in the
;; building tier: (free v), or let a (free-all a) take the region.
;;
;; The function is passed by name — this is a Lisp-1, so a bare defn name is
;; the function — or written inline as an (fn [x] ...), whose parameter types
;; come from the parameter it is being passed to. It may not capture: an fn is
;; lifted into a function of its own and sees its parameters and the globals
;; and nothing else.
(defn map-i32! [s [i32] f (Fn [i32] i32)] ()
(dotimes [i (len s)]
(set (at s i) (f (at s i)))))
(defn map-f32! [s [f32] f (Fn [f32] f32)] ()
(dotimes [i (len s)]
(set (at s i) (f (at s i)))))
;; The general fold, of which sum-i32 is the special case with the + written
;; in. The accumulator comes first in the step, which is the order that reads
;; as (f acc x) and the order Odin's slice.reduce uses.
(defn reduce-i32 [s [i32] init i32 f (Fn [i32 i32] i32)] i32
(let [acc init]
(dotimes [i (len s)]
(set acc (f acc (at s i))))
acc))
(defn reduce-f32 [s [f32] init f32 f (Fn [f32 f32] f32)] f32
(let [acc init]
(dotimes [i (len s)]
(set acc (f acc (at s i))))
acc))
;; A new Vec holding the elements the predicate kept, in the order they were
;; in. Owned by the caller.
(defn filter-i32 [s [i32] keep? (Fn [i32] bool)] (Vec i32)
(let [v (vec-new i32)]
(dotimes [i (len s)]
(when (keep? (at s i))
(push v (at s i))))
v))
(defn filter-f32 [s [f32] keep? (Fn [f32] bool)] (Vec f32)
(let [v (vec-new f32)]
(dotimes [i (len s)]
(when (keep? (at s i))
(push v (at s i))))
v))
;; The same insertion sort sort-i32! is, with the one comparison it had written
;; in replaced by the one it is told. before? answers "does a come before b",
;; so passing (fn [a b] (< a b)) is ascending and reversing it is descending —
;; and a caller wanting a key rather than an order writes the comparison.
;;
;; It is stable exactly as sort-i32! is: the loop stops the moment before? says
;; no, so equal elements never swap past each other. A before? that is not a
;; strict weak ordering — one answering true for both (a b) and (b a) — is the
;; caller's mistake and shows up as an order, not as a loop: the inner while is
;; bounded by j reaching 0 whatever the comparison says.
(defn sort-i32-by! [s [i32] before? (Fn [i32 i32] bool)] ()
(let [i 1]
(while (< i (len s))
(let [j i]
;; `and` short-circuits, so (at s -1) is never evaluated at j = 0.
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
(swap-i32! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
(defn sort-f32-by! [s [f32] before? (Fn [f32 f32] bool)] ()
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
(swap-f32! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
;; ── Bytes ─────────────────────────────────────────────────────────────
;;
;; Over [u8] and not over string, so (bytes s) is what a caller writes and one
@ -397,12 +378,6 @@ let source = {flan|
(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
@ -868,7 +843,7 @@ let source = {flan|
;; How many bytes this code point encodes to, or None if it is not a scalar
;; value. Odin's rune_size answers -1 for the refusals; a sentinel index is
;; exactly what index-of-i32 avoids above, so this is an Option like the rest
;; exactly what index-of avoids above, so this is an Option like the rest
;; of the file.
(defn rune-size [code i32] (Option i32)
(cond
@ -944,7 +919,7 @@ let source = {flan|
(defn split-next! [it (Ptr Split)] (Option [u8])
(when (not (.more it))
(return None))
(match (index-of-byte (.rest it) (.sep it))
(match (index-of (.rest it) (.sep it))
(Some i)
(let [field (slice (.rest it) 0 i)]
(set (.rest it) (slice (.rest it) (+ i 1) (len (.rest it))))
@ -1030,24 +1005,20 @@ let source = {flan|
(return (< (at a i) (at b i)))))
(< (len a) (len b))))
(defn swap-bytes! [s [[u8]] i i32 j i32] ()
(let [t (at s i)]
(set (at s i) (at s j))
(set (at s j) t)))
;; The same insertion sort as sort-i32!, over the same in-place contract: the
;; *slices* move, never the bytes they point at, so this sorts a [[u8]] of
;; sort-by! with the comparison written in, over the same in-place contract:
;; the *slices* move, never the bytes they point at, so this sorts a [[u8]] of
;; fields borrowed from one buffer without touching the buffer. Stable, and
;; here that is observable — two equal fields are two distinct slices of
;; different parts of the input, and a caller can see which one came first.
;;
;; It keeps a name of its own rather than collapsing into sort!, and the
;; reason is the point of the predicates: a [u8] is not ordered? and cannot
;; be, because < is defined on machine numbers and comparing two slices
;; lexicographically is a loop and not an instruction. bytes<? is that loop.
;; So this is the shape a generic takes when the operation it needs is not a
;; primitive: pass it in.
(defn sort-bytes! [s [[u8]]] ()
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (bytes<? (at s j) (at s (- j 1))))
(swap-bytes! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
(sort-by! s (fn [a b] (bytes<? a b))))
;; ── Building bytes, which is the tier that needed an allocator ────────
;;

26
test/programs/algorithms.flan
View File

@ -1,6 +1,6 @@
;;;; 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
;;;; 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
@ -22,55 +22,55 @@
(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
;; so [3.5 -1.0] is an [f64] and (sort!) 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
;; 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-f32! (slice xs 0 7))
(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-f32! (slice xs 1 5))
(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-f32! (slice xs 0 3))
(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-f32! (slice xs 0 3))
(sort! (slice xs 0 3))
(show-f32 (slice xs 0 3))) ; 1 2 3
(let [xs [(f32 7.0)]]
(sort-f32! (slice xs 0 1))
(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-f32! (slice xs 0 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-f32! (slice xs 0 4))
(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-f32 (slice xs 0 3)) (Some m) (print m) None (print "none"))
(match (min-of (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"))
(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-f32 (slice xs 0 0)) (Some m) (print m) None (print "none"))
(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

10
test/programs/fn-values.flan
View File

@ -23,11 +23,11 @@
;; A comparator, which is the other half of what was blocked: a sort that is
;; told the order rather than having it written in. Insertion sort, because the
;; point here is the parameter and not the algorithm.
(defn sort-by! [xs [i32] before? (Fn [i32 i32] bool)] ()
(defn insertion-by! [xs [i32] before? (Fn [i32 i32] bool)] ()
(dotimes [i (len xs)]
(let [j i]
(while (and (> j 0) (before? (at xs j) (at xs (- j 1))))
(swap-i32! xs j (- j 1))
(swap! xs j (- j 1))
(set j (- j 1))))))
(defn ascending [a i32 b i32] bool (< a b))
@ -75,12 +75,12 @@
;; A comparator, and the same slice sorted both ways.
(let [ys [3 1 4 1 5 9 2 6]
s (slice ys 0 8)]
(sort-by! s ascending)
(insertion-by! s ascending)
(print (at s 0)) (print " ") (print (at s 7)) (println "")
(sort-by! s descending)
(insertion-by! s descending)
(print (at s 0)) (print " ") (print (at s 7)) (println "")
;; A returned function value, and a computed head calling it.
(sort-by! s (pick true))
(insertion-by! s (pick true))
(print (at s 0)) (println "")
(println ((pick false) 1 2)))

15
test/programs/generic-reject.flan Normal file
View File

@ -0,0 +1,15 @@
;;;; The refusal, at the definition and not at a call site.
;;;;
;;;; A generic body is checked once with its type variables abstract, so an
;;;; operator the variable is not declared to support is refused here, naming
;;;; the variable — rather than at whichever call site first instantiated it
;;;; at a type that did not work. That is not Odin's model: Odin checks a
;;;; polymorphic body only per instantiation, so (+ a b) over a $T compiles
;;;; there and fails only if someone reaches it at a type without +.
;;;;
;;;; The way out is either predicate — {:where (numeric? $t)} — or the
;;;; parameter, a (Fn [$t $t] $t) the caller supplies. Neither is written
;;;; here, which is the point.
(defn add2 [a $t b $t] $t (+ a b))
(defn main [] () (println (add2 1 2)))

10
test/programs/generic-runaway.flan Normal file
View File

@ -0,0 +1,10 @@
;;;; A generic that instantiates itself at a larger type every time.
;;;;
;;;; (grow [x x]) asks for a copy at [t], which asks for one at [[t]],
;;;; forever. Before the refusal this did not fail, it *hung*, and since
;;;; Session.eval runs the same code the thing that hung was C-c C-c with the
;;;; dev daemon wedged behind it. The refusal names the chain of
;;;; instantiations rather than a depth it gave up at.
(defn grow [x $t] () {:where (copyable? $t)} (grow [x x]))
(defn main [] () (grow 1))

105
test/programs/generics.flan Normal file
View File

@ -0,0 +1,105 @@
;;;; Generics by monomorphisation, end to end.
;;;;
;;;; A [$t] binds a type variable in a defn signature and every call site
;;;; instantiates the body at the types it passes. The body is checked once
;;;; *abstractly*, with nothing substituted, so an operator the variable is
;;;; not declared to support is refused at the definition and not at whichever
;;;; call site happened to reach a type that worked — see generic-reject.flan
;;;; and generic-runaway.flan for that half.
;;;;
;;;; What this program is asserting, in order: one variable at several types,
;;;; a variable bound inside a slice, a generic calling a generic at its own
;;;; variable so that instantiation has to be transitive, the four where
;;;; predicates, two variables at once, println deferred to the instantiation,
;;;; and the collapsed prelude family the whole feature was for.
;; One variable, several types, and (ident 3) and (ident 7) share one copy.
;; The identity needs its parameter once, so it needs nothing declared: a type
;; variable is move-only by default and one move is what this is.
(defn ident [x $t] $t x)
;; The variable is bound *inside* a type constructor, which is a structural
;; walk rather than a name match.
(defn first-or [s [$t] d $t] $t
{:where (copyable? $t)}
(if (= (len s) 0) d (at s 0)))
;; A generic calling a generic at its own variable: the copy of [swap!] is
;; generated when [rotate!] is instantiated and not before.
(defn rotate! [s [$t]] ()
{:where (copyable? $t)}
(dotimes [i (- (len s) 1)]
(swap! s i (+ i 1))))
;; numeric? admits + - * / %.
(defn twice [x $t] $t
{:where (numeric? $t)}
(+ x x))
;; equal? admits = and !=; ordered? admits < <= > >= min max, and entails
;; equal? and copyable?.
(defn count-of [s [$t] x $t] i32
{:where (equal? $t)}
(let [n 0]
(dotimes [i (len s)]
(when (= (at s i) x)
(set n (+ n 1))))
n))
(defn clamp-to [x $t lo $t hi $t] $t
{:where (ordered? $t)}
(min (max x lo) hi))
;; Two variables, and the second is determined by its own argument.
(defn fst [a $t b $u] $t
{:where [(copyable? $t) (copyable? $u)]}
(do b a))
;; println over a type variable is the one form the abstract pass defers to
;; the instantiation, because its legality is only decidable after
;; substituting. The structural printer is selected per copy.
(defn show [x $t] ()
{:where (copyable? $t)}
(println x))
(defn main [] ()
(println (ident 3))
(println (ident 4.5))
(println (ident true))
(println (ident 7))
(let [ns [5 3 9 1]
fs [2.5 0.5 1.5]]
(println (first-or (slice ns 0 4) -1))
(println (first-or (slice ns 0 0) -1))
(rotate! (slice ns 0 4))
(println (at ns 3))
(println (twice 21))
(println (twice 1.5))
(println (count-of (slice ns 0 4) 9))
(println (clamp-to 12 0 10))
(println (clamp-to 0.5 1.0 9.0))
(println (fst 8 true))
(show 3)
(show 4.5)
(show "text")
;; The collapsed prelude family, at both element types.
(sort! (slice ns 0 4))
(println (at ns 0))
(sort-by! (slice fs 0 3) (fn [a b] (> a b)))
(println (at fs 0))
(reverse! (slice ns 0 4))
(println (at ns 0))
(map! (slice ns 0 4) (fn [x] (* x 2)))
(println (reduce (slice ns 0 4) 0 (fn [a b] (+ a b))))
(match (min-of (slice ns 0 4)) (Some m) (println m) _ (println -1))
(match (max-of (slice fs 0 3)) (Some m) (println m) _ (println -1.0))
(match (index-of (slice ns 0 4) 18) (Some i) (println i) _ (println -1))
(let [a (arena-new 4096)
keep (filter (slice ns 0 4) (fn [x] (> x 5)))]
(println (len (as-slice keep)))
(free keep)
(free-all a))))

20
test/programs/higher-order.flan
View File

@ -15,36 +15,36 @@
;; map! writes back into the slice it was handed.
(let [xs [1 2 3 4]
s (slice xs 0 4)]
(map-i32! s triple)
(map! s triple)
(print (at s 0)) (print " ") (print (at s 3)) (println "")
;; reduce, with the accumulator first in the step. The prelude's own
;; sum-i32 is this with the + written in.
(print (reduce-i32 s 0 adds)) (println "")
(print (reduce s 0 adds)) (println "")
;; ... and an fn literal, whose parameter types come from the parameter.
(print (reduce-i32 s 1 (fn [a b] (* a b)))) (println "")
(print (reduce s 1 (fn [a b] (* a b)))) (println "")
;; filter allocates and the caller frees.
(let [v (filter-i32 s odd?)]
(let [v (filter s odd?)]
(print (len v)) (print " ") (print (at v 0)) (println "")
(free v))
;; A comparator sort, both directions off the same slice.
(sort-i32-by! s longer-first)
(sort-by! s longer-first)
(print (at s 0)) (print " ") (print (at s 3)) (println "")
(sort-i32-by! s (fn [a b] (< a b)))
(sort-by! s (fn [a b] (< a b)))
(print (at s 0)) (print " ") (print (at s 3)) (println ""))
;; The f32 half of the family, which is the same code at the other element
;; type — the copy that generics would remove.
(let [ys [(f32 4.0) (f32 1.0) (f32 8.0) (f32 2.0)]
t (slice ys 0 4)]
(map-f32! t halve)
(map! t halve)
(print (at t 0)) (print " ") (print (at t 2)) (println "")
(print (reduce-f32 t 0.0 (fn [a b] (+ a b)))) (println "")
(let [w (filter-f32 t big?)]
(print (reduce t 0.0 (fn [a b] (+ a b)))) (println "")
(let [w (filter t big?)]
(print (len w)) (println "")
(free w))
(sort-f32-by! t (fn [a b] (> a b)))
(sort-by! t (fn [a b] (> a b)))
(print (at t 0)) (print " ") (print (at t 3)) (println ""))
0)

6
test/programs/reach-walk.flan
View File

@ -7,7 +7,7 @@
;;;; functions below is called from exactly one place, and that place is an
;;;; edge no other program in the corpus exercises:
;;;;
;;;; index-of the index expression of a place, (set (at a (f)) v)
;;;; index-expr the index expression of a place, (set (at a (f)) v)
;;;; through a place under (addr ...), here a (deref ...) so that it is
;;;; the addr edge and not the index one again
;;;; placeholder a restart-case clause body, which is reached by a transfer
@ -21,7 +21,7 @@
(defstruct Nope [id i32])
(defn index-of [] i32 2)
(defn index-expr [] i32 2)
(defn through [] (Ptr i32) (addr slot))
@ -37,7 +37,7 @@
(defn main [] i32
;; The index of a place is an expression, and it can call.
(set (at cells (index-of)) 10)
(set (at cells (index-expr)) 10)
(print (at cells 2)) (println "")
;; (addr (deref p)) is p, so this is the addr edge over a place whose own

28
test/programs/slices.flan
View File

@ -36,47 +36,47 @@
;; Reading the whole slice, before anything reorders it.
(print (sum-i32 (slice xs 0 (len xs)))) (println "") ; 23
(print (match (min-i32 (slice xs 0 (len xs))) (Some v) v None 99))
(print (match (min-of (slice xs 0 (len xs))) (Some v) v None 99))
(println "") ; -3
(print (match (max-i32 (slice xs 0 (len xs))) (Some v) v None 99))
(print (match (max-of (slice xs 0 (len xs))) (Some v) v None 99))
(println "") ; 12
;; First index, not the last: 5 appears at 0 and at 2.
(print (match (index-of-i32 (slice xs 0 (len xs)) 5) (Some v) v None -1))
(print (match (index-of (slice xs 0 (len xs)) 5) (Some v) v None -1))
(println "") ; 0
(print (match (index-of-i32 (slice xs 0 (len xs)) 4) (Some v) v None -1))
(print (match (index-of (slice xs 0 (len xs)) 4) (Some v) v None -1))
(println "") ; -1
;; An empty slice has no least element, and None is the answer.
(print (match (min-i32 (slice xs 3 3)) (Some v) v None 99))
(print (match (min-of (slice xs 3 3)) (Some v) v None 99))
(println "") ; 99
;; Reverse of an odd-length slice: the middle element stays put.
(reverse-i32! (slice xs 0 (len xs)))
(reverse! (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))
(reverse! (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)))
(sort! (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)))
(sort! (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))
(sort! (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))
(sort! (slice zs 0 0))
(reverse! (slice zs 0 0))
(sort! (slice zs 2 3))
(reverse! (slice zs 2 3))
(show (slice zs 0 (len zs))) ; 100 -1 0 4 9 9 200 300
0)

6
test/programs/text.flan
View File

@ -31,11 +31,11 @@
(println "")
;; First occurrence, and None for a byte that is not there.
(print (match (index-of-byte (bytes "banana") \a) (Some i) i None -1))
(print (match (index-of (bytes "banana") \a) (Some i) i None -1))
(print " ")
(print (match (index-of-byte (bytes "banana") \z) (Some i) i None -1))
(print (match (index-of (bytes "banana") \z) (Some i) i None -1))
(print " ")
(print (match (index-of-byte (bytes "") \a) (Some i) i None -1))
(print (match (index-of (bytes "") \a) (Some i) i None -1))
(println "")
;; Accepted.

25
test/test_acceptance.ml
View File

@ -1320,6 +1320,13 @@ let () =
outputs "a local shadows an imported name" "programs/pkg-shadow.flan"
"7\n20\n0\n5\n";
(* Generics end to end: one written body per family, several emitted, and
the collapsed prelude running underneath it. Every line of the expected
output is an answer a per-type copy used to give. *)
let generics_out = "3\n4.5\ntrue\n7\n5\n-1\n5\n42\n3\n1\n10\n1\n8\n3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\n3\n" in
outputs "generics" "programs/generics.flan" generics_out;
outputs ~opt:"-O0" "generics, -O0" "programs/generics.flan" generics_out;
(* Reach's walk, edge by edge. Pruning is what makes the link follow the
program, and the cost of getting it wrong is not a wrong answer: a
function the walk fails to reach is not emitted, and the build dies in
@ -1368,6 +1375,24 @@ let () =
in
(* Visibility: main is not a name a package offers, and saying so is the
point — "unknown name sand/main" would be true and useless. *)
(* Generics, at the definition rather than at a call site. Both of these
are refusals the abstract pass exists for: the body is checked once
with its type variables left abstract, so an operator the variable was
not declared to support, and an instantiation that grows without end,
are both answered where they are written. The second one used to *hang*
rather than fail, which through Session.eval is C-c C-c hanging with
the dev daemon behind it — so what is asserted is that it names the
chain of instantiations and not a depth it gave up at. *)
refuses "an unconstrained operator in a generic body"
"programs/generic-reject.flan"
"only what it is declared to support";
refuses "an unconstrained operator names the way out"
"programs/generic-reject.flan" "{:where (numeric? $t)}";
refuses "a runaway instantiation" "programs/generic-runaway.flan"
"instantiates itself without end";
refuses "a runaway instantiation names the chain"
"programs/generic-runaway.flan" "grow at ([2 i32])";
refuses "a package's main is not visible" "programs/pkg-hidden-main.flan"
"sand/main is not a name";
refuses "one directory under two aliases" "programs/pkg-two-aliases.flan"

80
test/test_flan.ml
View File

@ -2118,6 +2118,86 @@ let () =
| [] -> check "a report has a first line" false)
| None -> check "a report needs a diagnostic" false);
(* ── Generics: the syntax, the predicates, and the two defaults ──
The syntax question the feature had to settle first: [{K V}] is a legal
*return type*, so a defn with a map return type and a constraint map puts
two braces in a row meaning different things. They are told apart
structurally, by the first form inside — a constraint map leads with a
keyword and a map type leads with a type — so [{K V}] did not have to go
and is still exactly what it was. *)
accepts "a map return type is still a map return type"
"(defn f [] {string i32} (map-new string i32))";
accepts "a map return type followed by a constraint map"
"(defn f [x $t] {string i32} {:where (copyable? $t)} \
(do x (map-new string i32)))";
rejects_check "a map return type is not read as a constraint map"
~needle:"is not a type variable of f"
"(defn f [] {string i32} {:where (ordered? $t)} (map-new string i32))";
(* The predicates, and each one gating the operator it is for. *)
accepts "ordered? admits <"
"(defn less [a $t b $t] bool {:where (ordered? $t)} (< a b))";
accepts "equal? admits ="
"(defn same [a $t b $t] bool {:where (equal? $t)} (= a b))";
accepts "numeric? admits +"
"(defn add [a $t b $t] $t {:where (numeric? $t)} (+ a b))";
rejects_check "equal? does not admit <"
~needle:"nothing here says t is ordered?"
"(defn less [a $t b $t] bool {:where (equal? $t)} (< a b))";
(* The entailments, which are the reason a signature is one predicate long
rather than three. Every type the language orders is a number or an enum,
so it is equatable and it is not move-only. *)
accepts "ordered? entails equal?"
"(defn same [a $t b $t] bool {:where (ordered? $t)} (= a b))";
accepts "numeric? entails ordered?"
"(defn less [a $t b $t] bool {:where (numeric? $t)} (< a b))";
accepts "ordered? entails copyable?"
"(defn twice [a $t] bool {:where (ordered? $t)} (< a a))";
rejects_check "a predicate nobody has heard of"
~needle:"is not a type predicate"
"(defn f [a $t] $t {:where (sortable? $t)} a)";
rejects_check "a predicate about a variable the signature never bound"
~needle:"is not a type variable of f"
"(defn f [a i32] i32 {:where (ordered? $t)} a)";
(* Move-only by default, which is the other half of the where clause and the
one with no Odin counterpart: Odin has no move semantics, so its $T never
has to answer. The prior art is Rust's T: Copy, and the difference is
that copyable? is a question the compiler answers rather than a trait a
user implements. Conservative in the safe direction — move is the
stricter rule, so assuming it can only refuse a valid program. *)
rejects_check "a type variable is move-only until it says otherwise"
~needle:"cannot be used again"
"(defn twice [a $t b (Fn [$t $t] $t)] $t (b a a))";
accepts "and copyable? is the opt-out"
"(defn twice [a $t b (Fn [$t $t] $t)] $t {:where (copyable? $t)} (b a a))";
(* The allow-list, and it has two members. println over a type variable is
deferred to the instantiation, because its legality is only decidable
after substituting — which is the one thing the abstract pass otherwise
refuses to do. *)
accepts "println over a type variable is deferred"
"(defn show [x $t] () {:where (copyable? $t)} (println x))";
accepts "and so is print"
"(defn show [x $t] () {:where (copyable? $t)} (print x))";
(* A predicate a body relies on has to be carried by every signature between
it and the call site, or the refusal moves into code the caller did not
write. *)
rejects_check "a predicate is not carried through a generic call"
~needle:"has to be carried by every signature"
"(defn outer [s [$t]] () {:where (copyable? $t)} (sort! s))";
accepts "and is accepted when it is"
"(defn outer [s [$t]] () {:where (ordered? $t)} (sort! s))";
(* A map key that is a type variable has no hash and no equality to emit:
they are chosen from the concrete type, which does not exist yet. *)
rejects_check "a map keyed by a type variable that is not hashable?"
~needle:"is not a map key"
"(defn f [m {$t i32}] i32 {:where (copyable? $t)} (len m))";
accepts "and hashable? is what says it is"
"(defn f [m {$t i32}] i32 {:where (hashable? $t)} (len m))";
(* ── The acceptance program checks end to end ──────────────────── *)
accepts "calc-me.flan type checks"
(In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);

2
vendor/edn/edn.flan vendored
View File

@ -320,7 +320,7 @@
;; A ratio is caught here and not by a "contains a slash" rule over every
;; token, because a slash is perfectly ordinary in a symbol: foo/bar is a
;; namespaced name and must stay one.
(when (match (index-of-byte text \/) (Some _) true None false)
(when (match (index-of text \/) (Some _) true None false)
(fail c err-ratio lo)
(return (error-token c)))
(when (match (parse-i64 text) (Some _) true None false)

4
web/examples/option.flan
View File

@ -2,12 +2,12 @@
;; `some` unwraps Some and early-returns None from *this* function.
(defn doubled-first [s [i32]] (Option i32)
(Some (* 2 (some (index-of-i32 s 15)))))
(Some (* 2 (some (index-of s 15)))))
(defn main [] ()
(match (doubled-first (slice nums 0 4))
(Some i) (do (print i) (println "")) ; 4
None (println "not found"))
(match (index-of-i32 (slice nums 0 4) 99)
(match (index-of (slice nums 0 4) 99)
(Some i) (do (print i) (println ""))
None (println "not found")))