Add prototype for tuple dispatch with fast pipe

formatTest/typeCheckedTests/expected_output/fastPipe.re

@@ -1,12 +1,12 @@
 /* tests adapted from https://github.com/BuckleScript/bucklescript/blob/master/jscomp/test/pipe_syntax.ml */
 include (
           {
-            let t0 = (x, f) => x -> f -> f -> f;
-            let t1 = (x, f) => x -> f;
+            let t0 = (x, f) => x ->f ->f ->f;
+            let t1 = (x, f) => x ->f;
             let t2 = (x, f, g) =>
-              x -> f -> g(x, x) -> f(x);
+              x ->f ->g(x, x) ->f(x);
             let t3 = (x, f) =>
-              x -> f(~h=1, ~x=2);
+              x ->f(~h=1, ~x=2);
           }: {
             let t0: ('a, 'a => 'a) => 'a;
             let t1: ('a, 'a => 'b) => 'b;
@@ -26,35 +26,38 @@ include (
           }
         );
 
-/* let f = (a, b, c) => a |. (b, c); */
+let f = (a, b, c) => a ->(b, c);
 
-/* let f1 = (a, b, c, d) => a(b) |. (c, d); */
+let f1 = (a, b, c, d) => a(b) ->(c, d);
 
-/* let f2 = (a, b, c, d) => { */
-/* let (u, v) = a(b) |. (c, d); */
-/* u + v; */
-/* }; */
+let f2 = (a, b, c, d) => {
+  let (u, v) = a(b) ->(c, d);
+  u + v;
+};
 
-/* let f3 = (a, b, c, d, e) => */
-/* a(b) |. (c(d), d(1, 2), e) |. (((u, v, h)) => u + v + h); */
+let f3 = (a, b, c, d, e) =>
+  a(b)
+  ->(c(d), d(1, 2), e)
+  ->(((u, v, h)) => u + v + h);
 
-/* let f4 = (a, b, c) => a |. (b(c), b(c)); */
+let f4 = (a, b, c) => a ->(b(c), b(c));
 
-/* let f5 = (a, b, c, d) => { */
-/* let (v0, v1, v2) = a |. (b(c, c), b(c, c), b(d, d)); */
-/* v0 + v1 + v2; */
-/* }; */
+let f5 = (a, b, c, d) => {
+  let (v0, v1, v2) =
+    a ->(b(c, c), b(c, c), b(d, d));
+  v0 + v1 + v2;
+};
 
-let f6 = a => a -> Some;
+let f6 = a => a ->Some;
 
 include (
           {
-            let t0 = (x, f) => x -> f -> f -> f;
-            let t1 = (x, f) => x -> f;
+            let t0 = (x, f) => x ->f ->f ->f;
+            let t1 = (x, f) => x ->f;
             let t2 = (x, f, g) =>
-              x -> f -> g(x, x) -> f(x);
+              x ->f ->g(x, x) ->f(x);
             let t3 = (x, f) =>
-              x -> f(~h=1, ~x=2);
+              x ->f(~h=1, ~x=2);
           }: {
             let t0: ('a, 'a => 'a) => 'a;
             let t1: ('a, 'a => 'b) => 'b;
@@ -74,36 +77,43 @@ include (
           }
         );
 
-/* let f = (a, b, c) => a -> (b, c); */
+let f = (a, b, c) => a ->(b, c);
 
-/* let f1 = (a, b, c, d) => a(b) -> (c, d); */
+let f1 = (a, b, c, d) => a(b) ->(c, d);
 
-/* let f2 = (a, b, c, d) => { */
-/* let (u, v) = a(b) -> (c, d); */
-/* u + v; */
-/* }; */
+let f2 = (a, b, c, d) => {
+  let (u, v) = a(b) ->(c, d);
+  u + v;
+};
 
-/* let f3 = (a, b, c, d, e) => */
-/* a(b) -> (c(d), d(1, 2), e) -> (((u, v, h)) => u + v + h); */
+let f3 = (a, b, c, d, e) =>
+  a(b)
+  ->(c(d), d(1, 2), e)
+  ->(((u, v, h)) => u + v + h);
 
-/* let f4 = (a, b, c) => a -> (b(c), b(c)); */
+let f4 = (a, b, c) => a ->(b(c), b(c));
 
-/* let f5 = (a, b, c, d) => { */
-/* let (v0, v1, v2) = a -> (b(c, c), b(c, c), b(d, d)); */
-/* v0 + v1 + v2; */
-/* }; */
+let f5 = (a, b, c, d) => {
+  let (v0, v1, v2) =
+    a ->(b(c, c), b(c, c), b(d, d));
+  v0 + v1 + v2;
+};
 
-let f6 = a => a -> Some;
+let f6 = a => a ->Some;
 
-/* let f7 = a => a |. (Some, Some, Some); */
+let f7 = a => a ->(Some, Some, Some);
 
 /* fast pipe in combination with underscore sugar */
-let f8 = (a, b, f) => a -> f(b, _);
-let f8 = (a, b, f) => a -> f(b, _);
+let f8 = (a, b, f) => a ->f(b, _);
+let f8 = (a, b, f) => a ->f(b, _);
+let f8 = (a, b, c, f, g) =>
+  a ->(f(b, _), g(c, _));
+let f8 = (a, b, c, f, g) =>
+  a ->(f(b, _), g(c, _));
 
 /* pipe into local fresh open */
 module F = {
   let f = (a, b, c) => a + b + c;
 };
-F.(1 -> f(2, 3));
-F.(1 -> f(2, 3));
+F.(1 ->f(2, 3));
+F.(1 ->f(2, 3));

formatTest/typeCheckedTests/input/fastPipe.re

@@ -13,24 +13,24 @@ include (
   }
 );
 
-/* let f = (a, b, c) => a |. (b, c); */
+let f = (a, b, c) => a |. (b, c);
 
-/* let f1 = (a, b, c, d) => a(b) |. (c, d); */
+let f1 = (a, b, c, d) => a(b) |. (c, d);
 
-/* let f2 = (a, b, c, d) => { */
-  /* let (u, v) = a(b) |. (c, d); */
-  /* u + v; */
-/* }; */
+let f2 = (a, b, c, d) => {
+  let (u, v) = a(b) |. (c, d);
+  u + v;
+};
 
-/* let f3 = (a, b, c, d, e) => */
-  /* a(b) |. (c(d), d(1, 2), e) |. (((u, v, h)) => u + v + h); */
+let f3 = (a, b, c, d, e) =>
+  a(b) |. (c(d), d(1, 2), e) |. (((u, v, h)) => u + v + h);
 
-/* let f4 = (a, b, c) => a |. (b(c), b(c)); */
+let f4 = (a, b, c) => a |. (b(c), b(c));
 
-/* let f5 = (a, b, c, d) => { */
-  /* let (v0, v1, v2) = a |. (b(c, c), b(c, c), b(d, d)); */
-  /* v0 + v1 + v2; */
-/* }; */
+let f5 = (a, b, c, d) => {
+  let (v0, v1, v2) = a |. (b(c, c), b(c, c), b(d, d));
+  v0 + v1 + v2;
+};
 
 let f6 = a => a |. Some;
 
@@ -48,32 +48,34 @@ include (
   }
 );
 
-/* let f = (a, b, c) => a -> (b, c); */
+let f = (a, b, c) => a -> (b, c);
 
-/* let f1 = (a, b, c, d) => a(b) -> (c, d); */
+let f1 = (a, b, c, d) => a(b) -> (c, d);
 
-/* let f2 = (a, b, c, d) => { */
-/* let (u, v) = a(b) -> (c, d); */
-/* u + v; */
-/* }; */
+let f2 = (a, b, c, d) => {
+  let (u, v) = a(b) -> (c, d);
+  u + v;
+};
 
-/* let f3 = (a, b, c, d, e) => */
-/* a(b) -> (c(d), d(1, 2), e) -> (((u, v, h)) => u + v + h); */
+let f3 = (a, b, c, d, e) =>
+  a(b) -> (c(d), d(1, 2), e) -> (((u, v, h)) => u + v + h);
 
-/* let f4 = (a, b, c) => a -> (b(c), b(c)); */
+let f4 = (a, b, c) => a -> (b(c), b(c));
 
-/* let f5 = (a, b, c, d) => { */
-/* let (v0, v1, v2) = a -> (b(c, c), b(c, c), b(d, d)); */
-/* v0 + v1 + v2; */
-/* }; */
+let f5 = (a, b, c, d) => {
+  let (v0, v1, v2) = a -> (b(c, c), b(c, c), b(d, d));
+  v0 + v1 + v2;
+};
 
 let f6 = a => a -> Some;
 
-/* let f7 = a => a |. (Some, Some, Some); */
+let f7 = a => a |. (Some, Some, Some);
 
 /* fast pipe in combination with underscore sugar */
 let f8 = (a, b, f) => a -> f(b, _);
 let f8 = (a, b, f) => a |. f(b, _);
+let f8 = (a, b, c, f, g) => a -> (f(b, _), g(c, _));
+let f8 = (a, b, c, f, g) => a |. (f(b, _), g(c, _));
 
 /* pipe into local fresh open */
 module F = {

src/reason-parser/reason_ast.ml

@@ -10,7 +10,7 @@ let parseFastPipe e1 e2 =
   } in
   let rec rewrite e = match e.pexp_desc with
   | Pexp_ident _ ->
-    Ast_helper.Exp.apply e2 [Nolabel, e1]
+    Ast_helper.Exp.apply e [Nolabel, e1]
   | Pexp_apply(f, args) ->
     Ast_helper.Exp.apply f ((Nolabel, e1)::args)
   | Pexp_construct(lident, None) ->
@@ -23,15 +23,17 @@ let parseFastPipe e1 e2 =
   | Pexp_fun(
       Nolabel,
       None,
-      {ppat_desc=Ppat_var({txt="__x"} )},
+      _,
       {pexp_desc=Pexp_apply(f, args)})
     ->
-    Ast_helper.Exp.apply e2 [Nolabel, e1]
+    Ast_helper.Exp.apply e [Nolabel, e1]
   | Pexp_open(Fresh, lident, subExp) ->
       { e with pexp_desc = Pexp_open(Fresh, lident, rewrite subExp) }
+  | Pexp_tuple(expList) ->
+      Ast_helper.Exp.tuple (List.map (fun e -> rewrite e) expList)
   | _ ->
     let msg = "Unsupported fast pipe expression" in
-    raise Reason_syntax_util.(Error(e2.pexp_loc, (Syntax_error msg)))
+    raise Reason_syntax_util.(Error(e.pexp_loc, (Syntax_error msg)))
   in
   markFastPipe (rewrite e2)
 
@@ -65,5 +67,44 @@ let unparseFastPipe e =
           [(Nolabel, tupArg); (Nolabel, ctor)]
     | Pexp_open(Fresh, lident, subExpr) ->
       {e with pexp_desc = Pexp_open(Fresh, lident, rewrite subExpr)}
+    | Pexp_tuple(expList) ->
+      let firstE = ref None in
+      let children = List.map (fun e ->
+        match e.pexp_desc with
+        | Pexp_ident i -> e
+        | Pexp_apply(f, (Nolabel, e1)::args) ->
+          firstE := Some e1;
+          begin match args with
+          | [] -> f
+          | _ -> Ast_helper.Exp.apply f args
+          end
+        | Pexp_construct(lident, Some subExp) ->
+            begin match subExp.pexp_desc with
+            | Pexp_tuple(hd::tail) ->
+                firstE := Some hd;
+                begin match tail with
+                | [] ->
+                  Ast_helper.Exp.ident lident
+                | _ ->
+                  Ast_helper.Exp.construct
+                    ~attrs:[Location.mknoloc "explicit_arity", PStr []]
+                    lident
+                    (Some (Ast_helper.Exp.tuple tail))
+                end
+            | _ ->
+              firstE := Some subExp;
+              Ast_helper.Exp.ident lident
+            end
+        | _ -> e
+      ) expList in
+      begin match !firstE with
+      | Some e1 ->
+          Ast_helper.Exp.apply
+            minusGreater
+            [(Nolabel, e1); (Nolabel, Ast_helper.Exp.tuple children)]
+      | None ->
+        Ast_helper.Exp.tuple children
+      end
     | _ -> e
-  in rewrite e
+  in
+  rewrite e

src/reason-parser/reason_pprint_ast.ml

@@ -2151,7 +2151,7 @@ let formatComputedInfixChain infixChainList =
      * |> f
      * |> z *)
     if List.length group < 2 then
-      makeList ~inline:(true, true) ~sep:(Sep " ") ~break:Layout.Never group
+      makeList ~inline:(true, true) ~sep:(Sep " ") group
     (* Basic equality operators require special formatting, we can't give it
      * 'classic' infix operator formatting, otherwise we would get
      * let example =
@@ -2162,7 +2162,7 @@ let formatComputedInfixChain infixChainList =
      *  *)
     else if List.mem currentToken equalityOperators then
       let hd = List.hd group in
-      let tl = makeList ~inline:(true, true) ~sep:(Sep " ") ~break:Layout.Never (List.tl group) in
+      let tl = makeList ~inline:(true, true) ~sep:(Sep " ") (List.tl group) in
       makeList ~inline:(true, true) ~sep:(Sep " ") ~break:IfNeed [hd; tl]
     else
       (* Represents `|> f` in foo |> f
@@ -2174,16 +2174,16 @@ let formatComputedInfixChain infixChainList =
        *     Printf.sprintf
        *       "okokok" uri meth headers body
        * )   <-- notice how this closing paren is on the same height as >|= *)
-      label ~break:`Never ~space:true (atom currentToken) (List.nth group 1)
+      let space = not (currentToken = "->") in
+      label ~break:`Never ~space (atom currentToken) (List.nth group 1)
   in
   let rec print acc group currentToken l =
     match l with
     | x::xs -> (match x with
       | InfixToken t ->
           if List.mem t requireIndentFor then
             let groupNode =
-              makeList ~inline:(true, true) ~sep:(Sep " ") ~break:Layout.Never
-                (group @ [atom t])
+              makeList ~inline:(true, true) ~sep:(Sep " ") (group @ [atom t])
             in
             let children =
               makeList ~inline:(true, true) ~preSpace:true ~break:IfNeed
@@ -3632,9 +3632,9 @@ let printer = object(self:'self)
   method unparseResolvedRule  = function
     | LayoutNode layoutNode -> layoutNode
     | InfixTree _ as infixTree ->
-          let infixChainList = computeInfixChain infixTree in
-          let l = formatComputedInfixChain infixChainList in
-          makeList ~inline:(true, true) ~sep:(Sep " ") ~break:IfNeed l
+        let infixChainList = computeInfixChain infixTree in
+        let l = formatComputedInfixChain infixChainList in
+        makeList ~inline:(true, true) ~sep:(Sep " ") ~break:IfNeed l
 
 
   method unparseExprApplicationItems x =