Process uncurried application in the type checker.

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