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

@@ -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
+negative at any integer type before this; it is refused now too. A cast's
-decimal is still a =u64= bit pattern. A cast's integer literal that does not fit
+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
+A negative literal fits no unsigned type, u64 included; =(u64 -1)= is how the
-as a =u64=, because the reader records the value and not how it was written.
+pattern is written, and a constant folds it. Rules out a negative decimal as a
-Narrower unsigned types keep the strict check, which is where a typo like =300=
+u64's bit pattern.
-for a =u8= shows up.
 
 ** 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

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 as a
-      (* A literal at or above 2^63 is a [UInt] and never reaches here; see
+       literal; see [wide_literal]. [pattern] is the folded-constant path,
-         [wide_literal]. A negative decimal is accepted as a u64's bit pattern,
+       which holds a u64 as its 64-bit pattern and cannot tell 2^64 - 1 from
-         which is a settled rule. Narrower unsigned types keep the strict
+       -1, so there every pattern is a u64. *)
-         check, which is where a typo like 300 for a u8 actually shows up. *)
+    else if bits = 64 then pattern || Int64.compare n 0L >= 0
-      true
     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

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"
+  (* A negative literal fits no unsigned type, wherever the type comes from;
-    "(defconst a u64 -1)";
+     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 \