@@ -139,6 +139,8 @@ type type_mismatch =
139
139
| Record_representation of record_representation * record_representation
140
140
| Unboxed_representation of bool (* true means second one is unboxed *)
141
141
| Immediate
142
+ | Tag_name
143
+ | Variant_representation of Ident .t
142
144
143
145
let report_type_mismatch0 first second decl ppf err =
144
146
let pr fmt = Format. fprintf ppf fmt in
@@ -183,6 +185,9 @@ let report_type_mismatch0 first second decl ppf err =
183
185
(if b then second else first) decl
184
186
" uses unboxed representation"
185
187
| Immediate -> pr " %s is not an immediate type" first
188
+ | Tag_name -> pr " Their @tag annotations differ"
189
+ | Variant_representation s ->
190
+ pr " The internal representations for case %s are not equal" (Ident. name s)
186
191
187
192
let report_type_mismatch first second decl ppf =
188
193
List. iter
@@ -232,6 +237,17 @@ and compare_variants ~loc env params1 params2 n
232
237
compare_constructor_arguments ~loc env cd1.cd_id
233
238
params1 params2 cd1.cd_args cd2.cd_args
234
239
in
240
+ let r =
241
+ if r <> [] then r
242
+ else match Ast_untagged_variants. is_nullary_variant cd1.cd_args with
243
+ | true ->
244
+ let tag_type1 = Ast_untagged_variants. process_tag_type cd1.cd_attributes in
245
+ let tag_type2 = Ast_untagged_variants. process_tag_type cd2.cd_attributes in
246
+ if tag_type1 <> tag_type2 then [Variant_representation cd1.cd_id]
247
+ else []
248
+ | false ->
249
+ r
250
+ in
235
251
if r <> [] then r
236
252
else compare_variants ~loc env params1 params2 (n+ 1 ) rem1 rem2
237
253
end
@@ -320,8 +336,14 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 =
320
336
| _ -> []
321
337
in
322
338
if err <> [] then err else
339
+ let err =
340
+ let tag1 = Ast_untagged_variants. process_tag_name decl1.type_attributes in
341
+ let tag2 = Ast_untagged_variants. process_tag_name decl2.type_attributes in
342
+ if tag1 <> tag2 then [Tag_name ] else err in
343
+ if err <> [] then err else
323
344
let err = match (decl1.type_kind, decl2.type_kind) with
324
345
(_ , Type_abstract) -> []
346
+ (* XXX *)
325
347
| (Type_variant cstrs1 , Type_variant cstrs2 ) ->
326
348
let mark cstrs usage name decl =
327
349
List. iter
0 commit comments