Fix issue where uncurried was not supported with pipe (#5803)

cristianoc · web-flow · commit a233b08fc5cc · 2022-11-14T12:52:59.000+01:00
* Refactor: renaming in pipe ppx.

* Fix issue where uncurried was not supported with pipe

* Update CHANGELOG.md
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -29,6 +29,10 @@
 Also, `(. int) => string => bool` is not equivalen to `(. int, string) => bool` anymore.
 These are only breaking changes for unformatted code.
 
+#### :bug: Bug Fix
+
+- Fix issue where uncurried was not supported with pipe https://github.com/rescript-lang/rescript-compiler/pull/5803
+
 #### :nail_care: Polish
 
 - Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784
diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml
@@ -95,39 +95,39 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
       Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op
   | None -> (
       match view_as_app e infix_ops with
-      | Some { op = "|."; args = [ obj_arg; fn ]; loc } -> (
+      | Some { op = "|."; args = [ a_; f_ ]; loc } -> (
           (*
         a |. f
         a |. f b c [@bs]  --> f a b c [@bs]
         a |. (g |. b)
         a |. `Variant
         a |. (b |. f c [@bs])
       *)
-          let new_obj_arg = self.expr self obj_arg in
-          let fn = self.expr self fn in
-          match fn.pexp_desc with
+          let a = self.expr self a_ in
+          let f = self.expr self f_ in
+          match f.pexp_desc with
           | Pexp_variant (label, None) ->
               {
-                fn with
-                pexp_desc = Pexp_variant (label, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_variant (label, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_construct (ctor, None) ->
               {
-                fn with
-                pexp_desc = Pexp_construct (ctor, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_construct (ctor, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_apply (fn1, args) ->
               Bs_ast_invariant.warn_discarded_unused_attributes
                 fn1.pexp_attributes;
               {
-                pexp_desc = Pexp_apply (fn1, (Nolabel, new_obj_arg) :: args);
+                pexp_desc = Pexp_apply (fn1, (Nolabel, a) :: args);
                 pexp_loc = e.pexp_loc;
                 pexp_attributes = e.pexp_attributes;
               }
           | Pexp_tuple xs ->
-              bound new_obj_arg (fun bounded_obj_arg ->
+              bound a (fun bounded_obj_arg ->
                   {
                     pexp_desc =
                       Pexp_tuple
@@ -153,11 +153,32 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
                              | _ ->
                                  Ast_compatible.app1 ~loc:fn.pexp_loc fn
                                    bounded_obj_arg));
-                    pexp_attributes = fn.pexp_attributes;
-                    pexp_loc = fn.pexp_loc;
+                    pexp_attributes = f.pexp_attributes;
+                    pexp_loc = f.pexp_loc;
                   })
-          | _ ->
-              Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes fn new_obj_arg)
+          | _ -> (
+              match
+                ( Ext_list.exclude_with_val f_.pexp_attributes
+                    Ast_attributes.is_bs,
+                  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 e.pexp_loc self fn1
+                        ((Nolabel, a) :: args);
+                    pexp_loc = e.pexp_loc;
+                    pexp_attributes = e.pexp_attributes @ other_attributes;
+                  }
+              | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a))
       | Some { op = "##"; loc; args = [ obj; rest ] } -> (
           (* - obj##property
              - obj#(method a b )
diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja
diff --git a/jscomp/test/uncurried_pipe.js b/jscomp/test/uncurried_pipe.js
@@ -0,0 +1,42 @@
+'use strict';
+
+
+function add(x, y) {
+  return x + y | 0;
+}
+
+function addC(x, y) {
+  return x + y | 0;
+}
+
+var v7 = add(3, 4);
+
+var v17 = add(10, add(3, 4));
+
+var v27 = add(20, 7);
+
+var v37 = 30 + add(3, 4) | 0;
+
+var StandardNotation = {
+  add: add,
+  addC: addC,
+  v7: v7,
+  v17: v17,
+  v27: v27,
+  v37: v37
+};
+
+var v7$1 = add(3, 4);
+
+var v17$1 = add(10, add(3, 4));
+
+var v27$1 = add(20, 7);
+
+var v37$1 = 30 + add(3, 4) | 0;
+
+exports.StandardNotation = StandardNotation;
+exports.v7 = v7$1;
+exports.v17 = v17$1;
+exports.v27 = v27$1;
+exports.v37 = v37$1;
+/* v7 Not a pure module */
diff --git a/jscomp/test/uncurried_pipe.res b/jscomp/test/uncurried_pipe.res
@@ -0,0 +1,18 @@
+module StandardNotation = {
+  let add = (. x, y) => x + y
+  let addC = (x, y) => x + y
+
+  let v7 = 3->add(. 4)
+  let v17 = 10->add(. 3->add(. 4))
+  let v27 = 20->add(. 3->addC(4))
+  let v37 = 30->addC(3->add(. 4))
+}
+
+@@uncurried
+
+open StandardNotation
+
+let v7 = 3->add(4)
+let v17 = 10->add(3->add(4))
+let v27 = 20->add(3->addC(. 4))
+let v37 = 30->addC(. 3->add(4))
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
@@ -150328,39 +150328,39 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
       Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op
   | None -> (
       match view_as_app e infix_ops with
-      | Some { op = "|."; args = [ obj_arg; fn ]; loc } -> (
+      | Some { op = "|."; args = [ a_; f_ ]; loc } -> (
           (*
         a |. f
         a |. f b c [@bs]  --> f a b c [@bs]
         a |. (g |. b)
         a |. `Variant
         a |. (b |. f c [@bs])
       *)
-          let new_obj_arg = self.expr self obj_arg in
-          let fn = self.expr self fn in
-          match fn.pexp_desc with
+          let a = self.expr self a_ in
+          let f = self.expr self f_ in
+          match f.pexp_desc with
           | Pexp_variant (label, None) ->
               {
-                fn with
-                pexp_desc = Pexp_variant (label, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_variant (label, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_construct (ctor, None) ->
               {
-                fn with
-                pexp_desc = Pexp_construct (ctor, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_construct (ctor, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_apply (fn1, args) ->
               Bs_ast_invariant.warn_discarded_unused_attributes
                 fn1.pexp_attributes;
               {
-                pexp_desc = Pexp_apply (fn1, (Nolabel, new_obj_arg) :: args);
+                pexp_desc = Pexp_apply (fn1, (Nolabel, a) :: args);
                 pexp_loc = e.pexp_loc;
                 pexp_attributes = e.pexp_attributes;
               }
           | Pexp_tuple xs ->
-              bound new_obj_arg (fun bounded_obj_arg ->
+              bound a (fun bounded_obj_arg ->
                   {
                     pexp_desc =
                       Pexp_tuple
@@ -150386,11 +150386,32 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
                              | _ ->
                                  Ast_compatible.app1 ~loc:fn.pexp_loc fn
                                    bounded_obj_arg));
-                    pexp_attributes = fn.pexp_attributes;
-                    pexp_loc = fn.pexp_loc;
+                    pexp_attributes = f.pexp_attributes;
+                    pexp_loc = f.pexp_loc;
                   })
-          | _ ->
-              Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes fn new_obj_arg)
+          | _ -> (
+              match
+                ( Ext_list.exclude_with_val f_.pexp_attributes
+                    Ast_attributes.is_bs,
+                  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 e.pexp_loc self fn1
+                        ((Nolabel, a) :: args);
+                    pexp_loc = e.pexp_loc;
+                    pexp_attributes = e.pexp_attributes @ other_attributes;
+                  }
+              | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a))
       | Some { op = "##"; loc; args = [ obj; rest ] } -> (
           (* - obj##property
              - obj#(method a b )
diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml
@@ -150328,39 +150328,39 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
       Location.raise_errorf ~loc "%s expect f%sproperty arg0 arg2 form" op op
   | None -> (
       match view_as_app e infix_ops with
-      | Some { op = "|."; args = [ obj_arg; fn ]; loc } -> (
+      | Some { op = "|."; args = [ a_; f_ ]; loc } -> (
           (*
         a |. f
         a |. f b c [@bs]  --> f a b c [@bs]
         a |. (g |. b)
         a |. `Variant
         a |. (b |. f c [@bs])
       *)
-          let new_obj_arg = self.expr self obj_arg in
-          let fn = self.expr self fn in
-          match fn.pexp_desc with
+          let a = self.expr self a_ in
+          let f = self.expr self f_ in
+          match f.pexp_desc with
           | Pexp_variant (label, None) ->
               {
-                fn with
-                pexp_desc = Pexp_variant (label, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_variant (label, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_construct (ctor, None) ->
               {
-                fn with
-                pexp_desc = Pexp_construct (ctor, Some new_obj_arg);
+                f with
+                pexp_desc = Pexp_construct (ctor, Some a);
                 pexp_loc = e.pexp_loc;
               }
           | Pexp_apply (fn1, args) ->
               Bs_ast_invariant.warn_discarded_unused_attributes
                 fn1.pexp_attributes;
               {
-                pexp_desc = Pexp_apply (fn1, (Nolabel, new_obj_arg) :: args);
+                pexp_desc = Pexp_apply (fn1, (Nolabel, a) :: args);
                 pexp_loc = e.pexp_loc;
                 pexp_attributes = e.pexp_attributes;
               }
           | Pexp_tuple xs ->
-              bound new_obj_arg (fun bounded_obj_arg ->
+              bound a (fun bounded_obj_arg ->
                   {
                     pexp_desc =
                       Pexp_tuple
@@ -150386,11 +150386,32 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
                              | _ ->
                                  Ast_compatible.app1 ~loc:fn.pexp_loc fn
                                    bounded_obj_arg));
-                    pexp_attributes = fn.pexp_attributes;
-                    pexp_loc = fn.pexp_loc;
+                    pexp_attributes = f.pexp_attributes;
+                    pexp_loc = f.pexp_loc;
                   })
-          | _ ->
-              Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes fn new_obj_arg)
+          | _ -> (
+              match
+                ( Ext_list.exclude_with_val f_.pexp_attributes
+                    Ast_attributes.is_bs,
+                  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 e.pexp_loc self fn1
+                        ((Nolabel, a) :: args);
+                    pexp_loc = e.pexp_loc;
+                    pexp_attributes = e.pexp_attributes @ other_attributes;
+                  }
+              | _ -> Ast_compatible.app1 ~loc ~attrs:e.pexp_attributes f a))
       | Some { op = "##"; loc; args = [ obj; rest ] } -> (
           (* - obj##property
              - obj#(method a b )
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
