From dad725afe477747a5768ae9e35e199cff1b0614c Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 14:49:11 +0700 Subject: [PATCH] The prelude's per-type families collapse: 22 functions become 10, 27 become 16 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 () + | 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))) diff --git a/lib/prelude.ml b/lib/prelude.ml index 4184cb5..553014f 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -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 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 j 0) (bytes 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))) diff --git a/test/programs/generic-reject.flan b/test/programs/generic-reject.flan new file mode 100644 index 0000000..82d848e --- /dev/null +++ b/test/programs/generic-reject.flan @@ -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))) diff --git a/test/programs/generic-runaway.flan b/test/programs/generic-runaway.flan new file mode 100644 index 0000000..a124b36 --- /dev/null +++ b/test/programs/generic-runaway.flan @@ -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)) diff --git a/test/programs/generics.flan b/test/programs/generics.flan new file mode 100644 index 0000000..44d4220 --- /dev/null +++ b/test/programs/generics.flan @@ -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)))) diff --git a/test/programs/higher-order.flan b/test/programs/higher-order.flan index 08db084..e0cea10 100644 --- a/test/programs/higher-order.flan +++ b/test/programs/higher-order.flan @@ -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) diff --git a/test/programs/reach-walk.flan b/test/programs/reach-walk.flan index 0a35f50..3561167 100644 --- a/test/programs/reach-walk.flan +++ b/test/programs/reach-walk.flan @@ -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 diff --git a/test/programs/slices.flan b/test/programs/slices.flan index ad66103..f96ada3 100644 --- a/test/programs/slices.flan +++ b/test/programs/slices.flan @@ -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) diff --git a/test/programs/text.flan b/test/programs/text.flan index 5ca88ec..1c93790 100644 --- a/test/programs/text.flan +++ b/test/programs/text.flan @@ -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. diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 3d7e17e..7351bce 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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" diff --git a/test/test_flan.ml b/test/test_flan.ml index 1cff6c9..679b673 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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); diff --git a/vendor/edn/edn.flan b/vendor/edn/edn.flan index c12af96..e1efbf4 100644 --- a/vendor/edn/edn.flan +++ b/vendor/edn/edn.flan @@ -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) diff --git a/web/examples/option.flan b/web/examples/option.flan index ea8ea91..813d419 100644 --- a/web/examples/option.flan +++ b/web/examples/option.flan @@ -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")))