Process uncurried application in the type checker. (#5835)

* Process uncurried application in the type checker.

- Do the processing of uncurried application in the type checker.
- Add support for default arguments in uncurried functions.
- Add custom error messages for uncurried application.
- Uncurried pipe processing does not require special handling.

The current encoding is based on arity. To support default arguments one cannot just look at the number of supplied arguments, but to know whether the required arguments are supplied one needs to inspect the function type.

* Give error when uncurried application tries to use label from result type.

* clean up error message that is now not possible

* Add examples of uncurried functions with default arguments.

* Update CHANGELOG.md

* clean up

Author: cristianoc

CHANGELOG.md

@@ -21,6 +21,7 @@
 subset of the arguments, and return a curried type with the remaining ones https://github.com/rescript-lang/rescript-compiler/pull/5805
 - Add support for uncurried externals https://github.com/rescript-lang/rescript-compiler/pull/5815 https://github.com/rescript-lang/rescript-compiler/pull/5819 https://github.com/rescript-lang/rescript-compiler/pull/5830
 - Parser/Printer: unify uncurried functions of arity 0, and of arity 1 taking unit. There's now only arity 1 in the source language. https://github.com/rescript-lang/rescript-compiler/pull/5825
+- Add support for default arguments in uncurried functions https://github.com/rescript-lang/rescript-compiler/pull/5835
 
 
 #### :boom: Breaking Change

jscomp/build_tests/super_errors/expected/arity_mismatch.res.expected

@@ -6,4 +6,5 @@
   2 │ let makeVariables = makeVar(.~f=f => f)
   3 │ 
 
-  This function expected 2 arguments, but got 1
+  This uncurried function has type (. ~f: 'a => 'a, unit) => int
+  It is applied with 1 arguments but it requires 2.

jscomp/build_tests/super_errors/expected/arity_mismatch2.res.expected

@@ -6,4 +6,5 @@
   2 │ let makeVariables = makeVar(. 1, 2, 3)
   3 │ 
 
-  This function expected 2 arguments, but got 3
+  This uncurried function has type (. 'a, unit) => int
+  It is applied with 3 arguments but it requires 2.

jscomp/build_tests/super_errors/expected/method_arity_mismatch.res.expected

@@ -8,4 +8,5 @@
   4 │ }
   5 │ 
 
-  This function expected 2 arguments, but got 1
+  This uncurried function has type (. int, int) => unit
+  It is applied with 1 arguments but it requires 2.

jscomp/build_tests/super_errors/expected/uncurried_wrong_label.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/uncurried_wrong_label.res:3:18
+
+  1 │ let foo = (. ~x) => { let _ = (); (~y) => x+y }
+  2 │ // This looks too far into the return type
+  3 │ let d = foo(. ~y=3)
+  4 │ 
+
+  The function applied to this argument has type (. ~x: int, ~y: int) => int
+This argument cannot be applied with label ~y

jscomp/build_tests/super_errors/expected/warnings4.res.expected

@@ -10,4 +10,4 @@
   14 │ 
 
   You forgot to handle a possible case here, for example: 
-  #second(_) | #fourth | #third
+  #second(_) | #fourth | #third

jscomp/build_tests/super_errors/expected/warnings5.res.expected

@@ -187,4 +187,4 @@ Either bind these labels explicitly or add ', _' to the pattern.
   60 │ 
 
   You forgot to handle a possible case here, for example: 
-  (_, true)
+  (_, true)

jscomp/build_tests/super_errors/fixtures/uncurried_wrong_label.res

@@ -0,0 +1,3 @@
+let foo = (. ~x) => { let _ = (); (~y) => x+y }
+// This looks too far into the return type
+let d = foo(. ~y=3)

jscomp/frontend/ast_attributes.ml

@@ -341,8 +341,7 @@ let locg = Location.none
 let is_bs (attr : attr) =
   match attr with { Location.txt = "bs"; _ }, _ -> true | _ -> false
 
-let is_res_uapp (attr : attr) =
-  match attr with { Location.txt = "res.uapp"; _ }, _ -> true | _ -> false
+let res_uapp : attr = ({ txt = "res.uapp"; loc = locg }, Ast_payload.empty)
 
 let bs_get : attr = ({ txt = "bs.get"; loc = locg }, Ast_payload.empty)
 

jscomp/frontend/ast_attributes.mli

@@ -73,7 +73,7 @@ val is_bs : attr -> bool
    val is_bs_as : attr -> bool *)
 
 (* Attribute for uncurried application coming from the ReScript parser *)
-val is_res_uapp : attr -> bool
+val res_uapp : attr
 
 val bs_get : attr
 

jscomp/frontend/ast_exp_apply.ml

@@ -124,7 +124,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
               {
                 pexp_desc = Pexp_apply (fn1, (Nolabel, a) :: args);
                 pexp_loc = e.pexp_loc;
-                pexp_attributes = e.pexp_attributes;
+                pexp_attributes = e.pexp_attributes @ f.pexp_attributes;
               }
           | Pexp_tuple xs ->
               bound a (fun bounded_obj_arg ->
@@ -156,41 +156,14 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
                     pexp_attributes = f.pexp_attributes;
                     pexp_loc = f.pexp_loc;
                   })
-          | _ -> (
-              match
-                ( Ext_list.exclude_with_val f_.pexp_attributes (fun a ->
-                      Ast_attributes.is_bs a
-                      || Ast_attributes.is_res_uapp a),
-                  f_.pexp_desc )
-              with
-              | Some other_attributes, Pexp_apply (fn1, args) ->
-                  (* a |. f b c [@bs]
-                     Cannot process uncurried application early as the arity is wip *)
-                  let fn1 = self.expr self fn1 in
-                  let args =
-                    args |> List.map (fun (l, e) -> (l, self.expr self e))
-                  in
-                  Bs_ast_invariant.warn_discarded_unused_attributes
-                    fn1.pexp_attributes;
-                  {
-                    pexp_desc =
-                      Ast_uncurry_apply.uncurry_fn_apply ~arity0:(op = "|.")
-                        e.pexp_loc self fn1 ((Nolabel, a) :: args);
-                    pexp_loc = e.pexp_loc;
-                    pexp_attributes = e.pexp_attributes @ other_attributes;
-                  }
-              | _ when op = "|.u" ->
-                  (* a |.u f
-                     Uncurried unary application *)
-                  {
-                    pexp_desc =
-                      Ast_uncurry_apply.uncurry_fn_apply ~arity0:false
-                        e.pexp_loc self f
-                        [ (Nolabel, a) ];
-                    pexp_loc = e.pexp_loc;
-                    pexp_attributes = e.pexp_attributes;
-                  }
-              | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a))
+          | _ ->
+              if op = "|.u" then
+                (* a |.u f
+                   Uncurried unary application *)
+                Ast_compatible.app1 ~loc
+                  ~attrs:(Ast_attributes.res_uapp :: e.pexp_attributes)
+                  f a
+              else Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a)
       | Some { op = "##"; loc; args = [ obj; rest ] } -> (
           (* - obj##property
              - obj#(method a b )
@@ -289,21 +262,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
               {
                 e with
                 pexp_desc =
-                  Ast_uncurry_apply.uncurry_fn_apply ~arity0:true e.pexp_loc
-                    self fn args;
+                  Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
                 pexp_attributes;
               }
-          | None -> (
-              match
-                Ext_list.exclude_with_val e.pexp_attributes
-                  Ast_attributes.is_res_uapp
-              with
-              | Some pexp_attributes ->
-                  {
-                    e with
-                    pexp_desc =
-                      Ast_uncurry_apply.uncurry_fn_apply ~arity0:false
-                        e.pexp_loc self fn args;
-                    pexp_attributes;
-                  }
-              | None -> default_expr_mapper self e)))
+          | None -> default_expr_mapper self e))

jscomp/frontend/ast_uncurry_apply.ml

@@ -44,9 +44,8 @@ let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc =
         [ (Nolabel, e) ],
       Typ.any ~loc () )
 
-let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper)
-    (obj : Parsetree.expression) (args : Ast_compatible.args)
-    (cb : loc -> exp -> exp) =
+let generic_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
+    (args : Ast_compatible.args) (cb : loc -> exp -> exp) =
   let obj = self.expr self obj in
   let args =
     Ext_list.map args (fun (lbl, e) ->
@@ -58,8 +57,7 @@ let generic_apply ~arity0 loc (self : Bs_ast_mapper.mapper)
     match args with
     | [
      (Nolabel, { pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) });
-    ]
-      when arity0 ->
+    ] ->
         []
     | _ -> args
   in
@@ -130,9 +128,9 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
             ])
          args)
 
-let uncurry_fn_apply ~arity0 loc self fn args =
-  generic_apply ~arity0 loc self fn args (fun _ obj -> obj)
+let uncurry_fn_apply loc self fn args =
+  generic_apply loc self fn args (fun _ obj -> obj)
 
 let property_apply loc self obj name args =
-  generic_apply ~arity0:true loc self obj args (fun loc obj ->
+  generic_apply loc self obj args (fun loc obj ->
       Exp.send ~loc obj { txt = name; loc })

jscomp/frontend/ast_uncurry_apply.mli

@@ -25,7 +25,6 @@
 (* TODO: the interface is not reusable, it depends on too much context *)
 
 val uncurry_fn_apply :
-  arity0:bool ->
   Location.t ->
   Bs_ast_mapper.mapper ->
   Parsetree.expression ->