Fix issue where the internal ppx for pipe -> would not use uncurried application in uncurried mode.

Author: cristianoc

CHANGELOG.md

@@ -46,6 +46,7 @@
 - Fix issue with infinite loops with type errors on recursive types. https://github.com/rescript-lang/rescript-compiler/pull/6867
 - Fix issue where using partial application `...` can generate code that uses `Curry` at runtime. https://github.com/rescript-lang/rescript-compiler/pull/6872
 - Avoid generation of `Curry` with reverse application `|>`. https://github.com/rescript-lang/rescript-compiler/pull/6876
+- Fix issue where the internal ppx for pipe `->` would not use uncurried application in uncurried mode. https://github.com/rescript-lang/rescript-compiler/pull/6878
 
 #### :house: Internal
 

jscomp/frontend/ast_attributes.ml

@@ -293,11 +293,6 @@ let locg = Location.none
 (* let bs : attr
    =  {txt = "bs" ; loc = locg}, Ast_payload.empty *)
 
-let is_bs (attr : attr) =
-  match attr with
-  | {Location.txt = "bs"; _}, _ -> true
-  | _ -> false
-
 let res_uapp : attr = ({txt = "res.uapp"; loc = locg}, Ast_payload.empty)
 
 let get : attr = ({txt = "get"; loc = locg}, Ast_payload.empty)

jscomp/frontend/ast_attributes.mli

@@ -60,15 +60,6 @@ val iter_process_bs_string_or_int_as : t -> as_const_payload option
 
 val process_derive_type : t -> derive_attr * t
 
-(* val iter_process_derive_type :
-   t -> derive_attr
-
-
-   val bs : attr *)
-val is_bs : attr -> bool
-(* val is_optional : attr -> bool
-   val is_bs_as : attr -> bool *)
-
 (* Attribute for uncurried application coming from the ReScript parser *)
 val res_uapp : attr
 

jscomp/frontend/ast_exp_apply.ml

@@ -32,15 +32,15 @@ let rec no_need_bound (exp : exp) =
   | Pexp_constraint (e, _) -> no_need_bound e
   | _ -> false
 
-let ocaml_obj_id = "__ocaml_internal_obj"
+let tuple_obj_id = "__tuple_internal_obj"
 
 let bound (e : exp) (cb : exp -> _) =
   if no_need_bound e then cb e
   else
     let loc = e.pexp_loc in
     Exp.let_ ~loc Nonrecursive
-      [Vb.mk ~loc (Pat.var ~loc {txt = ocaml_obj_id; loc}) e]
-      (cb (Exp.ident ~loc {txt = Lident ocaml_obj_id; loc}))
+      [Vb.mk ~loc (Pat.var ~loc {txt = tuple_obj_id; loc}) e]
+      (cb (Exp.ident ~loc {txt = Lident tuple_obj_id; loc}))
 
 let default_expr_mapper = Bs_ast_mapper.default_mapper.expr
 
@@ -71,8 +71,7 @@ let view_as_app (fn : exp) (s : string list) : app_pattern option =
 
 let infix_ops = ["|."; "|.u"; "#="; "##"]
 
-let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
-    (args : Ast_compatible.args) : exp =
+let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
   match view_as_app e infix_ops with
   | Some {op = ("|." | "|.u") as op; args = [a_; f_]; loc} -> (
     (*
@@ -82,6 +81,11 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
         a |. `Variant
         a |. (b |. f c [@bs])
       *)
+    let add_uncurried_attr attrs =
+      if op = "|.u" && not (List.mem Ast_attributes.res_uapp attrs) then
+        Ast_attributes.res_uapp :: attrs
+      else attrs
+    in
     let a = self.expr self a_ in
     let f = self.expr self f_ in
     match f.pexp_desc with
@@ -94,7 +98,8 @@ 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 @ f.pexp_attributes;
+        pexp_attributes =
+          add_uncurried_attr (e.pexp_attributes @ f.pexp_attributes);
       }
     | Pexp_tuple xs ->
       bound a (fun bounded_obj_arg ->
@@ -114,22 +119,18 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
                        {
                          Parsetree.pexp_desc =
                            Pexp_apply (fn, (Nolabel, bounded_obj_arg) :: args);
-                         pexp_attributes = [];
+                         pexp_attributes = add_uncurried_attr [];
                          pexp_loc = fn.pexp_loc;
                        }
                      | _ ->
-                       Ast_compatible.app1 ~loc:fn.pexp_loc fn bounded_obj_arg));
+                       Ast_compatible.app1 ~loc:fn.pexp_loc
+                         ~attrs:(add_uncurried_attr []) fn bounded_obj_arg));
             pexp_attributes = f.pexp_attributes;
             pexp_loc = f.pexp_loc;
           })
     | _ ->
-      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)
+      Ast_compatible.app1 ~loc ~attrs:(add_uncurried_attr e.pexp_attributes) f a
+    )
   | Some {op = "##"; loc; args = [obj; rest]} -> (
     (* - obj##property
        - obj#(method a b )
@@ -202,21 +203,4 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
     Location.raise_errorf ~loc
       "Js object ## expect syntax like obj##(paint (a,b)) "
   | Some {op} -> Location.raise_errorf "invalid %s syntax" op
-  | None -> (
-    match Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs with
-    | Some pexp_attributes -> (
-      (* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
-      let fn = self.expr self fn in
-      let args = Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e)) in
-      let js_internal = Ast_literal.Lid.js_internal in
-      let loc = e.pexp_loc in
-      match args with
-      | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] ->
-        Exp.apply ~loc ~attrs:pexp_attributes
-          (Exp.ident {txt = Ldot (js_internal, "run"); loc})
-          [(Nolabel, fn)]
-      | _ ->
-        Exp.apply ~loc
-          ~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
-          fn args)
-    | None -> default_expr_mapper self e)
+  | None -> default_expr_mapper self e

jscomp/frontend/ast_exp_apply.mli

@@ -23,8 +23,4 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 val app_exp_mapper :
-  Parsetree.expression ->
-  Bs_ast_mapper.mapper ->
-  Parsetree.expression ->
-  Ast_compatible.args ->
-  Parsetree.expression
+  Parsetree.expression -> Bs_ast_mapper.mapper -> Parsetree.expression

jscomp/frontend/bs_builtin_ppx.ml

@@ -154,7 +154,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
           Ast_uncurry_gen.to_method_callback e.pexp_loc self label pat body;
         pexp_attributes;
       })
-  | Pexp_apply (fn, args) -> Ast_exp_apply.app_exp_mapper e self fn args
+  | Pexp_apply _ -> Ast_exp_apply.app_exp_mapper e self
   | Pexp_match
       ( b,
         [

jscomp/test/UncurriedAlways.js

@@ -91,8 +91,17 @@ module PartialApplication = {
   let fxyz = f3(~x=1, ~y=1, ~z=1, ...)
 }
 
-let hello1 = (y, f) => f(y)
+module ReverseApplication = {
+  let hello1 = (y, f) => f(y)
+  let hello2 = (y, f) => y |> f
+}
+
+module Pipe = {
+  let f = (a, b, c) => a->(b, c)
 
-let hello2 = (y, f) => y |> f
+  let f2 = (a, b, c, d, e) => a(b)->(c(d), d(1, 2), e)->(((u, v, h)) => u + v + h)
 
+  let f3 = (foo, x) => foo(x)
 
+  let f4 = (x, f) => x->f(3)
+}