Word signature mismatch errors in ReScript terms

changes/inclusion-error-wording.polish.md

@@ -0,0 +1 @@
+- Signature mismatch errors name variant constructors as constructors, write functor positions and quotes in ReScript syntax, and print `type t += A` with a single space.

compiler/ml/includecore.ml

@@ -179,6 +179,10 @@ type type_mismatch =
   | Field_arity of Ident.t
   | Field_names of int * string * string
   | Field_missing of bool * Ident.t
+  | Constructor_type of Ident.t
+  | Constructor_arity of Ident.t
+  | Constructor_names of int * string * string
+  | Constructor_missing of bool * Ident.t
   | Record_representation of record_representation * record_representation
   | Unboxed_representation of bool (* true means second one is unboxed *)
   | Immediate
@@ -208,6 +212,16 @@ let report_type_mismatch0 first second decl ppf err =
     pr "The field %s is only present in %s %s" (Ident.name s)
       (if b then second else first)
       decl
+  | Constructor_type s ->
+    pr "The types for constructor %s are not equal" (Ident.name s)
+  | Constructor_arity s ->
+    pr "The arities for constructor %s differ" (Ident.name s)
+  | Constructor_names (n, name1, name2) ->
+    pr "Constructors number %i have different names, %s and %s" n name1 name2
+  | Constructor_missing (b, s) ->
+    pr "The constructor %s is only present in %s %s" (Ident.name s)
+      (if b then second else first)
+      decl
   | Record_representation (_rep1, _rep2) ->
     pr "Their internal representations differ"
   | Unboxed_representation b ->
@@ -237,26 +251,26 @@ let report_type_mismatch first second decl ppf =
 let rec compare_constructor_arguments env cstr params1 params2 arg1 arg2 =
   match (arg1, arg2) with
   | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
-    if List.length arg1 <> List.length arg2 then [Field_arity cstr]
+    if List.length arg1 <> List.length arg2 then [Constructor_arity cstr]
     else if
       (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
       Ctype.equal env true (params1 @ arg1) (params2 @ arg2)
     then []
-    else [Field_type cstr]
+    else [Constructor_type cstr]
   | Types.Cstr_record l1, Types.Cstr_record l2 ->
     compare_records env params1 params2 0 l1 l2
-  | _ -> [Field_type cstr]
+  | _ -> [Constructor_type cstr]
 
 and compare_variants ~loc env params1 params2 ~layout1 ~layout2 n
     (cstrs1 : Types.constructor_declaration list)
     (cstrs2 : Types.constructor_declaration list) =
   match (cstrs1, cstrs2) with
   | [], [] -> []
-  | [], c :: _ -> [Field_missing (true, c.Types.cd_id)]
-  | c :: _, [] -> [Field_missing (false, c.Types.cd_id)]
+  | [], c :: _ -> [Constructor_missing (true, c.Types.cd_id)]
+  | c :: _, [] -> [Constructor_missing (false, c.Types.cd_id)]
   | cd1 :: rem1, cd2 :: rem2 ->
     if Ident.name cd1.cd_id <> Ident.name cd2.cd_id then
-      [Field_names (n, cd1.cd_id.name, cd2.cd_id.name)]
+      [Constructor_names (n, cd1.cd_id.name, cd2.cd_id.name)]
     else (
       Builtin_attributes.check_deprecated_inclusion ~def:cd1.cd_loc
         ~use:cd2.cd_loc loc cd1.cd_attributes cd2.cd_attributes
@@ -267,8 +281,8 @@ and compare_variants ~loc env params1 params2 ~layout1 ~layout2 n
           if Ctype.equal env true [r1] [r2] then
             compare_constructor_arguments env cd1.cd_id [r1] [r2] cd1.cd_args
               cd2.cd_args
-          else [Field_type cd1.cd_id]
-        | Some _, None | None, Some _ -> [Field_type cd1.cd_id]
+          else [Constructor_type cd1.cd_id]
+        | Some _, None | None, Some _ -> [Constructor_type cd1.cd_id]
         | _ ->
           compare_constructor_arguments env cd1.cd_id params1 params2
             cd1.cd_args cd2.cd_args

compiler/ml/includecore.mli

@@ -33,6 +33,10 @@ type type_mismatch =
   | Field_arity of Ident.t
   | Field_names of int * string * string
   | Field_missing of bool * Ident.t
+  | Constructor_type of Ident.t
+  | Constructor_arity of Ident.t
+  | Constructor_names of int * string * string
+  | Constructor_missing of bool * Ident.t
   | Record_representation of record_representation * record_representation
   | Unboxed_representation of bool
   | Immediate

compiler/ml/includemod.ml

@@ -543,7 +543,7 @@ let show_arity_mismatch env ppf (d1 : value_description)
 
 let include_symptom env ppf = function
   | Missing_field (id, loc, kind) ->
-    fprintf ppf "The %s `%a' is required but not provided" kind ident id;
+    fprintf ppf "The %s `%a` is required but not provided" kind ident id;
     show_loc "Expected declaration" ppf loc
   | Value_descriptions (id, d1, d2) ->
     fprintf ppf
@@ -588,21 +588,16 @@ let rec context ppf = function
   | Module id :: rem -> fprintf ppf "@[<2>module %a%a@]" ident id args rem
   | Modtype id :: rem ->
     fprintf ppf "@[<2>module type %a =@ %a@]" ident id context_mty rem
-  | Body x :: rem ->
-    fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
-  | Arg x :: rem ->
-    fprintf ppf "functor (%a : %a) -> ..." ident x context_mty rem
+  | Body x :: rem -> fprintf ppf "(%s) =>@ %a" (argname x) context_mty rem
+  | Arg x :: rem -> fprintf ppf "(%a:@ %a) => ..." ident x context_mty rem
   | [] -> fprintf ppf "<here>"
 
 and context_mty ppf = function
   | (Module _ | Modtype _) :: _ as rem ->
-    fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+    fprintf ppf "@[<2>{@ %a@;<1 -2>}@]" context rem
   | cxt -> context ppf cxt
 
-and args ppf = function
-  | Body x :: rem -> fprintf ppf "(%s)%a" (argname x) args rem
-  | Arg x :: rem -> fprintf ppf "(%a :@ %a) : ..." ident x context_mty rem
-  | cxt -> fprintf ppf " :@ %a" context_mty cxt
+and args ppf cxt = fprintf ppf ":@ %a" context_mty cxt
 
 and argname x =
   let s = Ident.name x in

compiler/syntax/src/res_outcome_printer.ml

@@ -889,7 +889,7 @@ and print_out_extension_constructor_doc
          Doc.text "type ";
          Printer.print_ident_like ~allow_uident:false out_ext.oext_type_name;
          type_params;
-         Doc.text " += ";
+         Doc.text " +=";
          Doc.line;
          (if out_ext.oext_private = Asttypes.Private then Doc.text "private "
           else Doc.nil);

tests/build_tests/super_errors/expected/functor_apply_arg_mismatch.res.expected

@@ -15,6 +15,6 @@
     }
   is not included in
     HasFoo
-  The value `foo' is required but not provided
+  The value `foo` is required but not provided
   /.../fixtures/functor_apply_arg_mismatch.res:2:3-14:
     Expected declaration

tests/build_tests/super_errors/expected/functor_signature_mismatch.res.expected

@@ -0,0 +1,53 @@
+
+  We've found a bug for you!
+  /.../fixtures/functor_signature_mismatch.res:7:5-11:1
+
+   5 │ module M: {
+   6 │   module F: (X: S) => (S with type t = X.t)
+   7 │ } = {
+   8 │   module F = (X: S) => {
+   9 │     type t = int
+  10 │   }
+  11 │ }
+  12 │ 
+
+  Signature mismatch:
+  Modules do not match:
+    {
+      module F: (X: S) => {
+        type t = int
+      }
+    }
+  is not included in
+    {
+      module F: (X: S) => {
+        type t = X.t
+      }
+    }
+  In module F:
+  Modules do not match:
+    (X: S) => {
+      type t = int
+    }
+  is not included in
+    (X: S) => {
+      type t = X.t
+    }
+  At position module F: (X) => <here>
+  Modules do not match:
+    {
+      type t = int
+    }
+  is not included in
+    {
+      type t = X.t
+    }
+  At position module F: (X) => <here>
+  Type declarations do not match:
+    type t = int
+  is not included in
+    type t = X.t
+  /.../fixtures/functor_signature_mismatch.res:6:36:
+    Expected declaration
+  /.../fixtures/functor_signature_mismatch.res:9:5-16:
+    Actual declaration

tests/build_tests/super_errors/expected/gadt_constructor_signature_mismatch.res.expected

@@ -0,0 +1,22 @@
+
+  We've found a bug for you!
+  /.../fixtures/gadt_constructor_signature_mismatch.res:3:5-5:1
+
+  1 │ module M: {
+  2 │   type rec t<_> = Int(int): t<int> | Str(string): t<string>
+  3 │ } = {
+  4 │   type rec t<_> = Int(int): t<int> | Str(string): t<int>
+  5 │ }
+  6 │ 
+
+  Signature mismatch:
+  ...
+  Type declarations do not match:
+    type t<_> = Int(int): t<int> | Str(string): t<int>
+  is not included in
+    type t<_> = Int(int): t<int> | Str(string): t<string>
+  /.../fixtures/gadt_constructor_signature_mismatch.res:2:3-59:
+    Expected declaration
+  /.../fixtures/gadt_constructor_signature_mismatch.res:4:3-56:
+    Actual declaration
+  The types for constructor Str are not equal.

tests/build_tests/super_errors/expected/include_extension_constructors_mismatch.res.expected

@@ -22,9 +22,9 @@
       type t += E(int)
     }
   Extension declarations do not match:
-    type t +=  E(string)
+    type t += E(string)
   is not included in
-    type t +=  E(int)
+    type t += E(int)
   /.../fixtures/include_extension_constructors_mismatch.res:3:13-18:
     Expected declaration
   /.../fixtures/include_extension_constructors_mismatch.res:6:13-21:

tests/build_tests/super_errors/expected/include_missing_field.res.expected

@@ -19,6 +19,6 @@
       let x: int
       let y: string
     }
-  The value `y' is required but not provided
+  The value `y` is required but not provided
   /.../fixtures/include_missing_field.res:3:3-15:
     Expected declaration

tests/build_tests/super_errors/fixtures/functor_signature_mismatch.res

@@ -0,0 +1,11 @@
+module type S = {
+  type t
+}
+
+module M: {
+  module F: (X: S) => (S with type t = X.t)
+} = {
+  module F = (X: S) => {
+    type t = int
+  }
+}

tests/build_tests/super_errors/fixtures/gadt_constructor_signature_mismatch.res

@@ -0,0 +1,5 @@
+module M: {
+  type rec t<_> = Int(int): t<int> | Str(string): t<string>
+} = {
+  type rec t<_> = Int(int): t<int> | Str(string): t<int>
+}

tests/build_tests/super_errors_multi/expected/Iface_extension_constructors.expected

@@ -6,9 +6,9 @@
   The implementation /.../fixtures/Iface_extension_constructors/Foo.res
   does not match the interface /.../fixtures/Iface_extension_constructors/foo.cmi:
   Extension declarations do not match:
-    type t +=  Boom(string)
+    type t += Boom(string)
   is not included in
-    type t +=  Boom(int)
+    type t += Boom(int)
   /.../fixtures/Iface_extension_constructors/Foo.res:
     Expected declaration
   /.../fixtures/Iface_extension_constructors/Foo.res:4:3-16:

tests/build_tests/super_errors_multi/expected/Iface_field_arity_mismatch.expected

@@ -16,4 +16,4 @@
     Expected declaration
   /.../fixtures/Iface_field_arity_mismatch/Foo.res:1:1-19:
     Actual declaration
-  The arities for field A differ.
+  The arities for constructor A differ.

tests/build_tests/super_errors_multi/expected/Iface_missing_value.expected

@@ -9,6 +9,6 @@
 
   The implementation /.../fixtures/Iface_missing_value/Foo.res
   does not match the interface /.../fixtures/Iface_missing_value/foo.cmi:
-  The value `b' is required but not provided
+  The value `b` is required but not provided
   /.../fixtures/Iface_missing_value/Foo.resi:2:1-13:
     Expected declaration

tests/build_tests/super_errors_multi/expected/Iface_type_decl_variant.expected

@@ -18,4 +18,4 @@
     Expected declaration
   /.../fixtures/Iface_type_decl_variant/Foo.res:1:1-3:13:
     Actual declaration
-  The types for field B are not equal.
+  The types for constructor B are not equal.

tests/build_tests/super_errors_multi/expected/Iface_variant_extra_constructor.expected

@@ -16,4 +16,4 @@
     Expected declaration
   /.../fixtures/Iface_variant_extra_constructor/Foo.res:1:1-18:
     Actual declaration
-  The field C is only present in the first declaration.
+  The constructor C is only present in the first declaration.