diff --git a/TODO.org b/TODO.org index 3ea45b08..5ab4afe7 100644 --- a/TODO.org +++ b/TODO.org @@ -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 diff --git a/lib/ast.ml b/lib/ast.ml index c49e9e36..f3677360 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -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) diff --git a/lib/check.ml b/lib/check.ml index a127a542..f81e1479 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -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 diff --git a/lib/emit.ml b/lib/emit.ml index c4d380e9..4b49fb25 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -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. *) diff --git a/lib/expand.ml b/lib/expand.ml index 017bfe73..98bbfe94 100644 --- a/lib/expand.ml +++ b/lib/expand.ml @@ -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)) diff --git a/lib/form.ml b/lib/form.ml index b16ace01..2eda0357 100644 --- a/lib/form.ml +++ b/lib/form.ml @@ -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 diff --git a/lib/load.ml b/lib/load.ml index 96629722..cac0d6c6 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -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) -> diff --git a/lib/macro.ml b/lib/macro.ml index 177b4c34..b31ed83a 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -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 diff --git a/lib/parse.ml b/lib/parse.ml index 456c8a8b..acc61a0f 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -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 diff --git a/lib/prelude.ml b/lib/prelude.ml index ee7e83e9..29dbfe74 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -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))}))) diff --git a/lib/reader.ml b/lib/reader.ml index 0e098a79..40890424 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -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 diff --git a/lib/x86.ml b/lib/x86.ml index c546b4e5..b0f12a2d 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -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; diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index f295fa44..1332d9f6 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -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 diff --git a/test/programs/arith-condition.flan b/test/programs/arith-condition.flan index 62ba1381..78bd2019 100644 --- a/test/programs/arith-condition.flan +++ b/test/programs/arith-condition.flan @@ -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)) diff --git a/test/programs/arith.flan b/test/programs/arith.flan index 71b747c4..9a9d0601 100644 --- a/test/programs/arith.flan +++ b/test/programs/arith.flan @@ -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)) diff --git a/test/programs/macro-gensym-rounds.flan b/test/programs/macro-gensym-rounds.flan new file mode 100644 index 00000000..74584556 --- /dev/null +++ b/test/programs/macro-gensym-rounds.flan @@ -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)))) diff --git a/test/programs/recur.flan b/test/programs/recur.flan index 5c6f32a0..e03cf332 100644 --- a/test/programs/recur.flan +++ b/test/programs/recur.flan @@ -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) diff --git a/test/programs/u64-decimal.flan b/test/programs/u64-decimal.flan new file mode 100644 index 00000000..00b0c92a --- /dev/null +++ b/test/programs/u64-decimal.flan @@ -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) diff --git a/test/programs/vec-new-shadow.flan b/test/programs/vec-new-shadow.flan new file mode 100644 index 00000000..9be6e154 --- /dev/null +++ b/test/programs/vec-new-shadow.flan @@ -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) diff --git a/test/programs/vec-new-type.flan b/test/programs/vec-new-type.flan new file mode 100644 index 00000000..5d338a70 --- /dev/null +++ b/test/programs/vec-new-type.flan @@ -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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 2e7b708b..f3677f73 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -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 diff --git a/test/test_flan.ml b/test/test_flan.ml index 3c606aef..d39a06df 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -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