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

lib/check.ml

@@ -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 when Float.is_integer x && Float.abs x < 1e15 ->
-    | Ast.Float x -> Printf.sprintf "%g" x
+      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,17 +8173,21 @@ 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
+        match trial ctx (fun () -> check ctx ~want:t e) with
-        | 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. *)
+          (match t with
+           | Types.Dyn ->
+             fail a.Ast.aloc
+               "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
@@ -8194,25 +8206,54 @@ and check_match ctx ?(tail = false) ?want loc scrutinee arms =
           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)
+            tn an (spell e) why an
       in
-      (* One key per value [=] cannot tell apart, so a second arm that could
+      (* The arm's value at the scrutinee's type, and a second arm [=] could
-         never be reached is refused: 97 and \\a are one u8, and over a dyn
+         not tell from an earlier one is refused, since it can never be
-         1 and 1.0 are equal, as they are over a float. *)
+         reached: 97 and \a are one u8, 0.1 and 0.10000000001 are one f32,
-      let key =
+         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
+          match t with Types.Float Types.F32 -> `F (f32 x) | _ -> `F x
-            Printf.sprintf "i%Ld" (Int64.of_float x)
-          else Printf.sprintf "f%h" x
         in
-        match e.Ast.e with
+        match e.Ast.e, t with
-        | Ast.Int n -> Printf.sprintf "i%Ld" n
+        | Ast.Str s, _ -> `S s
-        | Ast.Byte b -> Printf.sprintf "i%d" b
+        | (Ast.Int n | Ast.UInt (n, _)), Types.Float _ -> num (Int64.to_float n)
-        | Ast.UInt (n, _) -> Printf.sprintf "u%Lu" n
+        | Ast.Byte b, Types.Float _ -> num (float_of_int b)
-        | Ast.Float x -> num x
+        | (Ast.Int n | Ast.UInt (n, _)), _ -> `I n
-        | Ast.Str t -> "s" ^ t
+        | 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 ->

test/test_flan.ml

@@ -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 \