diff --git a/testsuite/tests/typing-extensions/extensions.ml b/testsuite/tests/typing-extensions/extensions.ml
index 76e63968c..3de0c41e3 100644
--- a/testsuite/tests/typing-extensions/extensions.ml
+++ b/testsuite/tests/typing-extensions/extensions.ml
@@ -296,7 +296,11 @@ Error: Signature mismatch:
          type ('a, 'b) bar += A of float
        is not included in
          type ('a, 'b) bar += A of int
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A of float
+       is not compatible with:
+         A of int
+       The types are not equal.
 |}]
 
 module M : sig
@@ -318,7 +322,11 @@ Error: Signature mismatch:
          type ('a, 'b) bar += A of 'b
        is not included in
          type ('a, 'b) bar += A of 'a
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A of 'b
+       is not compatible with:
+         A of 'a0
+       The types are not equal.
 |}]
 
 module M : sig
@@ -340,7 +348,11 @@ Error: Signature mismatch:
          type ('a, 'b) bar += A : 'd -> ('c, 'd) bar
        is not included in
          type ('a, 'b) bar += A : 'c -> ('c, 'd) bar
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A : 'd -> ('c, 'd) bar
+       is not compatible with:
+         A : 'c -> ('c, 'd) bar
+       The types are not equal.
 |}]
 
 (* Extensions can be rebound *)
diff --git a/testsuite/tests/typing-gadts/pr7160.ml b/testsuite/tests/typing-gadts/pr7160.ml
index 7e9972b1c..a615a4628 100644
--- a/testsuite/tests/typing-gadts/pr7160.ml
+++ b/testsuite/tests/typing-gadts/pr7160.ml
@@ -18,5 +18,9 @@ Lines 4-5, characters 0-77:
 4 | type 'a tt = 'a t =
 5 |   Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt..
 Error: This variant or record definition does not match that of type 'a t
-       The types for constructor Same are not equal.
+       Constructors do not match:
+         Same : 'l t -> 'l t
+       is not compatible with:
+         Same : 'l1 t -> 'l2 t
+       The types are not equal.
 |}];;
diff --git a/testsuite/tests/typing-gadts/pr7378.ml b/testsuite/tests/typing-gadts/pr7378.ml
index 365b00815..9252b43dd 100644
--- a/testsuite/tests/typing-gadts/pr7378.ml
+++ b/testsuite/tests/typing-gadts/pr7378.ml
@@ -19,7 +19,11 @@ Lines 2-3, characters 2-37:
 2 | ..type t = X.t =
 3 |     | A : 'a * 'b * ('b -> unit) -> t
 Error: This variant or record definition does not match that of type X.t
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A : 'a * 'b * ('a -> unit) -> X.t
+       is not compatible with:
+         A : 'a * 'b * ('b -> unit) -> X.t
+       The types are not equal.
 |}]
 
 (* would segfault
diff --git a/testsuite/tests/typing-misc/pr6416.ml b/testsuite/tests/typing-misc/pr6416.ml
index ae74229e0..ca8700865 100644
--- a/testsuite/tests/typing-misc/pr6416.ml
+++ b/testsuite/tests/typing-misc/pr6416.ml
@@ -50,7 +50,11 @@ Error: Signature mismatch:
          type u = A of t/1
        is not included in
          type u = A of t/2
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A of t/1
+       is not compatible with:
+         A of t/2
+       The types are not equal.
        Line 4, characters 9-19:
          Definition of type t/1
        Line 2, characters 2-11:
@@ -113,7 +117,11 @@ Error: Signature mismatch:
          type t = A of T/1.t
        is not included in
          type t = A of T/2.t
-       The types for constructor A are not equal.
+       Constructors do not match:
+         A of T/1.t
+       is not compatible with:
+         A of T/2.t
+       The types are not equal.
        Line 5, characters 6-34:
          Definition of module T/1
        Line 2, characters 2-30:
diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml
index 79f4c0af6..f4f3fea27 100644
--- a/testsuite/tests/typing-misc/records.ml
+++ b/testsuite/tests/typing-misc/records.ml
@@ -208,7 +208,11 @@ Line 2, characters 0-37:
 2 | type mut = d = {x:int; mutable y:int}
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type d
-       The mutability of field y is different.
+       Fields do not match:
+         y : int;
+       is not compatible with:
+         mutable y : int;
+       This is mutable and the original is not.
 |}]
 
 type missing = d = { x:int }
@@ -226,7 +230,11 @@ Line 1, characters 0-31:
 1 | type wrong_type = d = {x:float}
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type d
-       The types for field x are not equal.
+       Fields do not match:
+         x : int;
+       is not compatible with:
+         x : float;
+       The types are not equal.
 |}]
 
 type unboxed = d = {x:float} [@@unboxed]
@@ -245,5 +253,5 @@ Line 1, characters 0-30:
 1 | type perm = d = {y:int; x:int}
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type d
-       Fields number 1 have different names, x and y.
+       1st fields have different names, x and y.
 |}]
diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml
index b68f3cb5c..eb0f2869d 100644
--- a/testsuite/tests/typing-misc/variant.ml
+++ b/testsuite/tests/typing-misc/variant.ml
@@ -96,7 +96,11 @@ Line 1, characters 0-32:
 1 | type wrong_type = d = X of float
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type d
-       The types for constructor X are not equal.
+       Constructors do not match:
+         X of int
+       is not compatible with:
+         X of float
+       The types are not equal.
 |}]
 
 type unboxed = d = X of float [@@unboxed]
@@ -115,7 +119,7 @@ Line 1, characters 0-35:
 1 | type perm = d = Y of int | X of int
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type d
-       Constructors number 1 have different names, X and Y.
+       1st constructors have different names, X and Y.
 |}]
 
 module M : sig
@@ -137,5 +141,9 @@ Error: Signature mismatch:
          type t = Foo : int -> t
        is not included in
          type t = Foo of int
+       Constructors do not match:
+         Foo : int -> t
+       is not compatible with:
+         Foo of int
        The first has explicit return type and the second doesn't.
 |}]
diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml
index 66e745cb3..4570ce3cd 100644
--- a/testsuite/tests/typing-modules/Test.ml
+++ b/testsuite/tests/typing-modules/Test.ml
@@ -95,7 +95,11 @@ Line 3, characters 23-33:
 3 | module type B = A with type t = u;; (* fail *)
                            ^^^^^^^^^^
 Error: This variant or record definition does not match that of type u
-       The types for constructor X are not equal.
+       Constructors do not match:
+         X of bool
+       is not compatible with:
+         X of int
+       The types are not equal.
 |}];;
 
 (* PR#5815 *)
@@ -141,7 +145,11 @@ Error: Signature mismatch:
          type t += E of int
        is not included in
          type t += E
-       The arities for constructor E differ.
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E
+       They have different arities.
 |}];;
 
 module M : sig type t += E of char end = struct type t += E of int end;;
@@ -158,7 +166,11 @@ Error: Signature mismatch:
          type t += E of int
        is not included in
          type t += E of char
-       The types for constructor E are not equal.
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E of char
+       The types are not equal.
 |}];;
 
 module M : sig type t += C of int end = struct type t += E of int end;;
@@ -193,5 +205,9 @@ Error: Signature mismatch:
          type t += E of int
        is not included in
          type t += E of { x : int; }
-       The types for constructor E are not equal.
+       Constructors do not match:
+         E of int
+       is not compatible with:
+         E of { x : int; }
+       The second uses inline records and the first doesn't.
 |}];;
diff --git a/testsuite/tests/typing-modules/extension_constructors_errors_test.ml b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml
index 336d2c4f6..fb4b914f1 100644
--- a/testsuite/tests/typing-modules/extension_constructors_errors_test.ml
+++ b/testsuite/tests/typing-modules/extension_constructors_errors_test.ml
@@ -19,7 +19,11 @@ Error: Signature mismatch:
          type t += F of int
        is not included in
          type t += F
-       The arities for field F differ.
+       Constructors do not match:
+         F of int
+       is not compatible with:
+         F
+       They have different arities.
 |}];;
 
 module M1 : sig type t += A end = struct type t += private A end;;
diff --git a/testsuite/tests/typing-modules/pr7818.ml b/testsuite/tests/typing-modules/pr7818.ml
index 6bc5ce146..200946ded 100644
--- a/testsuite/tests/typing-modules/pr7818.ml
+++ b/testsuite/tests/typing-modules/pr7818.ml
@@ -315,5 +315,9 @@ Line 15, characters 16-64:
 15 | module rec M1 : S' with module Term0 := Asc and module T := Desc = M1;;
                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type M.t
-       The types for constructor E are not equal.
+       Constructors do not match:
+         E of (MkT(M.T).t, MkT(M.T).t) eq
+       is not compatible with:
+         E of (MkT(Desc).t, MkT(Desc).t) eq
+       The types are not equal.
 |}]
diff --git a/testsuite/tests/typing-modules/pr7851.ml b/testsuite/tests/typing-modules/pr7851.ml
index 0d7bed71f..856fb0b7a 100644
--- a/testsuite/tests/typing-modules/pr7851.ml
+++ b/testsuite/tests/typing-modules/pr7851.ml
@@ -27,7 +27,11 @@ Line 1, characters 16-53:
 1 | module rec M1 : S with type x = int and type y = bool = M1;;
                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type M1.t
-       The types for constructor E are not equal.
+       Constructors do not match:
+         E of M1.x
+       is not compatible with:
+         E of M1.y
+       The types are not equal.
 |}]
 
 let bool_of_int x =
@@ -75,5 +79,9 @@ Line 1, characters 16-53:
 1 | module rec M1 : S with type x = int and type y = bool = M1;;
                     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This variant or record definition does not match that of type M1.t
-       The types for constructor E are not equal.
+       Constructors do not match:
+         E of (M1.x, M1.x) eq
+       is not compatible with:
+         E of (M1.x, M1.y) eq
+       The types are not equal.
 |}]
diff --git a/testsuite/tests/typing-modules/records_errors_test.ml b/testsuite/tests/typing-modules/records_errors_test.ml
index 260d715ee..19d96be6e 100644
--- a/testsuite/tests/typing-modules/records_errors_test.ml
+++ b/testsuite/tests/typing-modules/records_errors_test.ml
@@ -40,7 +40,11 @@ Error: Signature mismatch:
            f0 : unit * unit * unit * int * unit * unit * unit;
            f1 : unit * unit * unit * int * unit * unit * unit;
          }
-       The types for field f0 are not equal.
+       Fields do not match:
+         f0 : unit * unit * unit * float * unit * unit * unit;
+       is not compatible with:
+         f0 : unit * unit * unit * int * unit * unit * unit;
+       The types are not equal.
 |}];;
 
 
@@ -82,7 +86,11 @@ Error: Signature mismatch:
            mutable f0 : unit * unit * unit * int * unit * unit * unit;
            f1 : unit * unit * unit * int * unit * unit * unit;
          }
-       The mutability of field f0 is different.
+       Fields do not match:
+         f0 : unit * unit * unit * float * unit * unit * unit;
+       is not compatible with:
+         mutable f0 : unit * unit * unit * int * unit * unit * unit;
+       The second is mutable and the first is not.
 |}];;
 
 module M3 : sig
@@ -104,7 +112,7 @@ Error: Signature mismatch:
          type t = { f1 : unit; }
        is not included in
          type t = { f0 : unit; }
-       Fields number 1 have different names, f1 and f0.
+       1st fields have different names, f1 and f0.
 |}];;
 
 module M4 : sig
diff --git a/testsuite/tests/typing-modules/variants_errors_test.ml b/testsuite/tests/typing-modules/variants_errors_test.ml
index 761ba36fc..7313aaa25 100644
--- a/testsuite/tests/typing-modules/variants_errors_test.ml
+++ b/testsuite/tests/typing-modules/variants_errors_test.ml
@@ -24,7 +24,11 @@ Error: Signature mismatch:
          type t = Foo of float * int
        is not included in
          type t = Foo of int * int
-       The types for field Foo are not equal.
+       Constructors do not match:
+         Foo of float * int
+       is not compatible with:
+         Foo of int * int
+       The types are not equal.
 |}];;
 
 module M2 : sig
@@ -49,7 +53,11 @@ Error: Signature mismatch:
          type t = Foo of float
        is not included in
          type t = Foo of int * int
-       The arities for field Foo differ.
+       Constructors do not match:
+         Foo of float
+       is not compatible with:
+         Foo of int * int
+       They have different arities.
 |}];;
 
 module M3 : sig
@@ -74,7 +82,15 @@ Error: Signature mismatch:
          type t = Foo of { x : float; y : int; }
        is not included in
          type t = Foo of { x : int; y : int; }
-       The types for field x are not equal.
+       Constructors do not match:
+         Foo of { x : float; y : int; }
+       is not compatible with:
+         Foo of { x : int; y : int; }
+       Fields do not match:
+         x : float;
+       is not compatible with:
+         x : int;
+       The types are not equal.
 |}];;
 
 module M4 : sig
@@ -99,7 +115,11 @@ Error: Signature mismatch:
          type t = Foo of float
        is not included in
          type t = Foo of { x : int; y : int; }
-       The types for field Foo are not equal.
+       Constructors do not match:
+         Foo of float
+       is not compatible with:
+         Foo of { x : int; y : int; }
+       The second uses inline records and the first doesn't.
 |}];;
 
 module M5 : sig
@@ -124,5 +144,9 @@ Error: Signature mismatch:
          type 'a t = Foo of 'a
        is not included in
          type 'a t = Foo : int -> int t
-       The types for field Foo are not equal.
+       Constructors do not match:
+         Foo of 'a
+       is not compatible with:
+         Foo : int -> int t
+       The second has explicit return type and the first doesn't.
 |}];;
diff --git a/typing/includecore.ml b/typing/includecore.ml
index ed2fb068a..6d84fc5d5 100644
--- a/typing/includecore.ml
+++ b/typing/includecore.ml
@@ -135,29 +135,37 @@ let choose_other ord first second =
   | Second -> choose First first second
 
 type label_mismatch =
-  | Type of Ident.t
-  | Mutability of Ident.t
+  | Type
+  | Mutability of position
 
 type record_mismatch =
-  | Label_mismatch of label_mismatch
+  | Label_mismatch of Types.label_declaration
+                      * Types.label_declaration
+                      * label_mismatch
   | Label_names of int * Ident.t * Ident.t
   | Label_missing of position * Ident.t
   | Unboxed_float_representation of position
 
 type constructor_mismatch =
-  | Type of Ident.t
-  | Arity of Ident.t
+  | Type
+  | Arity
   | Inline_record of record_mismatch
+  | Kind of position
   | Explicit_return_type of position
 
 type variant_mismatch =
-  | Constructor_mismatch of constructor_mismatch
+  | Constructor_mismatch of Types.constructor_declaration
+                            * Types.constructor_declaration
+                            * constructor_mismatch
   | Constructor_names of int * Ident.t * Ident.t
   | Constructor_missing of position * Ident.t
 
 type extension_constructor_mismatch =
   | Constructor_privacy
-  | Constructor_mismatch of constructor_mismatch
+  | Constructor_mismatch of Ident.t
+                            * Types.extension_constructor
+                            * Types.extension_constructor
+                            * constructor_mismatch
 
 type type_mismatch =
   | Arity
@@ -171,20 +179,28 @@ type type_mismatch =
   | Unboxed_representation of position
   | Immediate
 
-let report_label_mismatch ppf err =
+let report_label_mismatch first second ppf err =
   let pr fmt = Format.fprintf ppf fmt in
   match (err : label_mismatch) with
-  | Type s -> pr "The types for field %s are not equal." (Ident.name s)
-  | Mutability s ->
-      pr "The mutability of field %s is different." (Ident.name s)
+  | Type -> pr "The types are not equal."
+  | Mutability ord ->
+      pr "%s is mutable and %s is not."
+        (String.capitalize_ascii  (choose ord first second))
+        (choose_other ord first second)
 
 let report_record_mismatch first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
-  match (err : record_mismatch) with
-  | Label_mismatch err -> report_label_mismatch ppf err
+  match err with
+  | Label_mismatch (l1, l2, err) ->
+      pr
+        "@[<hv>Fields do not match:@;<1 2>%a@ is not compatible with:\
+         @;<1 2>%a@ %a"
+        Printtyp.label l1
+        Printtyp.label l2
+        (report_label_mismatch first second) err
   | Label_names (n, name1, name2) ->
-      pr "@[<hv>Fields number %i have different names, %s and %s.@]"
-        n (Ident.name name1) (Ident.name name2)
+      pr "@[<hv>%i%s fields have different names, %s and %s.@]"
+        n (Misc.suffix n) (Ident.name name1) (Ident.name name2)
   | Label_missing (ord, s) ->
       pr "@[<hv>The field %s is only present in %s %s.@]"
         (Ident.name s) (choose ord first second) decl
@@ -196,9 +212,13 @@ let report_record_mismatch first second decl ppf err =
 let report_constructor_mismatch first second decl ppf err =
   let pr fmt  = Format.fprintf ppf fmt in
   match (err : constructor_mismatch) with
-  | Type s -> pr "The types for constructor %s are not equal." (Ident.name s)
-  | Arity s -> pr "The arities for constructor %s differ." (Ident.name s)
+  | Type -> pr "The types are not equal."
+  | Arity -> pr "They have different arities."
   | Inline_record err -> report_record_mismatch first second decl ppf err
+  | Kind ord ->
+      pr "%s uses inline records and %s doesn't."
+        (String.capitalize_ascii (choose ord first second))
+        (choose_other ord first second)
   | Explicit_return_type ord ->
       pr "%s has explicit return type and %s doesn't."
         (String.capitalize_ascii (choose ord first second))
@@ -207,11 +227,16 @@ let report_constructor_mismatch first second decl ppf err =
 let report_variant_mismatch first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
   match (err : variant_mismatch) with
-  | Constructor_mismatch err ->
-    report_constructor_mismatch first second decl ppf err
+  | Constructor_mismatch (c1, c2, err) ->
+      pr
+        "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+         @;<1 2>%a@ %a"
+        Printtyp.constructor c1
+        Printtyp.constructor c2
+        (report_constructor_mismatch first second decl) err
   | Constructor_names (n, name1, name2) ->
-      pr "Constructors number %i have different names, %s and %s."
-        n (Ident.name name1) (Ident.name name2)
+      pr "%i%s constructors have different names, %s and %s."
+        n (Misc.suffix n) (Ident.name name1) (Ident.name name2)
   | Constructor_missing (ord, s) ->
       pr "The constructor %s is only present in %s %s."
         (Ident.name s) (choose ord first second) decl
@@ -220,8 +245,12 @@ let report_extension_constructor_mismatch first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
   match (err : extension_constructor_mismatch) with
   | Constructor_privacy -> pr "A private type would be revealed."
-  | Constructor_mismatch err ->
-    report_constructor_mismatch first second decl ppf err
+  | Constructor_mismatch (id, ext1, ext2, err) ->
+      pr "@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
+          @;<1 2>%a@ %a@]"
+        (Printtyp.extension_only_constructor id) ext1
+        (Printtyp.extension_only_constructor id) ext2
+        (report_constructor_mismatch first second decl) err
 
 let report_type_mismatch0 first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
@@ -245,31 +274,32 @@ let report_type_mismatch first second decl ppf err =
   if err = Manifest then () else
   Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
 
-let rec compare_constructor_arguments ~loc env cstr params1 params2 arg1 arg2 =
+let rec compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
   match arg1, arg2 with
   | Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
       if List.length arg1 <> List.length arg2 then
-        Some (Arity cstr : constructor_mismatch)
+        Some (Arity : constructor_mismatch)
       else if
         (* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
         Ctype.equal env true (params1 @ arg1) (params2 @ arg2)
-      then None else Some (Type cstr)
+      then None else Some Type
   | Types.Cstr_record l1, Types.Cstr_record l2 ->
       Option.map
         (fun rec_err -> Inline_record rec_err)
         (compare_records env ~loc params1 params2 0 l1 l2)
-  | Types.Cstr_record _, _ | _, Types.Cstr_record _ -> Some (Type cstr)
+  | Types.Cstr_record _, _ -> Some (Kind First : constructor_mismatch)
+  | _, Types.Cstr_record _ -> Some (Kind Second : constructor_mismatch)
 
-and compare_constructors ~loc env cstr params1 params2 res1 res2 args1 args2 =
+and compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
   match res1, res2 with
   | Some r1, Some r2 ->
       if Ctype.equal env true [r1] [r2] then
-        compare_constructor_arguments ~loc env cstr [r1] [r2] args1 args2
-      else Some (Type cstr)
+        compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+      else Some Type
   | Some _, None -> Some (Explicit_return_type First)
   | None, Some _ -> Some (Explicit_return_type Second)
   | None, None ->
-      compare_constructor_arguments ~loc env cstr params1 params2 args1 args2
+      compare_constructor_arguments ~loc env params1 params2 args1 args2
 
 and compare_variants ~loc env params1 params2 n
     (cstrs1 : Types.constructor_declaration list)
@@ -288,9 +318,10 @@ and compare_variants ~loc env params1 params2 n
           loc
           cd1.cd_attributes cd2.cd_attributes
           (Ident.name cd1.cd_id);
-        match compare_constructors ~loc env cd1.cd_id params1 params2
+        match compare_constructors ~loc env params1 params2
                 cd1.cd_res cd2.cd_res cd1.cd_args cd2.cd_args with
-        | Some r -> Some (Constructor_mismatch r : variant_mismatch)
+        | Some r ->
+            Some ((Constructor_mismatch (cd1, cd2, r)) : variant_mismatch)
         | None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2
       end
 
@@ -298,11 +329,13 @@ and compare_labels env params1 params2
       (ld1 : Types.label_declaration)
       (ld2 : Types.label_declaration) =
       if ld1.ld_mutable <> ld2.ld_mutable
-      then Some (Mutability ld1.ld_id)
+      then
+        let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+        Some (Mutability  ord)
       else
         if Ctype.equal env true (ld1.ld_type::params1) (ld2.ld_type::params2)
         then None
-        else Some (Type ld1.ld_id : label_mismatch)
+        else Some (Type : label_mismatch)
 
 and compare_records ~loc env params1 params2 n
     (labels1 : Types.label_declaration list)
@@ -322,7 +355,7 @@ and compare_records ~loc env params1 params2 n
           ld1.ld_attributes ld2.ld_attributes
           (Ident.name ld1.ld_id);
         match compare_labels env params1 params2 ld1 ld2 with
-        | Some r -> Some (Label_mismatch r)
+        | Some r -> Some (Label_mismatch (ld1, ld2, r))
         (* add arguments to the parameters, cf. PR#7378 *)
         | None -> compare_records ~loc env
                     (ld1.ld_type::params1) (ld2.ld_type::params2)
@@ -456,15 +489,15 @@ let extension_constructors ~loc env ~mark id ext1 ext2 =
   in
   if not (Ctype.equal env true (ty1 :: ext1.ext_type_params)
                                (ty2 :: ext2.ext_type_params))
-  then Some (Constructor_mismatch (Type id))
+  then Some (Constructor_mismatch (id, ext1, ext2, Type))
   else
     let r =
-      compare_constructors ~loc env id ext1.ext_type_params ext2.ext_type_params
+      compare_constructors ~loc env ext1.ext_type_params ext2.ext_type_params
         ext1.ext_ret_type ext2.ext_ret_type
         ext1.ext_args ext2.ext_args
     in
     match r with
-    | Some r -> Some (Constructor_mismatch r)
+    | Some r -> Some (Constructor_mismatch (id, ext1, ext2, r))
     | None -> match ext1.ext_private, ext2.ext_private with
         Private, Public -> Some Constructor_privacy
       | _, _ -> None
diff --git a/typing/includecore.mli b/typing/includecore.mli
index 2c9a82d71..68524f663 100644
--- a/typing/includecore.mli
+++ b/typing/includecore.mli
@@ -23,29 +23,35 @@ exception Dont_match
 type position = Ctype.Unification_trace.position = First | Second
 
 type label_mismatch =
-  | Type of Ident.t
-  | Mutability of Ident.t
+  | Type
+  | Mutability of position
 
 type record_mismatch =
-  | Label_mismatch of label_mismatch
+  | Label_mismatch of label_declaration * label_declaration * label_mismatch
   | Label_names of int * Ident.t * Ident.t
   | Label_missing of position * Ident.t
   | Unboxed_float_representation of position
 
 type constructor_mismatch =
-  | Type of Ident.t
-  | Arity of Ident.t
+  | Type
+  | Arity
   | Inline_record of record_mismatch
+  | Kind of position
   | Explicit_return_type of position
 
 type variant_mismatch =
-  | Constructor_mismatch of constructor_mismatch
+  | Constructor_mismatch of constructor_declaration
+                            * constructor_declaration
+                            * constructor_mismatch
   | Constructor_names of int * Ident.t * Ident.t
   | Constructor_missing of position * Ident.t
 
 type extension_constructor_mismatch =
   | Constructor_privacy
-  | Constructor_mismatch of constructor_mismatch
+  | Constructor_mismatch of Ident.t
+                            * extension_constructor
+                            * extension_constructor
+                            * constructor_mismatch
 
 type type_mismatch =
   | Arity
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 0db53346b..c2ed54408 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -391,6 +391,8 @@ and print_out_label ppf (name, mut, arg) =
   fprintf ppf "@[<2>%s%s :@ %a@];" (if mut then "mutable " else "") name
     print_out_type arg
 
+let out_label = ref print_out_label
+
 let out_type = ref print_out_type
 
 (* Class types *)
@@ -704,6 +706,7 @@ and print_out_type_extension ppf te =
     (print_list print_out_constr (fun ppf -> fprintf ppf "@ | "))
     te.otyext_constructors
 
+let out_constr = ref print_out_constr
 let _ = out_module_type := print_out_module_type
 let _ = out_signature := print_out_signature
 let _ = out_sig_item := print_out_sig_item
diff --git a/typing/oprint.mli b/typing/oprint.mli
index 27ff8bc1d..2eaaa2646 100644
--- a/typing/oprint.mli
+++ b/typing/oprint.mli
@@ -18,7 +18,10 @@ open Outcometree
 
 val out_ident : (formatter -> out_ident -> unit) ref
 val out_value : (formatter -> out_value -> unit) ref
+val out_label : (formatter -> string * bool * out_type -> unit) ref
 val out_type : (formatter -> out_type -> unit) ref
+val out_constr :
+  (formatter -> string * out_type list * out_type option -> unit) ref
 val out_class_type : (formatter -> out_class_type -> unit) ref
 val out_module_type : (formatter -> out_module_type -> unit) ref
 val out_sig_item : (formatter -> out_sig_item -> unit) ref
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 033145b92..a468a3e59 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1221,6 +1221,10 @@ and tree_of_constructor cd =
 and tree_of_label l =
   (Ident.name l.ld_id, l.ld_mutable = Mutable, tree_of_typexp false l.ld_type)
 
+let constructor ppf c = !Oprint.out_constr ppf (tree_of_constructor c)
+
+let label ppf l = !Oprint.out_label ppf (tree_of_label l)
+
 let tree_of_type_declaration id decl rs =
   Osig_type (tree_of_type_decl id decl, tree_of_rec rs)
 
@@ -1233,6 +1237,17 @@ let constructor_arguments ppf a =
 
 (* Print an extension declaration *)
 
+let extension_constructor_args_and_ret_type_subtree ext_args ext_ret_type =
+  match ext_ret_type with
+  | None -> (tree_of_constructor_arguments ext_args, None)
+  | Some res ->
+    let nm = !names in
+    names := [];
+    let ret = tree_of_typexp false res in
+    let args = tree_of_constructor_arguments ext_args in
+    names := nm;
+    (args, Some ret)
+
 let tree_of_extension_constructor id ext es =
   reset_except_context ();
   let ty_name = Path.name ext.ext_type_path in
@@ -1252,15 +1267,9 @@ let tree_of_extension_constructor id ext es =
   in
   let name = Ident.name id in
   let args, ret =
-    match ext.ext_ret_type with
-    | None -> (tree_of_constructor_arguments ext.ext_args, None)
-    | Some res ->
-        let nm = !names in
-        names := [];
-        let ret = tree_of_typexp false res in
-        let args = tree_of_constructor_arguments ext.ext_args in
-        names := nm;
-        (args, Some ret)
+    extension_constructor_args_and_ret_type_subtree
+      ext.ext_args
+      ext.ext_ret_type
   in
   let ext =
     { oext_name = name;
@@ -1281,6 +1290,16 @@ let tree_of_extension_constructor id ext es =
 let extension_constructor id ppf ext =
   !Oprint.out_sig_item ppf (tree_of_extension_constructor id ext Text_first)
 
+let extension_only_constructor id ppf ext =
+  let name = Ident.name id in
+  let args, ret =
+    extension_constructor_args_and_ret_type_subtree
+      ext.ext_args
+      ext.ext_ret_type
+  in
+  Format.fprintf ppf "@[<hv>%a@]"
+    !Oprint.out_constr (name, args, ret)
+
 (* Print a value declaration *)
 
 let tree_of_value_description id decl =
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 77061d1ad..524429b2b 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -94,6 +94,11 @@ val type_scheme_max: ?b_reset_names: bool ->
 (* End Maxence *)
 val tree_of_value_description: Ident.t -> value_description -> out_sig_item
 val value_description: Ident.t -> formatter -> value_description -> unit
+val tree_of_label : label_declaration -> string * bool * out_type
+val label : formatter -> label_declaration -> unit
+val tree_of_constructor :
+  constructor_declaration -> string * out_type list * out_type option
+val constructor : formatter -> constructor_declaration -> unit
 val tree_of_type_declaration:
     Ident.t -> type_declaration -> rec_status -> out_sig_item
 val type_declaration: Ident.t -> formatter -> type_declaration -> unit
@@ -101,6 +106,8 @@ val tree_of_extension_constructor:
     Ident.t -> extension_constructor -> ext_status -> out_sig_item
 val extension_constructor:
     Ident.t -> formatter -> extension_constructor -> unit
+val extension_only_constructor:
+    Ident.t -> formatter -> extension_constructor -> unit
 val tree_of_module:
     Ident.t -> ?ellipsis:bool -> module_type -> rec_status -> out_sig_item
 val modtype: formatter -> module_type -> unit
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 19d1c4cc7..522b23c5d 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -1746,14 +1746,6 @@ let report_error ppf = function
         | false, true  -> inj ^ "contravariant"
         | false, false -> if inj = "" then "unrestricted" else inj
       in
-      let suffix n =
-        let teen = (n mod 100)/10 = 1 in
-        match n mod 10 with
-        | 1 when not teen -> "st"
-        | 2 when not teen -> "nd"
-        | 3 when not teen -> "rd"
-        | _ -> "th"
-      in
       (* FIXME: this test below is horrible, use a proper variant *)
       if n = -1 then
         fprintf ppf "@[%s@ %s@ It"
diff --git a/utils/misc.ml b/utils/misc.ml
index 6d4e23b92..9452bbba4 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -862,6 +862,13 @@ let print_if ppf flag printer arg =
   if !flag then Format.fprintf ppf "%a@." printer arg;
   arg
 
+let suffix n =
+  let teen = (n mod 100)/10 = 1 in
+  match n mod 10 with
+  | 1 when not teen -> "st"
+  | 2 when not teen -> "nd"
+  | 3 when not teen -> "rd"
+  | _ -> "th"
 
 type filepath = string
 type modname = string
diff --git a/utils/misc.mli b/utils/misc.mli
index a112a3663..73004a732 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -456,6 +456,7 @@ val print_if :
   Format.formatter -> bool ref -> (Format.formatter -> 'a -> unit) -> 'a -> 'a
 (** [print_if ppf flag fmt x] prints [x] with [fmt] on [ppf] if [b] is true. *)
 
+val suffix : int -> string
 
 type filepath = string
 type modname = string