@@ -26,7 +26,12 @@ open Error_message_utils
26
26
27
27
type error =
28
28
| Polymorphic_label of Longident .t
29
- | Constructor_arity_mismatch of Longident .t * int * int
29
+ | Constructor_arity_mismatch of {
30
+ name : Longident .t ;
31
+ constuctor : constructor_description ;
32
+ expected : int ;
33
+ provided : int ;
34
+ }
30
35
| Label_mismatch of Longident .t * (type_expr * type_expr ) list
31
36
| Pattern_type_clash of (type_expr * type_expr ) list
32
37
| Or_pattern_type_clash of Ident .t * (type_expr * type_expr ) list
@@ -1395,7 +1400,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
1395
1400
( loc,
1396
1401
! env,
1397
1402
Constructor_arity_mismatch
1398
- (lid.txt, constr.cstr_arity, List. length sargs) ));
1403
+ {
1404
+ name = lid.txt;
1405
+ constuctor = constr;
1406
+ expected = constr.cstr_arity;
1407
+ provided = List. length sargs;
1408
+ } ));
1399
1409
let ty_args, ty_res =
1400
1410
instance_constructor ~in_pattern: (env, get_newtype_level () ) constr
1401
1411
in
@@ -3742,7 +3752,12 @@ and type_construct ~context env loc lid sarg ty_expected attrs =
3742
3752
( loc,
3743
3753
env,
3744
3754
Constructor_arity_mismatch
3745
- (lid.txt, constr.cstr_arity, List. length sargs) ));
3755
+ {
3756
+ name = lid.txt;
3757
+ constuctor = constr;
3758
+ expected = constr.cstr_arity;
3759
+ provided = List. length sargs;
3760
+ } ));
3746
3761
let separate = Env. has_local_constraints env in
3747
3762
if separate then (
3748
3763
begin_def () ;
@@ -4245,14 +4260,24 @@ let report_error env loc ppf error =
4245
4260
| Polymorphic_label lid ->
4246
4261
fprintf ppf " @[The record field %a is polymorphic.@ %s@]" longident lid
4247
4262
" You cannot instantiate it in a pattern."
4248
- | Constructor_arity_mismatch ( lid , expected , provided ) ->
4263
+ | Constructor_arity_mismatch {name; constuctor; expected; provided} ->
4249
4264
(* modified *)
4250
- fprintf ppf
4251
- " @[This variant constructor, %a, expects %i %s; here, we've %sfound %i.@]"
4252
- longident lid expected
4253
- (if expected == 1 then " argument" else " arguments" )
4254
- (if provided < expected then " only " else " " )
4255
- provided
4265
+ let is_inline_record = Option. is_some constuctor.cstr_inlined in
4266
+ if is_inline_record && expected = 1 then
4267
+ fprintf ppf
4268
+ " @[This variant constructor @{<info>%a@} expects an inline record as \
4269
+ payload%s.@]"
4270
+ longident name
4271
+ (if provided = 0 then " , but it's not being passed any arguments"
4272
+ else " " )
4273
+ else
4274
+ fprintf ppf
4275
+ " @[This variant constructor @{<info>%a@} expects %i %s, but it's%s \
4276
+ being passed %i.@]"
4277
+ longident name expected
4278
+ (if expected == 1 then " argument" else " arguments" )
4279
+ (if provided < expected then " only" else " " )
4280
+ provided
4256
4281
| Label_mismatch (lid , trace ) ->
4257
4282
(* modified *)
4258
4283
super_report_unification_error ppf env trace
0 commit comments