@@ -26,7 +26,12 @@ open Error_message_utils
2626
2727type error =
2828 | 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+ }
3035 | Label_mismatch of Longident .t * (type_expr * type_expr ) list
3136 | Pattern_type_clash of (type_expr * type_expr ) list
3237 | 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
13951400 ( loc,
13961401 ! env,
13971402 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+ } ));
13991409 let ty_args, ty_res =
14001410 instance_constructor ~in_pattern: (env, get_newtype_level () ) constr
14011411 in
@@ -3742,7 +3752,12 @@ and type_construct ~context env loc lid sarg ty_expected attrs =
37423752 ( loc,
37433753 env,
37443754 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+ } ));
37463761 let separate = Env. has_local_constraints env in
37473762 if separate then (
37483763 begin_def () ;
@@ -4245,14 +4260,24 @@ let report_error env loc ppf error =
42454260 | Polymorphic_label lid ->
42464261 fprintf ppf " @[The record field %a is polymorphic.@ %s@]" longident lid
42474262 " You cannot instantiate it in a pattern."
4248- | Constructor_arity_mismatch ( lid , expected , provided ) ->
4263+ | Constructor_arity_mismatch {name; constuctor; expected; provided} ->
42494264 (* 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
42564281 | Label_mismatch (lid , trace ) ->
42574282 (* modified *)
42584283 super_report_unification_error ppf env trace
0 commit comments