Skip to content
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@
- Better error message if platform binaries package is not found. https://github.com/rescript-lang/rescript/pull/7698
- Hint in error for string constants matching expected variant/polyvariant constructor. https://github.com/rescript-lang/rescript/pull/7711
- Polish arity mismatch error message a bit. https://github.com/rescript-lang/rescript/pull/7709
- Suggest related functions with the expected arity in errors when it makes sense. https://github.com/rescript-lang/rescript/pull/7712

#### :house: Internal

Expand Down
99 changes: 88 additions & 11 deletions compiler/ml/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -79,8 +79,13 @@ type error =
| Unknown_literal of string * char
| Illegal_letrec_pat
| Empty_record_literal
| Uncurried_arity_mismatch of
type_expr * int * int * Asttypes.Noloc.arg_label list
| Uncurried_arity_mismatch of {
function_type: type_expr;
expected_arity: int;
provided_arity: int;
provided_args: Asttypes.Noloc.arg_label list;
function_name: Longident.t option;
}
| Field_not_optional of string * type_expr
| Type_params_not_supported of Longident.t
| Field_access_on_dict_type
Expand Down Expand Up @@ -2220,6 +2225,11 @@ let not_function env ty =
let ls, tvar = list_labels env ty in
ls = [] && not tvar

let extract_function_name funct =
match funct.exp_desc with
| Texp_ident (path, _, _) -> Some (Longident.parse (Path.name path))
| _ -> None

type lazy_args =
(Asttypes.Noloc.arg_label * (unit -> Typedtree.expression) option) list

Expand Down Expand Up @@ -3512,10 +3522,13 @@ and type_application ~context total_app env funct (sargs : sargs) :
( funct.exp_loc,
env,
Uncurried_arity_mismatch
( funct.exp_type,
arity,
List.length sargs,
sargs |> List.map (fun (a, _) -> to_noloc a) ) ));
{
function_type = funct.exp_type;
expected_arity = arity;
provided_arity = List.length sargs;
provided_args = sargs |> List.map (fun (a, _) -> to_noloc a);
function_name = extract_function_name funct;
} ));
arity
| None -> max_int
in
Expand All @@ -3531,10 +3544,13 @@ and type_application ~context total_app env funct (sargs : sargs) :
( funct.exp_loc,
env,
Uncurried_arity_mismatch
( funct.exp_type,
required_args + newarity,
required_args,
sargs |> List.map (fun (a, _) -> to_noloc a) ) )));
{
function_type = funct.exp_type;
expected_arity = required_args + newarity;
provided_arity = required_args;
provided_args = sargs |> List.map (fun (a, _) -> to_noloc a);
function_name = extract_function_name funct;
} )));
let new_t =
if fully_applied then new_t
else
Expand Down Expand Up @@ -4232,6 +4248,40 @@ let spellcheck ppf unbound_name valid_names =
let spellcheck_idents ppf unbound valid_idents =
spellcheck ppf (Ident.name unbound) (List.map Ident.name valid_idents)

let strip_arity_suffix name =
let len = String.length name in
let rec scan_back i =
if i < 0 || name.[i] < '0' || name.[i] > '9' then i + 1
else scan_back (i - 1)
in
let start_of_digits = scan_back (len - 1) in
if start_of_digits > 0 && start_of_digits < len then
String.sub name 0 start_of_digits
else name

let find_arity_suggestion env function_name target_arity =
let base_name = strip_arity_suffix function_name in
let candidate =
if target_arity = 1 then base_name
else base_name ^ string_of_int target_arity
in
try
let path, desc = Env.lookup_value (Longident.parse candidate) env in
if Builtin_attributes.deprecated_of_attrs desc.val_attributes <> None then
None
else
let expanded_type = Ctype.expand_head env desc.val_type in
let actual_arity =
match Ctype.get_arity env expanded_type with
| Some arity -> arity
| None -> 0
in
if actual_arity = target_arity then Some (Printtyp.string_of_path path)
else None
with
| Not_found -> None
| _ -> None

open Format
let longident = Printtyp.longident
let super_report_unification_error = Printtyp.super_report_unification_error
Expand Down Expand Up @@ -4491,7 +4541,14 @@ let report_error env loc ppf error =
fprintf ppf
"Empty record literal {} should be type annotated or used in a record \
context."
| Uncurried_arity_mismatch (typ, arity, args, sargs) ->
| Uncurried_arity_mismatch
{
function_type = typ;
expected_arity = arity;
provided_arity = args;
provided_args = sargs;
function_name = function_name_opt;
} ->
(* We need:
- Any arg that's required but isn't passed
- Any arg that is passed but isn't in the fn definition (optional or labelled)
Expand Down Expand Up @@ -4600,6 +4657,26 @@ let report_error env loc ppf error =
(if args = 1 then "" else "s")
arity;

(* Add suggestions for related functions with correct arity *)
(match function_name_opt with
| Some function_name -> (
let function_name_str =
let buffer = Buffer.create 16 in
let formatter = Format.formatter_of_buffer buffer in
Printtyp.longident formatter function_name;
Format.pp_print_flush formatter ();
Buffer.contents buffer
in
let suggestion = find_arity_suggestion env function_name_str args in
match suggestion with
| None -> ()
| Some suggestion_str ->
fprintf ppf
"@,@,Hint: Try @{<info>%s@} instead (takes @{<info>%d@} argument%s)."
suggestion_str args
(if args = 1 then "" else "s"))
| None -> ());

fprintf ppf "@]"
| Field_not_optional (name, typ) ->
fprintf ppf "Field @{<info>%s@} is not optional in type %a. Use without ?"
Expand Down
9 changes: 7 additions & 2 deletions compiler/ml/typecore.mli
Original file line number Diff line number Diff line change
Expand Up @@ -111,8 +111,13 @@ type error =
| Unknown_literal of string * char
| Illegal_letrec_pat
| Empty_record_literal
| Uncurried_arity_mismatch of
type_expr * int * int * Asttypes.Noloc.arg_label list
| Uncurried_arity_mismatch of {
function_type: type_expr;
expected_arity: int;
provided_arity: int;
provided_args: Asttypes.Noloc.arg_label list;
function_name: Longident.t option;
}
| Field_not_optional of string * type_expr
| Type_params_not_supported of Longident.t
| Field_access_on_dict_type
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@

We've found a bug for you!
/.../fixtures/suggest_existing_arity_fn_1.res:1:1-11

1 │ Console.log(1, 2)
2 │

This function call is incorrect.
The function has type:
'a => unit

- The function takes just 1 unlabelled argument, but is called with 2

Hint: Try Console.log2 instead (takes 2 arguments).
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@

We've found a bug for you!
/.../fixtures/suggest_existing_arity_fn_2.res:1:1-12

1 │ Console.log2(1)
2 │

This function call is incorrect.
The function has type:
(int, 'a) => unit

- The function takes 2 unlabelled arguments, but is called with just 1

Hint: Try Console.log instead (takes 1 argument).
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@

We've found a bug for you!
/.../fixtures/suggest_existing_arity_fn_3.res:1:1-12

1 │ Console.log4(1, 2)
2 │

This function call is incorrect.
The function has type:
(int, int, 'a, 'b) => unit

- The function takes 4 unlabelled arguments, but is called with just 2

Hint: Try Console.log2 instead (takes 2 arguments).
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Console.log(1, 2)
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Console.log2(1)
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Console.log4(1, 2)