A duplicate literal arm is one whose value equals an earlier arm's at the scrutinee's type, and a literal no dyn holds is refused with a pattern fix

This commit is contained in:
Joseph Ferano 2026-09-25 21:01:15 +07:00
parent 9e09375d7b
commit 76b2ab3113
2 changed files with 103 additions and 45 deletions

View File

@ -8110,8 +8110,15 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
match e.Ast.e with
| Ast.Int n -> Int64.to_string n
| Ast.UInt (_, t) -> t
| Ast.Float x when Float.is_integer x -> Printf.sprintf "%.1f" x
| Ast.Float x -> Printf.sprintf "%g" x
| Ast.Float x when Float.is_integer x && Float.abs x < 1e15 ->
Printf.sprintf "%.1f" x
| Ast.Float x ->
(* The shortest spelling that reads back as the same float. *)
let rec go p =
let t = Printf.sprintf "%.*g" p x in
if p >= 17 || float_of_string t = x then t else go (p + 1)
in
go 1
| Ast.Byte b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
| Ast.Byte b -> string_of_int b
| Ast.Str t -> Printf.sprintf "%S" t
@ -8132,6 +8139,7 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
in
(* The checked literal of each literal arm, by the key [resolve_pat] gave it. *)
let lits : (string, Tast.expr) Hashtbl.t = Hashtbl.create 8 in
let lit_values = ref [] in
(* Which case each arm names, and the type of each name it binds. This is the
whole of what differs between the two subjects; everything below it is
shared. *)
@ -8165,54 +8173,87 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
(String.concat " " (List.map (fun (m, _) -> ":" ^ m) members))
| `Lit t, Ast.Plit e ->
let v =
match t with
(* [=]'s dyn pair checks its literal at dyn, which boxes it. *)
| Types.Dyn -> check ctx ~want:Types.Dyn e
| t ->
(match trial ctx (fun () -> check ctx ~want:t e) with
| Ok v -> v
| Error _ ->
(* A literal that does not fit is refused, where [=] would widen
the pair and let the arm quietly never match. The literal's
own refusal is not repeated: its fixes are casts, and a cast
is not a pattern. *)
let tn = Types.to_string t in
let an =
match tn.[0] with
| 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn
| _ -> "a " ^ tn
in
let why =
match e.Ast.e, t with
| Ast.Str _, _ -> "is a string"
| _, Types.String -> "is a number"
| Ast.Float x, Types.Int _ when not (Float.is_integer x) ->
"is not a whole number"
| Ast.Float _, Types.Int _ -> "is a float"
| _ -> "does not fit in one"
in
match trial ctx (fun () -> check ctx ~want:t e) with
| Ok v -> v
| Error _ ->
(* A literal that does not fit is refused, where [=] would widen
the pair and let the arm quietly never match. The literal's
own refusal is not repeated: its fixes are casts, and a cast
is not a pattern. *)
(match t with
| Types.Dyn ->
fail a.Ast.aloc
"this match is over %s, so each arm has to be %s, and %s %s. \
Change the arm to a value %s holds, or remove it"
tn an (spell e) why an)
"this match is over a dyn, which holds a number as an i64 or \
an f64, and %s fits in neither. Change the arm to a value an \
i64 holds, or remove it" (spell e)
| _ -> ());
let tn = Types.to_string t in
let an =
match tn.[0] with
| 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn
| _ -> "a " ^ tn
in
let why =
match e.Ast.e, t with
| Ast.Str _, _ -> "is a string"
| _, Types.String -> "is a number"
| Ast.Float x, Types.Int _ when not (Float.is_integer x) ->
"is not a whole number"
| Ast.Float _, Types.Int _ -> "is a float"
| _ -> "does not fit in one"
in
fail a.Ast.aloc
"this match is over %s, so each arm has to be %s, and %s %s. \
Change the arm to a value %s holds, or remove it"
tn an (spell e) why an
in
(* One key per value [=] cannot tell apart, so a second arm that could
never be reached is refused: 97 and \\a are one u8, and over a dyn
1 and 1.0 are equal, as they are over a float. *)
let key =
(* The arm's value at the scrutinee's type, and a second arm [=] could
not tell from an earlier one is refused, since it can never be
reached: 97 and \a are one u8, 0.1 and 0.10000000001 are one f32,
and over a dyn 1 and 1.0 are equal. Compared pairwise rather than
hashed, because dyn = between an integer and a float goes through
the float and is not transitive past 2^53. *)
let value =
let f32 x = Int32.float_of_bits (Int32.bits_of_float x) in
let num x =
if Float.is_integer x && Float.abs x < 0x1p62 then
Printf.sprintf "i%Ld" (Int64.of_float x)
else Printf.sprintf "f%h" x
match t with Types.Float Types.F32 -> `F (f32 x) | _ -> `F x
in
match e.Ast.e with
| Ast.Int n -> Printf.sprintf "i%Ld" n
| Ast.Byte b -> Printf.sprintf "i%d" b
| Ast.UInt (n, _) -> Printf.sprintf "u%Lu" n
| Ast.Float x -> num x
| Ast.Str t -> "s" ^ t
match e.Ast.e, t with
| Ast.Str s, _ -> `S s
| (Ast.Int n | Ast.UInt (n, _)), Types.Float _ -> num (Int64.to_float n)
| Ast.Byte b, Types.Float _ -> num (float_of_int b)
| (Ast.Int n | Ast.UInt (n, _)), _ -> `I n
| Ast.Byte b, _ -> `I (Int64.of_int b)
| Ast.Float x, _ -> num x
| _ -> assert false
in
let same x y =
match x, y with
| `I a, `I b -> Int64.equal a b
| `F a, `F b -> a = b
| `I a, `F b | `F b, `I a -> Int64.to_float a = b
| `S a, `S b -> String.equal a b
| _ -> false
in
(match List.find_opt (fun (w, _) -> same value w) !lit_values with
| Some (_, earlier) when earlier = spell e ->
fail a.Ast.aloc "this match has two %s arms" earlier
| Some (_, earlier) ->
fail a.Ast.aloc
"this match has two %s arms — %s equals it as %s, so this arm is \
never reached. Remove it"
earlier (spell e)
(match t with
| Types.Dyn -> "a dyn"
| t ->
let tn = Types.to_string t in
(match tn.[0] with
| 'a' | 'e' | 'f' | 'i' | 'o' -> "an " ^ tn
| _ -> "a " ^ tn))
| None -> ());
lit_values := (value, spell e) :: !lit_values;
let key = string_of_int (Hashtbl.length lits) in
Hashtbl.replace lits key v;
Some key, []
| `Lit t, Ast.Pkw k ->

View File

@ -4624,10 +4624,27 @@ let () =
~needle:"this match has two 5 arms";
rejects_check "a char and a number that are one u8"
"(defn f [c u8] i32 (match c \\a 1 97 2 _ 0))"
~needle:"this match has two 97 arms";
~needle:"this match has two \\a arms — 97 equals it as a u8";
rejects_check "1 and 1.0 are one arm over a dyn, as dyn = says"
"(defn f [d dyn] i32 (match d 1 1 1.0 2 _ 0))"
~needle:"this match has two 1.0 arms";
~needle:"this match has two 1 arms — 1.0 equals it as a dyn";
rejects_check "two literals that round to one f32"
"(defn f [x f32] i32 (match x 0.1 1 0.10000000001 2 _ 0))"
~needle:"this match has two 0.1 arms — 0.10000000001 equals it as an f32";
rejects_check "two integers that round to one f32"
"(defn f [x f32] i32 (match x 16777216 1 16777217 2 _ 0))"
~needle:"two 16777216 arms — 16777217 equals it as an f32";
rejects_check "an integer and a float that are one f64"
"(defn f [x f64] i32 \
(match x 4611686018427387904 1 4611686018427387904.0 2 _ 0))"
~needle:"equals it as an f64";
accepts "two f64 literals that differ"
"(defn f [x f64] i32 (match x 0.1 1 0.10000000001 2 _ 0))";
rejects_check "a literal no dyn holds"
"(defn f [x dyn] i32 (match x 18446744073709551615 1 _ 0))"
~needle:"this match is over a dyn, which holds a number as an i64 or an \
f64, and 18446744073709551615 fits in neither. Change the arm to \
a value an i64 holds, or remove it";
rejects_check "a keyword arm among literal arms"
"(defn f [n i32] i32 (match n 5 1 :lo 2 _ 0))"
~needle:":lo is an enum member, and this match is over i32, whose arms are \