From 6c9635cd53188e1f33c4801533d1f7bcef37ba89 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 10:26:03 +0700 Subject: [PATCH] A wide literal is refused for its range as an enum member, names the u64 cast where a dyn is wanted, and comes back wide from a macro --- TODO.org | 20 +++++++++++++++++--- lib/check.ml | 6 ++++++ lib/expand.ml | 30 ++++++++++++++++++++++++++---- lib/parse.ml | 10 ++++++++++ test/test_flan.ml | 19 +++++++++++++++++++ 5 files changed, 78 insertions(+), 7 deletions(-) diff --git a/TODO.org b/TODO.org index 6ab697d9..c94d08a4 100644 --- a/TODO.org +++ b/TODO.org @@ -161,9 +161,23 @@ 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=. +=(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 +second payload word (=Expand.wides=). Rules out a second integer case in the +prelude's =Form=. + +** DONE A wide literal's follow-ups: an enum member, a dyn want, a macro +CLOSED: [2026-09-25] +=(defenum E [A 0xFFFFFFFFFFFFFFFF])= gets the enum range refusal in the spelling +written. A wide literal where a =dyn= is wanted names =(u64 ...)= and says the dyn +holds it as the i64 with the same bits. A wide literal passed through a macro is +refused or accepted exactly as it would be unexpanded. + +** TODO A wide literal written inside a quasiquote comes back as an i64 +=(defmacro w [] `(+ 1 0xFFFFFFFFFFFFFFFF))= expands to =(+ 1 -1)= and prints 0: +=Expand.quote= builds =(Form.Int {.i ...})= from the pattern, and a Form built in +Flan has no way to carry the token an argument crosses with. At a =u64= want the +pattern is the right value, so a refusal would break the one reading that works. ** DONE {.row .col} binds same-named locals CLOSED: [2026-09-20] diff --git a/lib/check.ml b/lib/check.ml index 2ddd068d..40a65e3c 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3846,6 +3846,12 @@ and wide_literal loc ~want n s = "%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 Types.Dyn -> + Loc.failk literal_at_want loc + "expected dyn, found the integer literal %s, which only a u64 holds — a \ + dyn integer is an i64. Write (u64 %s) for the u64, which a dyn holds as \ + the i64 with the same bits, %Ld" + s s n | Some other -> Loc.failk literal_at_want loc "expected %s, found the integer literal %s, which only a u64 holds" diff --git a/lib/expand.ml b/lib/expand.ml index 98bbfe94..8ecc3754 100644 --- a/lib/expand.ml +++ b/lib/expand.ml @@ -78,6 +78,19 @@ let tag_of_int = function type sites = (Dynload.addr, Loc.t) Hashtbl.t +(* ── A wide literal's round trip ─────────────────────────────────── + A macro's [Form] has one integer case, so a literal at or above 2^63 crosses + as its bit pattern in [Int]'s payload. What marks it as wide is the second + payload word, which [Int] does not use and which a macro that passes the + form through copies along with the rest of its 24 bytes: [write] puts a + token there naming the literal's spelling in this table, and [unmarshal] + turns a node carrying one back into the [UInt] that went in. An [Int] the + macro built itself has no token, and is the [Int] it says it is. One table + per call, as [sites] is. *) +let wide_mark = 0x5749444500000000L + +let wides : (int64, int64 * string) Hashtbl.t ref = ref (Hashtbl.create 1) + (* Into an existing 24 bytes, which is what an argument array needs: the macro takes a [Form] slice, and a slice is contiguous elements and not an array of pointers — so this writes *into* memory the caller took, and every caller @@ -114,9 +127,13 @@ 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 + (* Crosses as an [Int] carrying a token; see [wides]. *) + | Form.UInt (i, text) -> + tag TInt; + Dynload.poke_i64 p payload i; + let token = Int64.logor wide_mark (Int64.of_int (Hashtbl.length !wides)) in + Hashtbl.replace !wides token (i, text); + Dynload.poke_i64 p len_off token | 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 @@ -167,7 +184,11 @@ let rec unmarshal ~(sites : sites) ~loc (p : Dynload.addr) : Form.t = unmarshal ~sites ~loc (Nativeint.add b (Nativeint.of_int (i * form_size)))) in match tag_of_int (Dynload.peek_i32 p 0) with - | TInt -> Form.make (Form.Int (Dynload.peek_i64 p payload)) loc + | TInt -> + let i = Dynload.peek_i64 p payload in + (match Hashtbl.find_opt !wides (Dynload.peek_i64 p len_off) with + | Some (w, text) when Int64.equal w i -> Form.make (Form.UInt (i, text)) loc + | _ -> Form.make (Form.Int i) loc) | TFloat -> Form.make (Form.Float (Dynload.peek_f64 p payload)) loc | TByte -> Form.make (Form.Byte (Int32.to_int (Dynload.peek_i32 p payload) land 0xff)) loc @@ -191,6 +212,7 @@ let call ~loc (fn : Dynload.addr) (args : Form.t list) : Form.t = handed to a second allocation while the table still holds it, and the table is dropped the moment this returns either way. *) let sites : sites = Hashtbl.create 8 in + wides := Hashtbl.create 1; let a = Dynload.take (max (n * form_size) 1) in List.iteri (fun i x -> write sites (Nativeint.add a (Nativeint.of_int (i * form_size))) x) diff --git a/lib/parse.ml b/lib/parse.ml index c54c47d3..931caf4d 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -1645,6 +1645,16 @@ let rec decl (f : Form.t) : Ast.decl = i32 by the time it is incremented, so the sum cannot overflow. *) let k = fits m loc ~explicit:true k in (m, k, true, loc) :: members (Int64.add k 1L) rest + (* At or above 2^63, so its [int64] is a bit pattern and not the + number written; refused in the spelling it was written in. *) + | ({ v = Form.Sym m; _ } as mf) :: { v = Form.UInt (_, text); loc = vloc } + :: _ -> + no_sigil mf; + Loc.failk "parse/enum-value-out-of-range" vloc + "the member %s of %s is %s, which does not fit i32 — an enum's \ + members run from -2147483648 to 2147483647. Give %s a value in \ + that range, or use a defconst" + m ename text m | ({ v = Form.Sym m; loc } as mf) :: rest -> no_sigil mf; let next = fits m loc ~explicit:false next in diff --git a/test/test_flan.ml b/test/test_flan.ml index 6da7418c..758848c1 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -6356,6 +6356,25 @@ let () = contains n.Loc.nmsg "this array's first element is u8") d.Loc.notes)); + (* ── A wide literal's follow-ups ──────────────────────────────── *) + parse_rejects "a wide enum member is refused for its range" + "(defenum E [A 0xFFFFFFFFFFFFFFFF B])" + ~needle:"the member A of E is 0xFFFFFFFFFFFFFFFF, which does not fit i32"; + rejects_check "a wide literal in a dyn global names the u64 cast" + "(defonce big 0xFFFFFFFFFFFFFFFF)" + ~needle:"Write (u64 0xFFFFFFFFFFFFFFFF) for the u64"; + accepts "the cast the dyn refusal names compiles" + "(defonce big (u64 0xFFFFFFFFFFFFFFFF))"; + (* A macro's Form has one integer case; the literal comes back wide all the + same, and is refused where it would have been refused unexpanded. *) + rejects_check "a wide literal through a macro is still wide" + "(defmacro idm [x] x) \ + (defn f [] i32 (+ 1 (idm 0xFFFFFFFFFFFFFFFF)))" + ~needle:"0xFFFFFFFFFFFFFFFF does not fit in i32"; + accepts "a wide literal through a macro is still a u64" + "(defmacro idm [x] x) \ + (defn f [] u64 (idm 18446744073709551615))"; + (* ── The acceptance program checks end to end ──────────────────── *) accepts "calc-me.flan type checks" (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all);