From 482b869835b6c175a1b5bd805bf4b322c2306f7b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Mon, 21 Sep 2026 09:46:53 +0700 Subject: [PATCH] Three membership tests asked the name as written, and one carries a sigil (vec-new $t) in a generic body was refused as if it had said nothing about its element type. The feature was not missing: env.tyvars and env.subst are keyed on the bare name, and type_named and the cast arm asked them of the name as written, so the spelling with the sigil fell past the guard into the no-element-type message. (vec-new t) had always worked. One helper the three of them share, beside resolve_name, which already stripped for itself. A sigil on a name nothing binds reaches resolve_name now too, so it is answered as the unbound variable it is. --- FIX.org | 54 +++++++++++++++ lib/check.ml | 48 +++++++++---- test/programs/generic-alloc.flan | 112 +++++++++++++++++++++++++++++++ test/test_acceptance.ml | 13 ++++ test/test_flan.ml | 30 +++++++++ 5 files changed, 244 insertions(+), 13 deletions(-) create mode 100644 test/programs/generic-alloc.flan diff --git a/FIX.org b/FIX.org index ded3757..7cbde82 100644 --- a/FIX.org +++ b/FIX.org @@ -4734,3 +4734,57 @@ So it is gone, with the call respelled, at the merge: sand.flan:121 says ~:log-warning~, the ~warning 4~ member and its paragraph are out of raylib.flan, and the ~constant~ line is out of bindings. Every member of every mapped enum now carries its prefix, with no exception. + +* Generic allocation, 2026-09-21 — the sigil, not the feature +Reported as "generic code cannot allocate a container of its own element type": +(vec-new $t) inside a generic body was refused with "nothing here says what +(vec-new) is a Vec of". + +The feature was already there. [type_named] and the cast arm asked +[List.mem n env.tyvars] / [List.mem_assoc n env.subst] of the name as *written*, +and those two tables are keyed on the *bare* name — [signature_tyvars] strips +the sigil when it records a variable, and [resolve_name] strips it again when +it answers one. So [(vec-new t)] worked and had worked since generics landed — +generics.flan's [one-of] and [bump] are written that way — and [(vec-new $t)] +fell past the guard into the no-element-type message, which then described a +missing annotation for a body that had written one. + +Three membership tests, one helper: [tyvar_bare] and [tyvar_in_scope] near +[resolve_name], used by [type_named] (which fronts vec-new and map-new) and by +the cast arm. [resolve_name] uses [tyvar_bare] for its own strip, so there is +one place that knows what the character means. A sigil on a name nothing binds +now reaches [resolve_name] too, so [(vec-new $u)] says the variable has no +binding site rather than blaming the element type. + +Already fine, both spellings: [(array n $t)], [(zeroed)], [(Some x)], +[(Option $t)], [(Ptr $t)], a [(Vec $t)] return, a [(Map $t i32)] parameter — +every type *position* goes through [resolve], which has always stripped. A +local declared [(Vec $t)] is not a thing in the language: parse gives a let +binding no type slot. + +Broken and fixed: [(vec-new $t)], [(vec-new $t a)], [(map-new $k $v)], +[(map-new $k $v a)], [($t x)]. + +Size and alignment come from the copy: the i32 instantiation of [sorted] emits +flan_vec_init with 4/4 and the f64 one with 8/8, and flan_dev_reg_note_vec +with 4 and 8. The abstract pass holds [Var t] and is never emitted — emit.ml +has no layout for a Var and would die if it were. Instantiated at dyn the copy +takes flan_dyn_vec_new and flan_dyn_push with the roots pushed, because the +substitution happens before the element type is looked at. + +test/programs/generic-alloc.flan is the motivating program end to end; +x86 matches LLVM on it. + +docs/SPIKE-GENERICS.md already specified this — "Both spellings are accepted +at a use" — so the doc was right and check.ml was the divergence. No doc +change; the tests are what now hold the claim up. + +Left: (vec-new $t a) instantiated at dyn is refused — "(vec-new dyn) takes no +allocator" — and the refusal lands on the generic body, at the line that wrote +[$t a], not at the call site that chose dyn. That is right as a decision and +thin as a message: the source says [$t] and the message says [dyn] with +nothing between them. Naming the instantiation would need the substitution +threaded into it; not done here. + +Also left: docs/SPIKE-GENERICS.md still lists map-new, zeroed and the casts +under "Mechanical" as remaining work. They landed. diff --git a/lib/check.ml b/lib/check.ml index 1dd2449..619095b 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -911,6 +911,25 @@ let rec unfillable env seen (t : Types.t) : Types.t option = | None -> Some t) | _ -> Some t +(* The name under the sigil. [$t] is how a defn signature introduces a type + variable and [t] is how the body spells the same one, so the tables that + record which variables are in scope — [env.tyvars] and [env.subst] — are + keyed on the bare name and every membership test has to strip first. A name + with no sigil is its own bare name. *) +let tyvar_bare n = + if n <> "" && n.[0] = '$' then String.sub n 1 (String.length n - 1) else n + +(* Is this name, as written, a type variable that is in scope here? Both + spellings answer yes, because both denote the same variable: the sigil is + the binding site's and is redundant rather than wrong in the body. Every + test against [tyvars] or [subst] goes through this, so a caller cannot ask + the question of the raw name and miss the spelling with the sigil — which is + what made [(vec-new $t)] report a missing element type for a body that had + written one. *) +let tyvar_in_scope env n = + let bare = tyvar_bare n in + List.mem bare env.tyvars || List.mem_assoc bare env.subst + let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = let loc = t.Ast.tloc in match t.Ast.t with @@ -1012,7 +1031,7 @@ and resolve_name env ~seen loc n = unknown-type error it always was. That is the point of the sigil: without one, a mistyped type name silently became a type parameter and made the function more permissive than it was written to be. *) - let bare = if n <> "" && n.[0] = '$' then String.sub n 1 (String.length n - 1) else n in + let bare = tyvar_bare n in match List.assoc_opt bare env.subst with (* Inside an instantiation: the variable is this concrete type, and every node checked under it is as concrete as if it had been written out. *) @@ -5906,12 +5925,16 @@ and file_guard ctx loc ~path_slot ~op mk_steps = them. *) and type_named ctx n = (* A type variable names a type here too, which is what lets [(vec-new t)] - be written in a generic body: inside an instantiation [resolve_name] - answers with the concrete element type, and during the abstract pass it - answers [Var t] and the [Vec] that comes back is a [(Vec t)] — generic, - and refused by anything that needs a size. *) - List.mem n ctx.env.tyvars - || List.mem_assoc n ctx.env.subst + and [(vec-new $t)] be written in a generic body: inside an instantiation + [resolve_name] answers with the concrete element type, and during the + abstract pass it answers [Var t] and the [Vec] that comes back is a + [(Vec t)] — generic, and refused by anything that needs a size. *) + tyvar_in_scope ctx.env n + (* A sigil is only ever written where a type goes, so a name carrying one is + answered here even when nothing binds it: [resolve_name] then says that a + variable has no binding site outside a defn signature, which is the + mistake, instead of this form reporting a missing element type. *) + || n <> tyvar_bare n || List.mem n Types.primitive_names || Hashtbl.mem ctx.env.structs n || Hashtbl.mem ctx.env.datas n @@ -7998,18 +8021,17 @@ and named_call ?(qualified = false) ctx ~want loc name args = float goes through (i32 x) first" name (Types.to_string other)); prim (Tast.Cast target) target [ a ] - (* A cast to a *type variable*: [(t x)] inside a generic body. The name is - not one [is_cast] knows, because [is_cast] asks whether the name is a - machine type and [t] is not — so this is its own arm, above the ordinary - one and below the enums, and it reaches the same [Cast] prim. + (* A cast to a *type variable*: [(t x)] or [($t x)] inside a generic body. + The name is not one [is_cast] knows, because [is_cast] asks whether the + name is a machine type and [t] is not — so this is its own arm, above the + ordinary one and below the enums, and it reaches the same [Cast] prim. Inside an instantiation [resolve_name] has already answered with the concrete target, so the copy casts to a real type and the emitter sees nothing unusual. During the abstract pass the target is [Var t] and the [where] clause is what says the cast means anything at all: a cast produces a number, so [numeric?] is what admits it. *) - | _ when (List.mem name ctx.env.tyvars || List.mem_assoc name ctx.env.subst) - && List.length args = 1 -> + | _ when tyvar_in_scope ctx.env name && List.length args = 1 -> let target = resolve_name ctx.env ~seen:[] loc name in unconstrained ctx.env loc ("a cast to " ^ name) ~needs:"numeric?" target; let a = check ctx (List.hd args) in diff --git a/test/programs/generic-alloc.flan b/test/programs/generic-alloc.flan new file mode 100644 index 0000000..38c3851 --- /dev/null +++ b/test/programs/generic-alloc.flan @@ -0,0 +1,112 @@ +;;;; A generic body that allocates a container of its own element type. +;;;; +;;;; The caller-allocated spelling — the caller passes a destination slice and +;;;; the callee fills it — is the one a generic could always write. This is the +;;;; other half: [sorted] below asks for the storage itself, at whatever type +;;;; the instantiation turned out to be, and hands the container back. +;;;; +;;;; What makes that work is that a type variable names a type wherever a type +;;;; name goes, in both spellings: [$t] is how a defn signature introduces the +;;;; variable and [t] is how the body spells the same one, and the constructors +;;;; that read a type argument — vec-new, map-new, array, a cast — accept +;;;; either. The size and the alignment flan_vec_init is given are produced +;;;; from the element type at the point the copy is checked, so each copy +;;;; carries its own: 4 and 4 in the i32 one, 8 and 8 in the f64 one. The +;;;; abstract pass, which checks the body once with nothing substituted, is +;;;; never emitted, so no copy ever asks for the size of a variable. + +;; The motivating case: allocate, fill, sort, return. Two element types below, +;; so there are two copies and the storage in each is the instantiation's. +(defn sorted [xs [$t]] (Vec $t) + {:where (ordered? $t)} + (let [v (vec-new $t)] + (dotimes [i (len xs)] (push v (at xs i))) + (sort (as-slice v)) + v)) + +;; The same, against a named allocator rather than the context's. Both arities +;; read their element type the same way, so both take a variable. +(defn sorted-in [xs [$t] al Allocator] (Vec $t) + {:where (ordered? $t)} + (let [v (vec-new $t al)] + (dotimes [i (len xs)] (push v (at xs i))) + (sort (as-slice v)) + v)) + +;; A Map whose key is the variable. The predicate is what lets the hash and the +;; equality be deferred to the copy; see generics.flan for that half. +(defn distinct-count [ks [$k]] i32 + {:where (hashable? $k)} + (let [m (map-new $k i32)] + (dotimes [i (len ks)] + (put m (at ks i) 1)) + (let [n (len m)] (free m) n))) + +;; The zeroed fixed array. Its length is still a compile-time constant; only +;; the element type is the variable, and that is answered per copy. +(defn middle-of [x $t] $t + (let [a (array 3 $t)] + (set (at a 1) x) + (at a 1))) + +;; A cast to the variable, written with the sigil. +(defn widen [x i32 d $t] $t + {:where (numeric? $t)} + (do d ($t x))) + +;; There is no row here for a type variable that instantiates at dyn: a +;; generic is not instantiated at dyn at all, and the refusal says to reach +;; for the dyn side instead. So nothing a copy of one of these bodies does +;; can reach the dyn container. + +;; Allocation failure inside a generic copy, handled the way exhausted.flan +;; handles it: a ceiling, a handler that raises it, and retry re-attempting the +;; request that did not fit. The globals are because a handler cannot see the +;; locals of the function that established it. +(defonce tight Allocator) +(defonce failures i64) + +(defn main [] () + (let [ns [5 3 9 1] + fs [2.5 0.5 1.5] + a (sorted (slice ns 0 4)) + b (sorted (slice fs 0 3))] + (println (at (as-slice a) 0)) ; 1 + (println (at (as-slice a) 3)) ; 9 + (println (at (as-slice b) 0)) ; 0.5 + (println (len (as-slice b))) ; 3 + (free a) + (free b)) + + (let [ns [4 2 8] + ar (arena-new 4096) + c (sorted-in (slice ns 0 3) ar)] + (println (at (as-slice c) 0)) ; 2 + (free-all ar)) + + (let [ns [7 7 3] + ws ["a" "b" "a"]] + (println (distinct-count (slice ns 0 3))) ; 2 + (println (distinct-count (slice ws 0 3)))) ; 2 + + (println (middle-of 6)) ; 6 + (println (middle-of 1.5)) ; 1.5 + (println (widen 3 0.0)) ; 3 + + ;; The guard, the condition and the restart are the concrete form's, emitted + ;; into the copy unchanged. 32 bytes is four i32 and the sixteen this fills + ;; are not. + (set tight (heap-allocator)) + (set-alloc-budget tight 32) + (handler-bind + [(StorageExhausted [c] + (set failures (+ failures 1)) + (set-alloc-budget tight (* 4 (alloc-budget tight))) + (invoke-restart 'retry))] + (let [ns [9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4] + d (sorted-in (slice ns 0 16) tight)] + (println (len (as-slice d))) ; 16 + (println (at (as-slice d) 0)) ; 0 + (free d))) + (println (> failures 0)) ; true + (set-alloc-budget tight 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 41326a5..c4b54ae 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -2764,6 +2764,19 @@ let () = outputs ~opt:"-O0" "integer? and the collapsed abs, -O0" "programs/int-generic.flan" int_generic_out; + (* A generic body that allocates a container of its own element type, + rather than filling one the caller allocated. Every line here is a copy + answering at a type the written body never named: the first four are one + [sorted] at i32 and at f64, and the 16 near the end is the same body + running under a ceiling it has to hit, signal and retry through. *) + let generic_alloc_out = + "1\n9\n0.5\n3\n2\n2\n2\n6\n1.5\n3\n16\n0\ntrue\n" + in + outputs "a generic allocates its own element type" + "programs/generic-alloc.flan" generic_alloc_out; + outputs ~opt:"-O0" "a generic allocates its own element type, -O0" + "programs/generic-alloc.flan" generic_alloc_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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 2cf9eaa..e7a6c86 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -5650,6 +5650,36 @@ let () = ~needle:"is not a map key" "(defn f [k $t] () (let [m (map-new t i32)] (put m k 1) (free m)))"; + (* ── A type variable, spelled with the sigil, where a type name goes ── + [$t] is the signature's spelling and [t] is the body's, and they are the + same variable: the tables that record which variables are in scope are + keyed on the bare name, so every membership test has to strip the sigil + before asking. The ones that did not strip were the guards in front of + [vec-new] and [map-new] and the cast arm, which is why a body that wrote + [(vec-new $t)] was told it had not said what the Vec held. *) + accepts "vec-new over a type variable written with the sigil" + "(defn f [x $t] (Vec $t) (let [v (vec-new $t)] (push v x) v))"; + accepts "and against a named allocator" + "(defn f [x $t a Allocator] (Vec $t) \ + (let [v (vec-new $t a)] (push v x) v))"; + accepts "map-new over type variables written with the sigil" + "(defn f [k $t] i32 {:where (hashable? $t)} \ + (let [m (map-new $t i32)] (put m k 1) (let [n (len m)] (free m) n)))"; + accepts "a zeroed fixed array of a type variable" + "(defn f [x $t] $t (let [a (array 3 $t)] (set (at a 1) x) (at a 1)))"; + accepts "a cast to a type variable written with the sigil" + "(defn f [x i32 d $t] $t {:where (numeric? $t)} (do d ($t x)))"; + (* The message these were taking is still the message for the case it was + written for: nothing named, and nothing at the site that says. *) + rejects_check "vec-new with no element type and nothing to take one from" + ~needle:"nothing here says what (vec-new) is a Vec of" + "(defn f [x $t] i32 (do x (let [v (vec-new)] (free v) 0)))"; + (* And a sigil on a name nothing binds is answered as the unbound variable + it is, rather than as a missing element type. *) + rejects_check "vec-new over a sigil that names no variable in scope" + ~needle:"only a defn signature can" + "(defn f [x $t] i32 (do x (let [v (vec-new $u)] (free v) 0)))"; + (* ── The builtin table against the arms it describes ────────────── [Check.builtins] is what the editor's C-c C-v and M-. read for a name no program wrote — [arena-new] and the seventy-seven others. A table like