From 9394a26449887bd10b739582e1c723e4f95c1b46 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 13:02:50 +0700 Subject: [PATCH] A negative literal fits no unsigned type, u64 included, and the refusal names the cast that writes its bit pattern, which a constant now folds --- TODO.org | 11 ++++---- lib/check.ml | 65 +++++++++++++++++++++++++++++++++++++++++------ test/test_flan.ml | 32 +++++++++++++++++++++-- 3 files changed, 92 insertions(+), 16 deletions(-) diff --git a/TODO.org b/TODO.org index 3e632ba1..af0ea030 100644 --- a/TODO.org +++ b/TODO.org @@ -155,8 +155,8 @@ An integer written at or above 2^63 — a decimal up to 2^64 - 1, or hex with th 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 +negative at any integer type before this; it is refused now too. 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 passed to a macro as an argument comes back wide: it crosses as an =Int= with a token in the unused @@ -1014,10 +1014,9 @@ died in the backend as a redefinition of a symbol, a message with no source location. ** DONE A u64 literal is its 64-bit pattern -The cost of accepting the pattern is that a negative decimal literal is accepted -as a =u64=, because the reader records 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= shows up. +A negative literal fits no unsigned type, u64 included; =(u64 -1)= is how the +pattern is written, and a constant folds it. Rules out a negative decimal as a +u64's bit pattern. ** DONE A folded constant does not skip the range check The folding pass makes its own call to the range test, because a global's diff --git a/lib/check.ml b/lib/check.ml index df9ca55a..489903bd 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4086,24 +4086,34 @@ and wide_literal loc ~want n 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 = +and in_range ?(pattern = false) loc k n = let bits = Types.bits k in let ok = if Types.signed k then bits = 64 || (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 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 + (* A literal at or above 2^63 is a [UInt] and never reaches here as a + literal; see [wide_literal]. [pattern] is the folded-constant path, + which holds a u64 as its 64-bit pattern and cannot tell 2^64 - 1 from + -1, so there every pattern is a u64. *) + else if bits = 64 then pattern || Int64.compare n 0L >= 0 else Int64.compare n 0L >= 0 && Int64.compare n (Int64.shift_left 1L bits) < 0 in if ok then n + else if Int64.compare n 0L < 0 && not (Types.signed k) then + (* A negative number at an unsigned type is never the value it reads as. + The cast is how to ask for the bit pattern, and names what it is. *) + let mask = + if bits = 64 then -1L else Int64.sub (Int64.shift_left 1L bits) 1L + in + let tn = Types.ikind_name k in + Loc.failk literal_at_want loc + "%Ld does not fit in %s, which holds no negative number — write (%s %Ld) \ + for the %s with the same bits, %Lu" + n tn tn n tn (Int64.logand n mask) else Loc.failk literal_at_want loc "%Ld does not fit in %s" n (Types.ikind_name k) @@ -5885,6 +5895,15 @@ and numbers_disagree : 'a. ctx -> (Ast.expr * Types.t) list -> 'a = | Some p -> p | None -> List.nth elems (List.length elems - 1) in + (* An integer literal beside an integer type it does not fit — -1 beside a + u64 — is that literal's own refusal, which names the cast. *) + let literal_refusal (lit : Ast.expr) t = + match lit.Ast.e, t with + | Ast.Int _, Types.Int _ -> ignore (check ctx ~want:t lit) + | _ -> () + in + literal_refusal second t1; + literal_refusal first t2; let target, moved, moved_ty, other = match t1, t2 with | Types.Int _, Types.Float _ -> t2, first, t1, second @@ -11110,6 +11129,22 @@ let rec const_int env (e : Ast.expr) : int64 option = | Ast.Int n -> Some n | Ast.Byte b -> Some (Int64.of_int b) | Ast.Var n -> Hashtbl.find_opt env.consts n + | Ast.Call ({ Ast.e = Ast.Var "-"; _ }, [ x ]) -> + Option.map Int64.neg (const_int env x) + (* A conversion to an integer type, which is how a negative number is + written as an unsigned constant's bit pattern: [(u64 -1)]. Truncated to + the type's width and extended by its sign, as the cast does at run time. *) + | Ast.Call ({ Ast.e = Ast.Var k; _ }, [ x ]) + when Types.ikind_of_name k <> None -> + let k = Option.get (Types.ikind_of_name k) in + let bits = Types.bits k in + Option.map + (fun n -> + if bits = 64 then n + else if Types.signed k then + Int64.shift_right (Int64.shift_left n (64 - bits)) (64 - bits) + else Int64.logand n (Int64.sub (Int64.shift_left 1L bits) 1L)) + (const_int env x) (* Left to right over any number of operands, because that is how the checker reads the same form: an array length that type-checks as a product of three literals and is then not a constant would be a @@ -12157,12 +12192,26 @@ let check_global env (d : Ast.decl) : Tast.global option = than the expression it came from: a global's initialiser has to be a compile-time constant, and [(/ screen-height cell-size)] is one — the folding pass is the only thing that knows it. *) + (* A folded conversion is still a value of the type it converts to. *) + (match v.Ast.e, ty with + | Ast.Call ({ Ast.e = Ast.Var c; _ }, [ _ ]), Types.Int kind + when (match Types.ikind_of_name c with + | Some k -> + k <> kind + && not (Types.widens_to ~from:(Types.Int k) ~into:(Types.Int kind)) + | None -> false) -> + fail v.Ast.loc "expected %s, found %s" (Types.ikind_name kind) c + | _ -> ()); let ginit = match Hashtbl.find_opt env.consts n, ty with | Some k, Types.Int kind -> (* Still range-checked: this path skips [check], and [in_range] is the only thing that rejects 300 as a u8. *) - { Tast.e = Tast.Int (in_range d.Ast.dloc kind k, kind); ty; + { Tast.e = + Tast.Int + (in_range + ~pattern:(match v.Ast.e with Ast.Int _ -> false | _ -> true) + v.Ast.loc kind k, kind); ty; loc = d.Ast.dloc } | _ -> check (ctx ()) ~want:ty v in diff --git a/test/test_flan.ml b/test/test_flan.ml index 54ce96ab..0b8d1381 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -6227,8 +6227,36 @@ let () = "(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)"; + (* A negative literal fits no unsigned type, wherever the type comes from; + the cast the refusal names is how to write the bit pattern. *) + List.iter + (fun (what, src, needle) -> rejects_check what src ~needle) + [ ("a negative literal at a u64 constant", "(defconst a u64 -1)", + "-1 does not fit in u64, which holds no negative number — write \ + (u64 -1) for the u64 with the same bits, 18446744073709551615"); + ("a negative literal at a u32 global", "(defonce g u32 -5)", + "write (u32 -5) for the u32 with the same bits, 4294967291"); + ("a negative literal as a u64 return", "(defn f [] u64 -1)", + "-1 does not fit in u64"); + ("a negative literal as a u32 argument", + "(defn t [x u32] u32 x) (defn f [] u32 (t -2))", "-2 does not fit in u32"); + ("a negative literal in a u8 field", + "(defstruct S [a u8]) (defn f [] S (S -3))", "write (u8 -3)"); + ("a negative literal given a u64 by the", + "(defn f [] i32 (let [a (the u64 -1)] 0))", "-1 does not fit in u64"); + ("a negative literal beside a u64-only literal", + "(defn f [] i32 (let [a [-1 18446744073709551615]] 0))", + "write (u64 -1) for the u64"); + ("a negative literal beside a u64 element", + "(defn f [x u64] i32 (let [a [x -1]] 0))", "write (u64 -1) for the u64") ]; + accepts "the casts those refusals name compile" + "(defconst a u64 (u64 -1)) (defonce g u32 (u32 -5)) \ + (defstruct S [a u8]) (defn f [x u64] S \ + (let [a [(u64 -1) 18446744073709551615] b [x (u64 -1)] \ + c (the u64 (u64 -1))] \ + (S (u8 -3))))"; + rejects_check "a folded constant's conversion is still its type" + "(defconst a u8 (i32 5))" ~needle:"expected u8, found i32"; 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 \