Untagged error messages

CHANGELOG.md

@@ -24,6 +24,7 @@
 #### :bug: Bug Fix
 
 - Fix issue where uncurried type internals leak in type error. https://github.com/rescript-lang/rescript-compiler/pull/6264
+- Improve error messages for untagged variant definitions https://github.com/rescript-lang/rescript-compiler/pull/6290
 
 
 # 11.0.0-beta.1

jscomp/build_tests/super_errors/expected/UntaggedNonUnary1.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/UntaggedNonUnary1.res:2:1-27
+
+  1 │ @unboxed
+  2 │ type t = Tuple(int, string)
+  3 │ 
+
+  This untagged variant definition is invalid: Constructor Tuple has more than one argument.

jscomp/build_tests/super_errors/expected/UntaggedNonUnary2.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/UntaggedNonUnary2.res:2:1-42
+
+  1 │ @unboxed
+  2 │ type t = Tuple(int, string) | Float(float)
+  3 │ 
+
+  This untagged variant definition is invalid: Constructor Tuple has more than one argument.

jscomp/build_tests/super_errors/expected/UntaggedUnknown.res.expected

@@ -0,0 +1,9 @@
+
+  We've found a bug for you!
+  /.../fixtures/UntaggedUnknown.res:2:10-31
+
+  1 │ @unboxed
+  2 │ type t = Tuple((float, string)) | Float(float)
+  3 │ 
+
+  This untagged variant definition is invalid: Case Tuple has a payload that is not of one of the recognized shapes (object, array, etc). Then it must be the only case with payloads.

jscomp/build_tests/super_errors/fixtures/UntaggedNonUnary1.res

@@ -0,0 +1,2 @@
+@unboxed
+type t = Tuple(int, string)

jscomp/build_tests/super_errors/fixtures/UntaggedNonUnary2.res

@@ -0,0 +1,2 @@
+@unboxed
+type t = Tuple(int, string) | Float(float)

jscomp/build_tests/super_errors/fixtures/UntaggedUnknown.res

@@ -0,0 +1,2 @@
+@unboxed
+type t = Tuple((float, string)) | Float(float)

jscomp/ml/typedecl.ml

@@ -304,38 +304,24 @@ let transl_declaration ~typeRecordAsObject env sdecl id =
   in
   let raw_status = get_unboxed_from_attributes sdecl in
 
-  let checkUntaggedVariant = match sdecl.ptype_kind with
+  let checkUntaggedVariant() = match sdecl.ptype_kind with
   | Ptype_variant cds -> Ext_list.for_all cds (function
       | {pcd_args = Pcstr_tuple ([] | [_])} ->
         (* at most one payload allowed for untagged  variants *)
         true
+      | {pcd_args = Pcstr_tuple (_::_::_); pcd_name={txt=name}} ->
+        Ast_untagged_variants.reportConstructorMoreThanOneArg ~loc:sdecl.ptype_loc ~name
       | {pcd_args = Pcstr_record _} -> true
-      | _ -> false )
+     )
   | _ -> false
   in
 
-  if raw_status.unboxed && not raw_status.default && not checkUntaggedVariant then begin
+  if raw_status.unboxed && not raw_status.default && not (checkUntaggedVariant()) then begin
     match sdecl.ptype_kind with
     | Ptype_abstract ->
         raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
                       "it is abstract"))
-    | Ptype_variant [{pcd_args = Pcstr_tuple []; _}] ->
-      raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
-                    "its constructor has no argument"))
-    | Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}] -> ()
-    | Ptype_variant [{pcd_args = Pcstr_tuple _; _}] ->
-      raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
-                    "its constructor has more than one argument"))
-    | Ptype_variant [{pcd_args = Pcstr_record
-                        [{pld_mutable=Immutable; _}]; _}] -> ()
-    | Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Mutable; _}]; _}] ->
-      raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute "it is mutable"))
-    | Ptype_variant [{pcd_args = Pcstr_record _; _}] ->
-      raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
-                    "its constructor has more than one argument"))
-    | Ptype_variant _ ->
-      raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute
-                    "it has more than one constructor"))
+    | Ptype_variant _ -> ()
     | Ptype_record [{pld_mutable=Immutable; _}] -> ()
     | Ptype_record [{pld_mutable=Mutable; _}] ->
       raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute