Uncurried internal representation escapes in error message. (#5892)

* Uncurried internal representation escapes in error message.

This is an old standing issue still present.
When something which is not a function is applied in an uncurried way, the error message leaks the internal representation of uncurried types.

See #5888

* rename

* Handle error message where non-function is used in function application.

Curried application treats specially the case where the type used is not a function.
Adapt uncurried application to do the same.

* Update CHANGELOG.md

Author: cristianoc

CHANGELOG.md

@@ -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
 

jscomp/build_tests/super_errors/expected/non_function_uncurried_apply.res.expected

@@ -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.

jscomp/build_tests/super_errors/fixtures/non_function_uncurried_apply.res

@@ -0,0 +1,2 @@
+let nonfun = 2
+let _ = nonfun(. 3)

jscomp/ml/ast_uncurried.ml

@@ -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

jscomp/ml/typecore.ml

@@ -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
@@ -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
@@ -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