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

Six small refusals and conversions say what the program wrote

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 08:41:31 +07:00
commit 00f116ea29
22 changed files with 511 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
TODO.org
View File

@ -73,11 +73,13 @@ is wrong where it was written rather than aborting the compile with no location.
The prelude's own =unless= has not been converted and still answers a bare
undefined name.
** TODO gensym's counter restarts in a second module
The counter lives in the loaded module and a module is dlopened once per compiler
process, so it is process-wide in practice — but the rounds already build more
than one module for a program whose macros call macros. Seed it from the module's
index.
** DONE gensym's counter restarts in a second module
CLOSED: [2026-09-25]
The counter is C data in the runtime (=flan_gensym_n=), and =lib/macro.ml= writes
the compiler's own count into the module before every macro call and reads it
back after. It counts across every module a compiler process loads — each round,
the program's module, and every expansion in a session. Rules out a counter per
module, seeded or not.
** TODO A quasiquote inside a quasiquote is refused
Nothing counts nesting levels — not the reader, deliberately, and not the
@ -141,11 +143,18 @@ as words the reader will not read back. =(/ 1.0 0.0)= is the only route to an
infinity, and the constant folder is integers only, so it cannot be a =defconst=.
Closing it needs a reader literal or a float-capable folding pass.
** TODO A u64 constant above 2^63 cannot be written in decimal
The reader reads a decimal integer literal as a signed 64-bit number; hex is read
as a bit pattern and works. The same limit has a second face: a cast's argument is
checked against the default type, so =(u64 2935910691)= is refused for not fitting
in an =i32=.
** DONE A u64 constant above 2^63 cannot be written in decimal
CLOSED: [2026-09-25]
An integer written at or above 2^63 — a decimal up to 2^64 - 1, or hex with the
top bit set — reads as =Form.UInt=, its pattern and its spelling. It is accepted
where the type is =u64=, a =(u64 ...)= cast included, and refused everywhere else
in the spelling it was written in. Hex with the top bit set was accepted as a
negative at any integer type before this; it is refused now too. A negative
decimal is still a =u64= bit pattern. A cast's integer literal that does not fit
=i32= is checked at the cast's type; one that fits keeps the =i32= default, so
=(u32 -1)= still means what it did. A wide literal that passes through a macro
comes back as an ordinary =Int=, because the macro side's =Form= has one integer
case. Rules out a second integer case in the prelude's =Form=.
** DONE {.row .col} binds same-named locals
CLOSED: [2026-09-20]
@ -790,14 +799,11 @@ program that does not type-check. Moot for anything that compiles; only the
daemon's half-typed recompiles could feel it. A cheaper retry was tried and
shelved because it changes which literal gets the nicer message.
** TODO and's last operand gets a misdirected caret
=(println (and true true (vec-new i32)))= puts the caret on the second =true=. The
last operand of an =and= is the then arm and the then arm is typed first, so the
mismatch is blamed on the else arm, which carries the previous operand's location.
The fix is preferring the arm that is not a compiler temp when deciding whom to
blame. Three others were considered and rejected: relabelling the else arm reads
backwards, a bool sentinel reverts the =or= fix, and inverting the condition costs
a =not= per operand.
** DONE and's last operand gets a misdirected caret
CLOSED: [2026-09-25]
Already fixed by 3672da2, which blames the arm that is not a compiler temp; the
caret is on the last operand and =test/test_flan.ml= asserts its column. Rules
out relabelling the else arm, a bool sentinel, and inverting the condition.
** TODO Signature pairing's cold-rebuild edge
Whether a parameter vector reads as one annotated parameter or two dyn ones
@ -841,14 +847,21 @@ Iteration is built; the remaining refusal is generics. A =defn= has to name its
types and =(defn map-keys [m (Map K V)] (Vec K))= has no =K=. The loop is three
lines at the call site, where =K= is known.
** TODO (vec-new [u8]) is refused
The element type must be a bare symbol naming a type, so a =(Vec [u8])= can only
be made where the context names it. The fix is letting it take a type expression —
the same parser that already reads =[u8]= in a parameter list.
** DONE (vec-new [u8]) is refused
CLOSED: [2026-09-25]
The type positions of =vec-new= and =map-new= take a type expression: brackets, or
a parenthesised =Ptr=, =Option=, =Vec=, =Map=, =Fn= or =CFn=. The arguments stay
ordinary expressions and the builtin reads the type back out of one
(=Check.type_of_expr=), so a program's own =vec-new= still gets values; only a
type an expression cannot hold, such as =(Fn [i32] ())=, is parsed as
=Ast.TypeArg=. Rules out a type expression anywhere else in expression position.
** TODO An array literal cannot say it is [f32]
A float literal defaults to =f64=, an array literal has no context, and a =let=
has no annotation. Same shape as =(vec-new [u8])= and probably the same fix.
Not the same fix: a bracket literal has no argument to put a type in. Decision:
how a literal names its element type — a spelling of its own, or a =let=
annotation.
** TODO A let binding takes no type annotation
Everything under the surface is there — the binding carries a type slot and the
@ -1860,12 +1873,12 @@ instrumented copy; the equivalent here is a dev-build-only instrumented
redefinition, which the cell indirection already makes deliverable. Open:
whether stepping suspends the frame loop, and what it does to a game's clock.
** TODO A NaN cast says "does not fit", which reads as too big
=runtime/flan_rt.c:1008= covers every out-of-range float with one sentence, so
=(i32 nan)= reports the =i32= bounds as if the value had overshot them. NaN and
the infinities convert to no integer at all and want saying so by name. Found
by filling a struct holding an =f32= with =(filled 0xFF)=, where every bit set
is NaN.
** DONE A NaN cast says "does not fit", which reads as too big
CLOSED: [2026-09-25]
Two more =ArithError= codes: 5 for a cast of NaN and 6 for a cast of an infinity,
each with its own sentence. Both backends choose the code on the cold path, so the
guard is still two compares. =lhs= and =rhs= still carry the range. Rules out
carrying the float value in the condition.
** TODO The break buffer prints fields, not the sentence the runtime wrote
=ArithError — op 4, lhs -2147483648, rhs 2147483647= where the runtime's own
@ -1892,12 +1905,12 @@ when it opens, so =M-g M-n= walks the stop and then each frame with a file.
Refusals — the prelude, a relative path, a missing file — are one function
shared with =M-.=.
** TODO loop's bindings should be sequential, like let's
=check_loop= (=lib/check.ml:4741=) checks every initialiser before binding any,
so =(loop [curr-r r next-r (inc curr-r)] ...)= cannot see =curr-r= and the
refusal reads as an unknown name. Every binding form is sequential — there is
no =let*= here and there is not going to be one. Check the other binding forms
for the same gap while fixing it.
** DONE loop's bindings should be sequential, like let's
CLOSED: [2026-09-25]
=check_loop= binds each name before checking the next initialiser; =recur= still
rebinds all at once. No other form had the gap: =let= was already sequential,
=dotimes= binds one name, and =fn=, =defn=, =match= and the handler and restart
clauses bind parameters with no initialisers.
** TODO C-c C-c reports one error, not every error in the form
Whole-file paths use =Check.program_all= and report every bad declaration. The

11
lib/ast.ml
View File

@ -36,6 +36,7 @@ type expr = { e : expr_kind; loc : Loc.t }
and expr_kind =
| Int of int64
| UInt of int64 * string (* 18446744073709551615 — u64 only *)
| Float of float
| Byte of int
| Str of string
@ -97,6 +98,12 @@ and expr_kind =
fails on an unknown name. This is that position's answer, and it says what
it does rather than looking like a vector of two things. *)
| ArrayOf of texpr (* the whole array type, built by Parse *)
(* (vec-new [u8]) and (map-new string [u8]) — a type written where an
argument goes. Only the type positions of those two forms read one, and
only when the form's shape says type and not value: brackets, or a
parenthesised Ptr, Option, Vec, Map, Fn or CFn. A bare name stays a
[Var], which the checker already answers as a type. *)
| TypeArg of texpr
(* (array-fill [r c] v) and (array-gen [r c] f) — a fixed array of any rank
as an *expression*, which is what [ArrayOf] and [dotimes] between them
could not be: [ArrayOf] produces the zeroed value only, and [dotimes] is
@ -402,8 +409,8 @@ let map_children f (e : expr) : expr =
in
let kind =
match e.e with
| Int _ | Float _ | Byte _ | Str _ | Kw _ | Quote _ | Var _ | ArrayOf _
| Break _ | Continue _ -> e.e
| Int _ | UInt _ | Float _ | Byte _ | Str _ | Kw _ | Quote _ | Var _ | ArrayOf _
| TypeArg _ | Break _ | Continue _ -> e.e
| Do es -> Do (List.map ex es)
| Let (bs, es) -> Let (List.map bind bs, List.map ex es)
| If (c, a, b) -> If (ex c, ex a, Option.map ex b)

134
lib/check.ml
View File

@ -395,6 +395,7 @@ let spell_arg stand_for (a : Ast.expr) =
match a.Ast.e with
| Ast.Var v -> v
| Ast.Int n -> Int64.to_string n
| Ast.UInt (_, s) -> s
| _ -> stand_for
(* What a [break] or a [continue] may be talking about, innermost first.
@ -1958,7 +1959,9 @@ let check_fn_ref : (env -> Ast.fn -> Tast.fn) ref =
(* Untyped literals: their machine type comes from context, so when one is an
operand of a binary operator we look at the *other* operand first. *)
let is_literal (e : Ast.expr) =
match e.Ast.e with Ast.Int _ | Ast.Float _ | Ast.Byte _ -> true | _ -> false
match e.Ast.e with
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
| _ -> false
(* [addr] takes the address of a place, but the parser only builds places for
[set]. Recover one from the expression it parsed instead. *)
@ -3317,6 +3320,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
ctx.tail <- false;
match e.Ast.e with
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
| Ast.UInt (n, s) -> wide_literal loc ~want n s
| Ast.Byte b ->
int_literal loc ~want ~preds:ctx.env.tvpreds ~default:Types.U8
(Int64.of_int b)
@ -3567,6 +3571,11 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
| Ast.ArrayOf t ->
let ty = resolve ctx.env t in
expect ctx loc ~want (mk loc ty (Tast.Zero ty))
(* Parse writes one only into a type position of a call named vec-new or
map-new, and the builtins read it before it could get here. A program's
own function of that name does not. *)
| Ast.TypeArg _ ->
fail loc "this is a type, and a value is wanted here"
| Ast.ArrayFill (dims, v) -> check_array_fill ctx ~want loc dims v
| Ast.ArrayGen (dims, f) -> check_array_gen ctx ~want loc dims f
| Ast.Match (scrutinee, arms) -> check_match ctx ~tail ?want loc scrutinee arms
@ -3747,6 +3756,29 @@ and int_literal loc ~want ?(preds = []) ?(default = Types.I32) n =
(Types.to_string other) n
| _ -> mk loc (Types.Int default) (Tast.Int (in_range loc default n, default))
(* An integer written at or above 2^63, in decimal or in hex. Only a u64 holds
one, so it is accepted there and refused everywhere else, in the spelling it
was written in — its pattern read as an i64 is a different number. *)
and wide_literal loc ~want n s =
match want with
| Some (Types.Int Types.U64) -> mk loc (Types.Int Types.U64) (Tast.Int (n, Types.U64))
| Some (Types.Int k) ->
Loc.failk literal_at_want loc "%s does not fit in %s" s (Types.ikind_name k)
| Some (Types.Float _ as t) ->
Loc.failk literal_at_want loc
"%s is too large for any integer type but u64, and an integer literal \
where %s is wanted is read as one — write (%s (u64 %s))"
s (Types.to_string t) (Types.to_string t) s
| Some Types.Never | None ->
Loc.failk literal_at_want loc
"%s does not fit in i32, the type an integer literal takes when nothing \
says otherwise — write (u64 %s) for a u64"
s s
| Some other ->
Loc.failk literal_at_want loc
"expected %s, found the integer literal %s, which only a u64 holds"
(Types.to_string other) s
(* Arithmetic wraps, but a literal that does not fit its type is a typo, not a
wrap — 300 is never what someone meant by a u8. *)
and in_range loc k n =
@ -3757,13 +3789,10 @@ and in_range loc k n =
|| (Int64.compare n (Int64.neg (Int64.shift_left 1L (bits - 1))) >= 0
&& Int64.compare n (Int64.shift_left 1L (bits - 1)) < 0)
else if bits = 64 then
(* A u64 literal is its 64-bit pattern, so anything at or above 2^63
arrives here as a negative [int64] and is still in range —
0xcbf29ce484222325 is a real u64 and not an error. The cost is that a
negative *decimal* literal is accepted as a u64 too, because the
reader records only the value and not how it was written. Narrower
unsigned types keep the strict check, which is where a typo like 300
for a u8 actually shows up. *)
(* A literal at or above 2^63 is a [UInt] and never reaches here; see
[wide_literal]. A negative decimal is accepted as a u64's bit pattern,
which is a settled rule. Narrower unsigned types keep the strict
check, which is where a typo like 300 for a u8 actually shows up. *)
true
else
Int64.compare n 0L >= 0
@ -4757,8 +4786,10 @@ and check_dotimes ctx ~want loc label name (b : Ast.bounds) body =
and check_loop ctx ?want loc bs body =
scoped ctx (fun () ->
(* Each initial value is evaluated once, before the loop, exactly as a
[let]'s is and as [dotimes]'s bound is. *)
let inits =
[let]'s is and as [dotimes]'s bound is — and bound before the next is
checked, as a [let]'s is, so a later initialiser sees an earlier
name. *)
let binds =
map_lr
(fun (n, v) ->
let v = check ctx v in
@ -4767,12 +4798,9 @@ and check_loop ctx ?want loc bs body =
fail v.Tast.loc "%s would be bound to %s, which is not a value" n
(Types.to_string v.Tast.ty)
| _ -> ());
(n, v))
(bind ctx n v.Tast.ty ~assignable:true, v))
bs
in
let binds =
List.map (fun (n, v) -> (bind ctx n v.Tast.ty ~assignable:true, v)) inits
in
let names = List.map (fun (slot, v) -> (slot, v.Tast.ty)) binds in
(* The singleton is [in_loop]'s doing: it sits in this recursive group and
is therefore monomorphic, and every other caller hands it a list. *)
@ -6585,12 +6613,16 @@ and type_named ctx n =
|| Hashtbl.mem ctx.env.enums n
|| Hashtbl.mem ctx.env.aliases n
(* The element type for [vec-new]: a leading bare symbol naming a type, or the
expectation at the site. A bare symbol shadowed by a local or a global is
that binding — an allocator, in practice — and not a type. *)
(* The element type for [vec-new]: a leading bare symbol naming a type, a
leading type expression — [(vec-new [u8])], [(vec-new (Ptr Cell))], which
Parse has already read as one — or the expectation at the site. A bare
symbol shadowed by a local or a global is that binding — an allocator, in
practice — and not a type. *)
and vec_new_elem ctx ~want loc args =
let named =
match args with
| a :: rest when type_of_expr a <> None ->
Some (resolve ctx.env (Option.get (type_of_expr a)), rest)
| { Ast.e = Ast.Var n; _ } :: rest
when lookup ctx n = None
&& (not (Hashtbl.mem ctx.env.globals n))
@ -6608,6 +6640,39 @@ and vec_new_elem ctx ~want loc args =
"nothing here says what (vec-new) is a Vec of — write the element \
type, as (vec-new i32), or give the binding a type")
(* A type written as an argument to vec-new or map-new, read back out of the
expression Parse made of it. Only the shapes that cannot be a value there:
brackets — an allocator is never an array — or a parenthesised Ptr,
Option, Vec, Map, Fn or CFn. A bare name is not one of them, because there
it may be an allocator's name; the callers ask about that themselves. *)
and type_of_expr (e : Ast.expr) : Ast.texpr option =
let mk t = { Ast.t; tloc = e.Ast.loc } in
let inner (e : Ast.expr) =
match e.Ast.e with
| Ast.Var s -> Some { Ast.t = Ast.Tname s; tloc = e.Ast.loc }
| _ -> type_of_expr e
in
let all es =
let ts = List.filter_map inner es in
if List.length ts = List.length es then Some ts else None
in
match e.Ast.e with
| Ast.TypeArg t -> Some t
| Ast.Arr [ x ] -> Option.map (fun t -> mk (Ast.Tslice t)) (inner x)
| Ast.Arr [ { Ast.e = Ast.Int n; _ }; x ] ->
Option.map (fun t -> mk (Ast.Tarray (Ast.Lint n, t))) (inner x)
| Ast.Arr [ { Ast.e = Ast.Var n; _ }; x ] ->
Option.map (fun t -> mk (Ast.Tarray (Ast.Lname n, t))) (inner x)
| Ast.Call ({ Ast.e = Ast.Var (("Fn" | "CFn") as which); _ },
[ { Ast.e = Ast.Arr ps; _ }; r ]) ->
(match all ps, inner r with
| Some ps, Some r -> Some (mk (Ast.Tfn (which = "Fn", ps, r)))
| _ -> None)
| Ast.Call ({ Ast.e = Ast.Var (("Ptr" | "Option" | "Vec" | "Map") as c); _ },
(_ :: _ as args)) ->
Option.map (fun ts -> mk (Ast.Tapp (c, ts))) (all args)
| _ -> None
(* The key and value types, or the reason this is not a Map. *)
and map_kv loc what (t : Types.t) =
match t with
@ -6625,10 +6690,21 @@ and map_new_types ctx ~want loc args =
&& (not (Hashtbl.mem ctx.env.globals n))
&& type_named ctx n
in
(* A type position holds a bare name or a type expression Parse has read
as one, as [vec-new]'s does. *)
let as_type (a : Ast.expr) =
match a.Ast.e, type_of_expr a with
| _, Some t -> Some (resolve ctx.env t)
| Ast.Var n, None when is_type n -> Some (resolve_name ctx.env ~seen:[] loc n)
| _ -> None
in
match args with
| { Ast.e = Ast.Var k; _ } :: { Ast.e = Ast.Var v; _ } :: rest
when is_type k && is_type v ->
resolve_name ctx.env ~seen:[] loc k, resolve_name ctx.env ~seen:[] loc v, rest
| k :: v :: rest when as_type k <> None && as_type v <> None ->
Option.get (as_type k), Option.get (as_type v), rest
| a :: _ when type_of_expr a <> None ->
fail loc
"(map-new) names a key and no value — write both, as (map-new string \
i32), or give the binding a type"
| { Ast.e = Ast.Var k; _ } :: rest when is_type k && rest = [] ->
fail loc
"(map-new %s) names a key and no value — write both, as (map-new %s \
@ -8858,7 +8934,19 @@ and named_call ?(qualified = false) ctx ~want loc name args =
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
(* An integer literal too wide for the i32 it would default to is checked
at the target instead, so (u64 2935910691) and (i64 5000000000) are the
constants they say. One that fits i32 keeps the default and the cast,
which is what (u32 -1) has always meant. *)
let want =
match (List.hd args).Ast.e, target with
| Ast.Int n, (Types.Int _ | Types.Float _)
when Int64.compare n (-2147483648L) < 0
|| Int64.compare n 2147483647L > 0 -> Some target
| Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target
| _ -> None
in
let a = check ctx ?want (List.hd args) in
(match a.Tast.ty with
| Types.Enum _ -> ()
(* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
@ -9181,7 +9269,7 @@ and generic_call ctx ~want loc name vars pats pret args =
else is checked on its own terms. *)
let untyped_literal =
match a.Ast.e with
| Ast.Int _ | Ast.Float _ | Ast.Byte _ -> true
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ -> true
| _ -> false
in
let a =
@ -9653,7 +9741,7 @@ and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args =
let y_decides =
(is_literal x && not (is_literal y))
|| (match x.Ast.e, y.Ast.e with
| (Ast.Int _ | Ast.Byte _), Ast.Float _ -> true
| (Ast.Int _ | Ast.UInt _ | Ast.Byte _), Ast.Float _ -> true
| _ -> false)
in
(* A form that cannot be checked without being told what is wanted. A

22
lib/emit.ml
View File

@ -1517,6 +1517,8 @@ let arith_rem_zero = 1
let arith_div_overflow = 2
let arith_rem_overflow = 3
let arith_cast_range = 4
let arith_cast_nan = 5
let arith_cast_inf = 6
(* ArithError's fields are i64 and an operand may be narrower, so every
operand is widened on the way into the condition — signed or not according
@ -1668,11 +1670,27 @@ let check_cast f ~guard loc (src : Types.fkind) (k : Types.ikind) v =
ins f "%s = fcmp olt double %s, %s" b v (dbl hi_f);
let ok = fresh f in
ins f "%s = and i1 %s, %s" ok a b;
(* NaN and the infinities are named rather than reported as out of range:
they are not values that overshot the type, they have no integer at
all. Worked out on the cold path, so the guard is still two compares. *)
signal_block f loc ~guard ok (fun id nn ->
let nan = fresh f in
ins f "%s = fcmp uno double %s, %s" nan v v;
let pinf = fresh f in
ins f "%s = fcmp oeq double %s, %s" pinf v (dbl infinity);
let ninf = fresh f in
ins f "%s = fcmp oeq double %s, %s" ninf v (dbl neg_infinity);
let inf = fresh f in
ins f "%s = or i1 %s, %s" inf pinf ninf;
let c1 = fresh f in
ins f "%s = select i1 %s, i32 %d, i32 %d" c1 inf arith_cast_inf
arith_cast_range;
let code = fresh f in
ins f "%s = select i1 %s, i32 %d, i32 %s" code nan arith_cast_nan c1;
ins f
"call void @flan_arith_error(ptr %s, i64 %d, i32 %d, i64 %Ld, i64 %Ld, \
"call void @flan_arith_error(ptr %s, i64 %d, i32 %s, i64 %Ld, i64 %Ld, \
ptr %s)"
id nn arith_cast_range lo_i hi_i xfer_param)
id nn code lo_i hi_i xfer_param)
end
(* [at] is strict: the last valid index is len - 1. *)

5
lib/expand.ml
View File

@ -114,6 +114,9 @@ let rec write (sites : sites) p (f : Form.t) =
| Form.Kw s -> str TKw s
| Form.Str s -> str TStr s
| Form.Int i -> tag TInt; Dynload.poke_i64 p payload i
(* A macro's Form has one integer case, so a wide literal crosses as its
pattern and comes back as an ordinary [Int]. *)
| Form.UInt (i, _) -> tag TInt; Dynload.poke_i64 p payload i
| Form.Float x -> tag TFloat; Dynload.poke_f64 p payload x
| Form.Byte b -> tag TByte; Dynload.poke_i32 p payload (Int32.of_int b)
| Form.List xs -> seq TList xs
@ -251,7 +254,7 @@ let rec quote (f : Form.t) : Form.t =
inner form with form-cons"
| Form.Sym s -> node loc "Sym" "s" (Form.Str s)
| Form.Kw s -> node loc "Kw" "s" (Form.Str s)
| Form.Int i -> node loc "Int" "i" (Form.Int i)
| Form.Int i | Form.UInt (i, _) -> node loc "Int" "i" (Form.Int i)
| Form.Float x -> node loc "Float" "x" (Form.Float x)
| Form.Str s -> node loc "Str" "s" (Form.Str s)
| Form.Byte b -> node loc "Byte" "b" (Form.Int (Int64.of_int b))

6
lib/form.ml
View File

@ -12,6 +12,10 @@ and value =
| Sym of string (* foo rl/draw-fps .pos + *)
| Kw of string (* :space :else (leading : dropped) *)
| Int of int64 (* 42 -1 0xE6B800FF *)
(* An integer written at or above 2^63 — 18446744073709551615, or a hex
literal with its top bit set. Its 64-bit pattern and its spelling: only a
u64 holds it, and a refusal anywhere else prints the number as written. *)
| UInt of int64 * string
| Float of float (* 0.05 *)
| Str of string (* "SAND" *)
| Byte of int (* \space \0 \( (0..255) *)
@ -30,6 +34,7 @@ let rec to_string f =
| Sym s -> s
| Kw s -> ":" ^ s
| Int i -> Int64.to_string i
| UInt (_, s) -> s
| Float x -> Printf.sprintf "%g" x
| Str s -> Printf.sprintf "%S" s
| Byte b ->
@ -126,6 +131,7 @@ let rec to_source f =
| Sym s -> s
| Kw s -> ":" ^ s
| Int i -> Int64.to_string i
| UInt (_, s) -> s
| Float x -> float_repr x
| Str s -> "\"" ^ escape s ^ "\""
| Byte b -> byte_repr b

8
lib/load.ml
View File

@ -223,7 +223,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
let name n = qualify_name owned alias bound n in
let k =
match e.Ast.e with
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
| Ast.Quote _ -> e.Ast.e
| Ast.Var n -> Ast.Var (name n)
| Ast.Do body -> Ast.Do (gos body)
@ -307,6 +307,7 @@ let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr =
Ast.MapLit (tag, List.map (fun (k, v) -> (go k, go v)) kvs)
| Ast.Arr items -> Ast.Arr (gos items)
| Ast.ArrayOf t -> Ast.ArrayOf (rename_texpr owned alias t)
| Ast.TypeArg t -> Ast.TypeArg (rename_texpr owned alias t)
(* The dimensions too, for the reason [rename_texpr] gives about the one
inside [Tarray]: a dimension written as a name is an ordinary
compile-time constant of the package and has to be qualified like any
@ -753,7 +754,8 @@ let rec expr_uses acc (e : Ast.expr) =
let go = expr_uses acc in
let gos = List.iter go in
match e.Ast.e with
| Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ | Ast.Quote _ ->
| Ast.Int _ | Ast.UInt _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _
| Ast.Quote _ ->
()
(* The name is not one an import can supply, but the arguments are ordinary
expressions and may well use one. *)
@ -787,7 +789,7 @@ let rec expr_uses acc (e : Ast.expr) =
| Ast.Bare kvs -> List.iter (fun (_, v) -> go v) kvs
| Ast.MapLit (_, kvs) -> List.iter (fun (k, v) -> go k; go v) kvs
| Ast.Arr items -> gos items
| Ast.ArrayOf t -> texpr_uses acc t
| Ast.ArrayOf t | Ast.TypeArg t -> texpr_uses acc t
(* A dimension written as a name is a use of that constant, exactly as it is
inside [Tarray]. *)
| Ast.ArrayFill (ds, v) | Ast.ArrayGen (ds, v) ->

18
lib/macro.ml
View File

@ -380,12 +380,28 @@ let dir_of (l : loaded) (loc : Loc.t) =
always has a signature, and the one thing that could put a name in [fns]
without one is the two lists coming apart — in which case expanding
unchecked is the wrong half to lose. *)
(* The gensym counter, process-wide. Every module links its own runtime and
so its own [flan_gensym_n], and a build loads several — one per round when
a macro calls a macro, then the one the program is expanded with, and a
session loads one per expansion. A counter that restarted in each would
hand a later module the name an earlier one had already baked into a
macro's code. So the count lives here and is written into the module
before every call and read back after, whether the call returns or
raises. *)
let gensym_n = ref 0L
let with_gensym (l : loaded) f =
let cell = Dynload.dl_sym l.handle "flan_gensym_n" in
Dynload.poke_i64 cell 0 !gensym_n;
Fun.protect ~finally:(fun () -> gensym_n := Dynload.peek_i64 cell 0) f
let checked_call (l : loaded) n ~loc (args : Form.t list) : Form.t =
(match List.assoc_opt n l.sigs with
| Some sg -> Expand.check_call ~name:n ~loc sg args
| None -> ());
dir_of l loc;
Expand.call ~loc:(Loc.from_macro n loc) (List.assoc n l.fns) args
with_gensym l (fun () ->
Expand.call ~loc:(Loc.from_macro n loc) (List.assoc n l.fns) args)
let fuel = 200

26
lib/parse.ml
View File

@ -310,6 +310,7 @@ let rec expr (f : Form.t) : Ast.expr =
let mk e = { Ast.e; loc = f.loc } in
match f.v with
| Int i -> mk (Ast.Int i)
| UInt (i, s) -> mk (Ast.UInt (i, s))
| Float x -> mk (Ast.Float x)
| Byte b -> mk (Ast.Byte b)
| Str s -> mk (Ast.Str s)
@ -425,6 +426,31 @@ and form f mk (head : Form.t) (args : Form.t list) : Ast.expr =
| [ target; value ] -> mk (Ast.Set (place target, expr value))
| _ -> fail f "set is (set place value)")
(* ── (vec-new [u8]) and (map-new string [u8]) ───────────────────────
The type positions of these two take a type expression. Whether this call
is the builtin at all is the checker's to know — a program may define its
own [vec-new] — so the arguments are read as ordinary expressions and
[Check.type_of_expr] reads a type back out of one when the builtin is
what was called. The one type an expression cannot carry is [()], as in
[(Fn [i32] ())], so an argument that is not an expression but is a type
is kept as a [TypeArg]. *)
| Sym (("vec-new" | "builtin/vec-new" | "map-new" | "builtin/map-new") as n) ->
let slots =
if n = "vec-new" || n = "builtin/vec-new" then 1 else 2
in
let args =
List.mapi
(fun i (a : Form.t) ->
match expr a with
| e -> e
| exception (Loc.Error _ as not_expr) when i < slots ->
(match texpr a with
| t -> { Ast.e = Ast.TypeArg t; loc = a.loc }
| exception Loc.Error _ -> raise not_expr))
args
in
mk (Ast.Call (expr head, args))
(* ── (array 4 rl/Vector2) ───────────────────────────────────────────
A zeroed fixed array, told its count and its element type. The type
spelling [4 rl/Vector2] is unchanged and still works everywhere a type is

27
lib/prelude.ml
View File

@ -123,9 +123,11 @@ let source = {flan|
;; 0 (/ a 0) 1 (% a 0)
;; 2 (/ min -1) 3 (% min -1)
;; 4 a float to integer cast whose value does not fit
;; 5 a float to integer cast of NaN
;; 6 a float to integer cast of an infinity
;;
;; `lhs` and `rhs` are the two operands for codes 0 through 3 and the
;; destination type's representable range for code 4 — the violated condition
;; destination type's representable range for codes 4 through 6 — the violated condition
;; written as a range, which is what flan_slice_promise_error already does
;; with BoundsError's fields. Two meanings over two fields rather than two
;; condition types, so that a handler writes one clause and not five. The
@ -232,10 +234,9 @@ let source = {flan|
;; LLVM; at this width there is no such case to guard.
;;
;; The multiplier is written in hex, which is how it is written everywhere
;; it appears: in decimal it is 12605985483714917081, and a decimal
;; literal that large is refused here because the reader reads one as a
;; signed 64-bit number. Hex is read as a bit pattern, and this is a bit
;; pattern. It is written here rather than given a name of its own: a
;; it appears: in decimal it is 12605985483714917081. Either spelling is
;; a u64 literal and nothing else. It is written here rather than given a
;; name of its own: a
;; prelude constant is a name in every program, and this is an
;; implementation number that nothing outside these four lines wants.
(let [w (* (bit-xor (>> s (+ (>> s 59) 5)) s) 0xAEF17502108EF2D9)]
@ -2135,19 +2136,19 @@ let source = {flan|
;; explicit gensym is the settled decision (plan.org, open decision 2); this is
;; the escape hatch that makes it liveable.
;;
;; The counter lives in the loaded module rather than in the compiler, which is
;; the one place this departs from the sketch. A module is dlopened once
;; per compiler process and every macro in a program shares it, so the counter
;; is process-wide in practice; a second module would restart it, and the day
;; there is one, the fix is to seed this from the module's index.
(defonce gensym-n i64 0)
;; The counter is C data in the runtime, flan_gensym_n, because a build loads
;; more than one macro module — one per round when macros call macros, and
;; another for every expansion in a session — and each links its own copy of
;; the runtime. lib/macro.ml keeps the count across them: it writes it into
;; the module before every macro call and reads it back after, so no two
;; modules in one compiler process draw the same name.
(declare gensym-next [] i64 "flan_gensym_next")
(defn gensym [] Form
(set gensym-n (+ gensym-n 1))
(let [v (vec-new u8)]
(push v 126) ; ~
(push v 103) ; g
(let [d (i64->bytes gensym-n)]
(let [d (i64->bytes (gensym-next))]
(dotimes [i (length d)]
(push v (at d i))))
(Form.Sym {.s (string (slice v))})))

16
lib/reader.ml
View File

@ -144,6 +144,8 @@ let read_number st =
in
if is_hex then
match Int64.of_string_opt text with
(* A top bit set is a value at or above 2^63, which only a u64 holds. *)
| Some i when Int64.compare i 0L < 0 -> spanned st loc (Form.UInt (i, text))
| Some i -> spanned st loc (Form.Int i)
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
"malformed hex literal %s" text
@ -153,10 +155,20 @@ let read_number st =
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
"malformed float literal %s" text
else
(* A decimal above the largest i64 and below 2^64 is a [UInt], as a hex
literal with its top bit set is: only a u64 holds it. *)
let unsigned () =
if String.for_all (fun c -> c >= '0' && c <= '9') text then
Int64.of_string_opt ("0u" ^ text)
else None
in
match Int64.of_string_opt text with
| Some i -> spanned st loc (Form.Int i)
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
"malformed integer literal %s" text
| None ->
match unsigned () with
| Some i -> spanned st loc (Form.UInt (i, text))
| None -> Loc.failk "reader/malformed-number" (Loc.upto loc (here st))
"malformed integer literal %s" text
let read_symbol_or_keyword st =
let loc = here st in

22
lib/x86.ml
View File

@ -2897,8 +2897,30 @@ and check_cast f (loc : Loc.t) (src : Types.fkind) (k : Types.ikind) =
ucomis f.b ~f64 ~a:1 ~c:xmm0;
jcc_lbl f.b ~cc:cc_a ok;
lbl f.b bad;
(* Which code, on the cold path: NaN and the infinities are named rather
than reported as out of range. xmm0 still holds the value here. *)
let call = new_label f "nofitcall" and notnan = new_label f "notnan"
and isinf = new_label f "isinf" in
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_range);
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
ucomis f.b ~f64 ~a:xmm0 ~c:xmm0;
jcc_lbl f.b ~cc:cc_np notnan;
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_nan);
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
jmp_lbl f.b call;
lbl f.b notnan;
let kpinf = float_const f infinity ~f64
and kninf = float_const f neg_infinity ~f64 in
fload f.b ~dst:1 ~mm:(Sym (kpinf, 0)) ~f64;
ucomis f.b ~f64 ~a:xmm0 ~c:1;
jcc_lbl f.b ~cc:cc_e isinf;
fload f.b ~dst:1 ~mm:(Sym (kninf, 0)) ~f64;
ucomis f.b ~f64 ~a:xmm0 ~c:1;
jcc_lbl f.b ~cc:cc_ne call;
lbl f.b isinf;
imm_into f ~reg:rax (Int64.of_int Emit.arith_cast_inf);
store_int f.b ~src:rax ~mm:(Frame so) ~size:8;
lbl f.b call;
imm_into f ~reg:rax lo_i;
store_int f.b ~src:rax ~mm:(Frame sa) ~size:8;
imm_into f ~reg:rax hi_i;

25
runtime/flan_rt.c
View File

@ -969,7 +969,9 @@ enum {
FLAN_ARITH_REM_ZERO = 1,
FLAN_ARITH_DIV_OVERFLOW = 2,
FLAN_ARITH_REM_OVERFLOW = 3,
FLAN_ARITH_CAST_RANGE = 4
FLAN_ARITH_CAST_RANGE = 4,
FLAN_ARITH_CAST_NAN = 5,
FLAN_ARITH_CAST_INF = 6
};
typedef struct { int32_t op; int64_t lhs, rhs; } flan_arith_cond;
@ -1005,6 +1007,19 @@ static void flan_arith_fail(const uint8_t *loc, int64_t loclen, int32_t op,
op == FLAN_ARITH_DIV_OVERFLOW ? "/" : "%", (long long)lhs,
(long long)rhs);
break;
/* NaN and the infinities did not overshoot the range: no integer is
* their value, whatever the type. Saying "does not fit" reads as too big. */
case FLAN_ARITH_CAST_NAN:
fprintf(stderr,
"%.*s: this value is NaN, which has no integer value to cast to\n",
(int)loclen, (const char *)loc);
break;
case FLAN_ARITH_CAST_INF:
fprintf(stderr,
"%.*s: this value is infinite, which has no integer value to cast "
"to\n",
(int)loclen, (const char *)loc);
break;
default:
fprintf(stderr,
"%.*s: this value does not fit the integer type it is cast to, "
@ -3181,6 +3196,14 @@ const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) {
char flan_macro_dir[FLAN_PATH_MAX] = { 0 };
int64_t flan_macro_dir_n = 0;
/* The prelude's gensym counter. C data rather than a Flan global for the same
* reason as the two above: lib/macro.ml writes it into a module before every
* macro call and reads it back after, which is what keeps it counting across
* every module a compiler process loads rather than restarting in each. */
int64_t flan_gensym_n = 0;
int64_t flan_gensym_next(void) { return ++flan_gensym_n; }
/* The bytes are the caller's to read and nobody's to free: an expansion is
* bounded by the size of the program being compiled, which is exactly the
* budget lib/dynload.ml's `owned` note already spends on a macro's own

3
test/programs/arith-condition.flan
View File

@ -180,7 +180,8 @@
;; NaN fails both halves of the range test, which is deliberate: a NaN
;; cast to an integer is exactly as undefined as a value out of range,
;; and an unordered comparison would have waved it through.
;; and an unordered comparison would have waved it through. Its code is
;; 5, which names NaN, rather than 4, which says it overshot the range.
(cast-frame (/ (f64 0.0) (f64 0.0)))
(show "op" (i64 op))

6
test/programs/arith.flan
View File

@ -76,6 +76,12 @@
;; double there, which agree because every bound is a power of two and is
;; exact in both.
(= n 9) (print (i32 wide))
;; NaN and the infinities have no integer value at all, so the message
;; names them rather than a range they did not overshoot. An f32 source
;; for each too, since the two backends test it at different widths.
(= n 10) (print (i32 (/ (f64 1.0) (f64 0.0))))
(= n 11) (print (u8 (/ (f32 -1.0) (f32 0.0))))
(= n 12) (print (i32 (/ (f32 0.0) (f32 0.0))))
:else (println "?"))
0))

24
test/programs/macro-gensym-rounds.flan Normal file
View File

@ -0,0 +1,24 @@
;;;; Two gensyms from two macro modules are never the same name.
;;;;
;;;; `outer` calls `baked` in its body, so `baked` is compiled in a round of
;;;; its own and `outer`'s body is expanded against that module before `outer`
;;;; is compiled. The gensym `baked` draws there becomes a literal in
;;;; `outer`'s code; the one `outer` draws itself comes from the later module
;;;; the program is expanded with. `main` comes first so that its expansion is
;;;; that module's first draw. Were the two the same name, the second binding
;;;; would shadow the first and this would print 200.
(defn main [] i32
(println (outer 1))
0)
;; Expands to code that builds the symbol this expansion drew.
(defmacro baked []
(match (gensym)
(Form.Sym s) `(Form.Sym {.s ~(Form.Str {.s s})})
_ `(form-nil)))
(defmacro outer [a]
(let [g (baked)
h (gensym)]
`(let [~g ~a ~h 100] (+ ~g ~h))))

6
test/programs/recur.flan
View File

@ -99,4 +99,10 @@
(Some v) (recur (+ i 1) (+ acc v))
None acc)))
(println "") ; 0+1+2+3 = 6
;; The bindings are sequential, as a let's are: the second initialiser reads
;; the first name. Only the initial values are; recur still rebinds at once.
(print (loop [a 1 b (+ a 10)]
(if (> a 3) b (recur (+ a 1) (+ b a)))))
(println "") ; 11+1+2+3 = 17
0)

16
test/programs/u64-decimal.flan Normal file
View File

@ -0,0 +1,16 @@
;;;; A u64 constant above 2^63 written in decimal, and an integer literal too
;;;; wide for i32 as a cast's argument.
(defconst top u64 18446744073709551615)
(defonce fnv u64 14695981039346656037)
(defn main [] i32
(println top)
(println fnv)
(println (u64 2935910691))
(println (u64 18446744073709551615))
(println (i64 -5000000000))
(println (f64 4000000000))
;; A literal that fits i32 keeps its default and is cast, as before.
(println (u32 -1))
0)

14
test/programs/vec-new-shadow.flan Normal file
View File

@ -0,0 +1,14 @@
;;;; A program's own vec-new is an ordinary function: a bracket passed to it
;;;; is an array value, not an element type. builtin/vec-new is still the
;;;; builtin and still reads one as a type.
(defn vec-new [xs [1 i32]] i32 (at xs 0))
(defn main [] i32
(let [x 7
v (builtin/vec-new [u8])]
(println (vec-new [x]))
(push v (bytes-view "ab"))
(println (length (at v 0)))
(free v))
0)

25
test/programs/vec-new-type.flan Normal file
View File

@ -0,0 +1,25 @@
;;;; vec-new and map-new take a type expression where they take a type, so a
;;;; local can hold a Vec of slices, of arrays or of pointers with nothing
;;;; else naming the element type. The last Vec names an allocator after its
;;;; type, which is the one argument that may follow.
(defn main [] i32
(let [a (arena-new 4096)
words (vec-new [u8])
pairs (vec-new [2 i32])
ptrs (vec-new (Ptr i32))
opts (vec-new (Option i64) a)
m (map-new string [u8])
x (i32 7)]
(push words (bytes-view "ab"))
(push words (bytes-view "cde"))
(push pairs [3 4])
(push ptrs (addr x))
(push opts (Some (i64 9)))
(put m "k" (bytes-view "xyz"))
(println (length words) (length (at words 1))
(at (at pairs 0) 1) (deref (at ptrs 0))
(match (at opts 0) (Some v) v None -1)
(match (get m "k") (Some v) (length v) None -1))
(free words) (free pairs) (free ptrs) (free m))
0)

44
test/test_acceptance.ml
View File

@ -501,7 +501,25 @@ let () =
rather than running out of stack. The swap line is the other — recur
rebinds every name at once, and interleaved writes would print 1. *)
outputs "loop and recur" "programs/recur.flan"
"10\n2\n21\n8\n10000000\n64\n012\n0\n4\n012\n6\n";
"10\n2\n21\n8\n10000000\n64\n012\n0\n4\n012\n6\n17\n";
(* A type expression where vec-new and map-new take a type: a slice, an
array, a pointer and an option, with nothing else naming the element. *)
outputs "vec-new takes a type expression" "programs/vec-new-type.flan"
"2 3 4 7 9 3\n";
outputs ~x86:true "vec-new takes a type expression, x86"
"programs/vec-new-type.flan" "2 3 4 7 9 3\n";
(* A program's own vec-new takes its arguments as values; the builtin,
reached as builtin/vec-new, still reads a bracket as a type. *)
outputs "a vec-new of the program's own" "programs/vec-new-shadow.flan"
"7\n2\n";
(* A u64 above 2^63 in decimal, and a cast of a literal too wide for i32. *)
let u64_out =
"18446744073709551615\n14695981039346656037\n2935910691\n\
18446744073709551615\n-5000000000\n4e+09\n4294967295\n"
in
outputs "a u64 constant in decimal" "programs/u64-decimal.flan" u64_out;
outputs ~x86:true "a u64 constant in decimal, x86"
"programs/u64-decimal.flan" u64_out;
(* into. The count of pulls is the assertion a unit test cannot make: one
pass, one call per element per stage it reaches, and no intermediate
collection anywhere. The two show lines either side of it are the same
@ -2543,8 +2561,8 @@ let () =
no overflow case because it has no most-negative value, and a float
division by zero, which is an infinity and is a defined answer this
language has no business refusing. *)
let arith ?opt () =
let exe = compile ?opt "programs/arith.flan" in
let arith ?opt ?x86 () =
let exe = compile ?opt ?x86 "programs/arith.flan" in
let traps name arg reason =
let code, text = run exe (Some arg) in
if code <> 134
@ -2587,7 +2605,7 @@ let () =
would have waved it through into an fptosi that is as undefined for a
NaN as it is for 1e300. *)
traps "NaN cast to an integer" "7"
"does not fit the integer type it is cast to";
"this value is NaN, which has no integer value to cast to";
(* One width down, and this is the case the two backends disagreed about
*silently* rather than both dying: x86 loaded the operands
sign-extended into 64-bit registers, divided there and truncated on
@ -2604,10 +2622,21 @@ let () =
and this is the row that says so rather than the comment. *)
traps "an f32 too large for an i32" "9"
"which holds [-2147483648 2147483647]";
(* NaN and the infinities are named: they did not overshoot a range,
they have no integer value at all. *)
traps "an infinity cast to an integer" "10"
"this value is infinite, which has no integer value to cast to";
traps "an f32 negative infinity cast to a u8" "11"
"this value is infinite, which has no integer value to cast to";
traps "an f32 NaN cast to an integer" "12"
"this value is NaN, which has no integer value to cast to";
(try Sys.remove exe with Sys_error _ -> ())
in
arith ();
arith ~opt:"-O0" ();
(* The x86 backend picks the code with its own instructions, so the three
named cases are asserted there as well as in the survey. *)
arith ~x86:true ();
(* The release build drops the guards. Asserted on the IR and not by
running an unchecked program, for the reason the bounds case gives: an
@ -2646,7 +2675,7 @@ let () =
op 2\nlhs -9223372036854775808\nrhs -1\nop 3\n\
cast 3\ncast -3\n\
op 4\nlhs -9223372036854775808\nrhs 9223372036854775807\nop 4\n\
cast8 12\nlhs -128\nrhs 127\nop 4\n\
cast8 12\nlhs -128\nrhs 127\nop 5\n\
lit 4611686018427387903\nu 14\n\
frames 4\nskipped 8\ncleaned 12\n"
in
@ -3896,6 +3925,11 @@ level "1"
outputs ~dev:true "a macro's parameter list, dev"
"programs/macro-params.flan" macro_params_out;
(* A gensym drawn in one round's module and one drawn in the module the
program is expanded with are different names. 200 is the two colliding. *)
outputs "gensym counts across macro modules"
"programs/macro-gensym-rounds.flan" "101\n";
(* A macro declared in an imported *package*, which is the half the
refusal at [a package's macro is not visible unqualified] above leaves
out. The program calls six of them qualified and one of its own

60
test/test_flan.ml
View File

@ -92,6 +92,14 @@ let () =
reads "bare plus" "+" "+";
reads "float" "0.05" "0.05";
reads "hex" "0xE6B800FF" "3870818559";
(* A decimal between 2^63 and 2^64 is its bit pattern, as hex is; one past
2^64, or a negative one past the smallest i64, is still malformed. *)
reads "u64 decimal" "18446744073709551615" "18446744073709551615";
reads "hex top bit" "0xFFFFFFFFFFFFFFFF" "0xFFFFFFFFFFFFFFFF";
rejects "decimal past 2^64" "18446744073709551616"
~needle:"malformed integer literal";
rejects "negative decimal past i64" "-9223372036854775809"
~needle:"malformed integer literal";
reads "string" "\"SAND\"" "\"SAND\"";
reads "symbol" "empty-at?" "empty-at?";
reads "qualified" "rl/draw-fps" "rl/draw-fps";
@ -6042,6 +6050,58 @@ let () =
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)))";
(* A type expression in a type position, generic or not. *)
accepts "vec-new over a slice of a type variable"
"(defn f [x [$t]] i32 (let [v (vec-new [$t])] (push v x) \
(let [n (length v)] (free v) n)))";
rejects_check "map-new with a key type expression and no value type"
~needle:"(map-new) names a key and no value"
"(defn f [] i32 (let [m (map-new [u8])] (free m) 0))";
accepts "vec-new over a function type returning unit"
"(defn f [] i32 (let [v (vec-new (Fn [i32] ()))] (free v) 0))";
accepts "a program's own vec-new takes an array literal"
"(defn vec-new [xs [3 i32]] i32 (at xs 2)) \
(defn f [] i32 (vec-new [1 2 3]))";
accepts "builtin/vec-new over a type expression"
"(defn f [] i32 (let [v (builtin/vec-new [u8])] (free v) 0))";
(* An integer written at or above 2^63 — decimal, or hex with the top bit
set — is a u64 and nothing else, and a refusal prints it as written. *)
accepts "a wide decimal at u64"
"(defconst a u64 18446744073709551615) (defonce b u64 0xFFFFFFFFFFFFFFFF) \
(defn f [x u64] u64 (+ x 9223372036854775808)) \
(defn g [] f64 (f64 (u64 12345678901234567890)))";
accepts "a negative decimal is still a u64 bit pattern"
"(defconst a u64 -1)";
rejects_check "a wide decimal with nothing to say u64"
~needle:"18446744073709551615 does not fit in i32, the type an integer \
literal takes when nothing says otherwise — write (u64 \
18446744073709551615)"
"(defn f [] () (println 18446744073709551615))";
rejects_check "a wide decimal cast to i64"
~needle:"18446744073709551615 does not fit in i64"
"(defn f [] i64 (i64 18446744073709551615))";
rejects_check "a wide decimal cast to f64"
~needle:"write (f64 (u64 18446744073709551615))"
"(defn f [] f64 (f64 18446744073709551615))";
rejects_check "a wide decimal constant at i32"
~needle:"18446744073709551615 does not fit in i32"
"(defconst x i32 18446744073709551615)";
rejects_check "a wide decimal constant at f64"
~needle:"write (f64 (u64 12345678901234567890))"
"(defconst x f64 12345678901234567890)";
rejects_check "a wide decimal argument to an i8 parameter"
~needle:"18446744073709551600 does not fit in i8"
"(defn g [a i8] i8 a) (defn f [] i8 (g 18446744073709551600))";
rejects_check "a wide decimal operand prints as written"
~needle:"9223372036854775808 does not fit in i32"
"(defn f [] () (println (+ 1 9223372036854775808)))";
rejects_check "a hex literal with the top bit set at i32"
~needle:"0xFFFFFFFFFFFFFFFF does not fit in i32"
"(defconst x i32 0xFFFFFFFFFFFFFFFF)";
rejects_check "a hex literal with the top bit set at i64"
~needle:"0xFFFFFFFFFFFFFFFF does not fit in i64"
"(defconst x i64 0xFFFFFFFFFFFFFFFF)";
(* And a sigil on a name nothing binds is answered as the unbound variable
it is, rather than as a missing element type — with the names that *are*
bound, because inside a signature that introduces one the mistake is