diff --git a/lib/check.ml b/lib/check.ml index 99b8955..679d21d 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4645,6 +4645,26 @@ and named_call 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. + + 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 -> + 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 + (match a.Tast.ty with + | Types.Enum _ -> () + | t when Types.is_numeric t || generic_ty t -> () + | t -> fail loc "%s converts a number, found %s" name (Types.to_string t)); + prim (Tast.Cast target) target [ a ] | _ when is_cast name && List.length args = 1 -> let target = resolve_name ctx.env ~seen:[] loc name in let a = check ctx (List.hd args) in diff --git a/test/programs/generics.flan b/test/programs/generics.flan index 44d4220..1f83cd5 100644 --- a/test/programs/generics.flan +++ b/test/programs/generics.flan @@ -62,6 +62,30 @@ {:where (copyable? $t)} (println x)) +;; A cast to a type variable. [(t x)] is not a name [is_cast] knows — [t] is +;; not a machine type — so it is its own arm, and [numeric?] is what admits +;; it, because a cast produces a number. Inside the copy the target is +;; concrete and the emitter sees an ordinary cast. +(defn widen [x i32 d $t] $t + {:where (numeric? $t)} + (do d (t x))) + +;; The builtins that take a *type name* as an argument, over a variable. Each +;; reaches the one list of what names a type, so all three came at once. +;; (pool-new t) and (map-new t i32) are the other two; a Pool of a variable +;; needs it not to be move-only, which [copyable?] is. +(defn one-of [x $t] (Vec $t) + {:where (copyable? $t)} + (let [v (vec-new t)] + (push v x) + v)) + +;; (zeroed) takes its type from the position it is written in, so a variable +;; in that position is answered by the instantiation like any other type. +(defn zero-of [x $t] $t + {:where (copyable? $t)} + (do x (zeroed))) + (defn main [] () (println (ident 3)) (println (ident 4.5)) @@ -98,8 +122,15 @@ (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)) + (println (widen 3 0.0)) + (println (widen 3 (i64 0))) + (println (zero-of 9)) + (let [a (arena-new 4096) - keep (filter (slice ns 0 4) (fn [x] (> x 5)))] + keep (filter (slice ns 0 4) (fn [x] (> x 5))) + one (one-of 4.5)] (println (len (as-slice keep))) + (println (at (as-slice one) 0)) + (free one) (free keep) (free-all a)))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 7351bce..30f0507 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1323,7 +1323,10 @@ let () = (* 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 + let generics_out = + "3\n4.5\ntrue\n7\n5\n-1\n5\n42\n3\n1\n10\n1\n8\n\ + 3\n4.5\ntext\n1\n2.5\n9\n36\n2\n2.5\n0\n3\n3\n0\n3\n4.5\n" + in outputs "generics" "programs/generics.flan" generics_out; outputs ~opt:"-O0" "generics, -O0" "programs/generics.flan" generics_out;