Skip to content
Merged
Show file tree
Hide file tree
Changes from all 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 @@ -44,6 +44,7 @@ These are only breaking changes for unformatted code.
- Fix formatting uncurried functions with attributes https://github.com/rescript-lang/rescript-compiler/pull/5829
- Fix parsing/printing uncurried functions with type parameters https://github.com/rescript-lang/rescript-compiler/pull/5849
- Fix compiler ppx issue when combining `async` and uncurried application https://github.com/rescript-lang/rescript-compiler/pull/5856
- Fix issue where the internal representation of uncurried types would leak when a non-function is applied in a curried way https://github.com/rescript-lang/rescript-compiler/pull/5892

#### :nail_care: Polish

Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@

We've found a bug for you!
/.../fixtures/non_function_uncurried_apply.res:2:9-14

1 │ let nonfun = 2
2 │ let _ = nonfun(. 3)
3 │

This expression has type int
It is not a function.
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
let nonfun = 2
let _ = nonfun(. 3)
2 changes: 1 addition & 1 deletion jscomp/ml/ast_uncurried.ml
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ let type_to_arity (tArity : Types.type_expr) =
| Tvariant { row_fields = [ (label, _) ] } -> decode_arity_string label
| _ -> assert false

let mk_js_fn ~env ~arity t =
let make_uncurried_type ~env ~arity t =
let typ_arity = arity_to_type arity in
let lid : Longident.t = Lident "function$" in
let path = Env.lookup_type lid env in
Expand Down
14 changes: 10 additions & 4 deletions jscomp/ml/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2107,7 +2107,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
(match lid.txt with
| Lident "Function$" ->
let arity = Ast_uncurried.attributes_to_arity sexp.pexp_attributes in
let uncurried_typ = Ast_uncurried.mk_js_fn ~env ~arity (newvar()) in
let uncurried_typ = Ast_uncurried.make_uncurried_type ~env ~arity (newvar()) in
unify_exp_types loc env ty_expected uncurried_typ
| _ -> ());
type_construct env loc lid sarg ty_expected sexp.pexp_attributes
Expand Down Expand Up @@ -2992,8 +2992,14 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
match has_uncurried_type funct.exp_type with
| None ->
let arity = List.length sargs in
let js_fn = Ast_uncurried.mk_js_fn ~env ~arity (newvar()) in
unify_exp env funct js_fn
let uncurried_typ = Ast_uncurried.make_uncurried_type ~env ~arity (newvar()) in
begin
match (expand_head env funct.exp_type).desc with
| Tvar _ | Tarrow _ ->
unify_exp env funct uncurried_typ
| _ ->
raise(Error(funct.exp_loc, env, Apply_non_function (expand_head env funct.exp_type)))
end
| Some _ -> () in
let extract_uncurried_type t =
match has_uncurried_type t with
Expand All @@ -3011,7 +3017,7 @@ and type_application uncurried env funct (sargs : sargs) : targs * Types.type_ex
if uncurried && not fully_applied then
raise(Error(funct.exp_loc, env,
Uncurried_arity_mismatch (t, arity, List.length sargs)));
let newT = if fully_applied then newT else Ast_uncurried.mk_js_fn ~env ~arity:newarity newT in
let newT = if fully_applied then newT else Ast_uncurried.make_uncurried_type ~env ~arity:newarity newT in
(fully_applied, newT)
| _ -> (false, newT)
in
Expand Down