Fast pipe sugar

formatTest/typeCheckedTests/expected_output/fastPipe.re

@@ -0,0 +1,119 @@
+/* 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 t2 = (x, f, g) =>
+              x ->f ->g(x, x) ->f(x);
+            let t3 = (x, f) =>
+              x ->f(~h=1, ~x=2);
+          }: {
+            let t0: ('a, 'a => 'a) => 'a;
+            let t1: ('a, 'a => 'b) => 'b;
+            let t2:
+              (
+                'a,
+                ('a, 'a) => 'b,
+                ('a => 'b, 'a, 'a) => 'a
+              ) =>
+              'b;
+            let t3:
+              (
+                'a,
+                ('a, ~h: int, ~x: int) => 'b
+              ) =>
+              'b;
+          }
+        );
+
+let f = (a, b, c) => a ->(b, c);
+
+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 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 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;
+
+include (
+          {
+            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);
+            let t3 = (x, f) =>
+              x ->f(~h=1, ~x=2);
+          }: {
+            let t0: ('a, 'a => 'a) => 'a;
+            let t1: ('a, 'a => 'b) => 'b;
+            let t2:
+              (
+                'a,
+                ('a, 'a) => 'b,
+                ('a => 'b, 'a, 'a) => 'a
+              ) =>
+              'b;
+            let t3:
+              (
+                'a,
+                ('a, ~h: int, ~x: int) => 'b
+              ) =>
+              'b;
+          }
+        );
+
+let f = (a, b, c) => a ->(b, c);
+
+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 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 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);
+
+/* 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 = {
+  let f = (a, b, c) => a + b + c;
+};
+F.(1 ->f(2, 3));
+F.(1 ->f(2, 3));

formatTest/typeCheckedTests/input/fastPipe.re

@@ -0,0 +1,85 @@
+/* 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 t2 = (x, f, g) => x |. f |. g(x, x) |. f(x);
+    let t3 = (x, f) => x |. f(~h=1, ~x=2);
+  }: {
+    let t0: ('a, 'a => 'a) => 'a;
+    let t1: ('a, 'a => 'b) => 'b;
+    let t2: ('a, ('a, 'a) => 'b, ('a => 'b, 'a, 'a) => 'a) => 'b;
+    let t3: ('a, ('a, ~h: int, ~x: int) => 'b) => 'b;
+  }
+);
+
+let f = (a, b, c) => a |. (b, c);
+
+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 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 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;
+
+include (
+  {
+    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);
+    let t3 = (x, f) => x -> f(~h=1, ~x=2);
+  }: {
+    let t0: ('a, 'a => 'a) => 'a;
+    let t1: ('a, 'a => 'b) => 'b;
+    let t2: ('a, ('a, 'a) => 'b, ('a => 'b, 'a, 'a) => 'a) => 'b;
+    let t3: ('a, ('a, ~h: int, ~x: int) => 'b) => 'b;
+  }
+);
+
+let f = (a, b, c) => a -> (b, c);
+
+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 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 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);
+
+/* 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 = {
+  let f = (a, b, c) => a + b + c;
+};
+1 -> F.(f(2, 3));
+1 |. F.(f(2, 3));

src/reason-parser/jbuild

@@ -53,6 +53,7 @@
   (wrapped false)
   (modules
    (lexer_warning
+    reason_ast
     reason_syntax_util
     reason_comment
     reason_layout

src/reason-parser/reason_ast.ml

@@ -0,0 +1,110 @@
+open Ast_404
+open Parsetree
+open Asttypes
+open Ast_helper
+
+let parseFastPipe e1 e2 =
+  let attr = (Location.mknoloc "reason.fast_pipe", PStr []) in
+  let markFastPipe e = { e with pexp_attributes =
+    attr::e.pexp_attributes
+  } in
+  let rec rewrite e = match e.pexp_desc with
+  | Pexp_ident _ ->
+    Ast_helper.Exp.apply e [Nolabel, e1]
+  | Pexp_apply(f, args) ->
+    Ast_helper.Exp.apply f ((Nolabel, e1)::args)
+  | Pexp_construct(lident, None) ->
+    Ast_helper.Exp.construct lident (Some e1)
+  | Pexp_construct(lident, Some({pexp_desc=Pexp_tuple l})) ->
+    Ast_helper.Exp.construct
+      ~attrs:[Location.mknoloc "explicit_arity", PStr []]
+      lident
+      (Some (Ast_helper.Exp.tuple (e1::l)))
+  | Pexp_fun(
+      Nolabel,
+      None,
+      _,
+      {pexp_desc=Pexp_apply(f, args)})
+    ->
+    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(e.pexp_loc, (Syntax_error msg)))
+  in
+  markFastPipe (rewrite e2)
+
+let unparseFastPipe e =
+  let minusGreater = Ast_helper.Exp.ident (Location.mknoloc (Longident.parse "->")) in
+  let rec rewrite e = match e.pexp_desc with
+    | Pexp_apply(f, (Nolabel, e1)::args) ->
+      let f = match args with
+      | [] -> f
+      | args -> Ast_helper.Exp.apply f args
+      in
+      Ast_helper.Exp.apply ~attrs:e.pexp_attributes
+        minusGreater
+        [(Nolabel, e1); (Nolabel, f)]
+    | Pexp_construct(lident, Some tupArg) ->
+        let (tupArg, ctorChild) = match tupArg.pexp_desc with
+          | Pexp_tuple(x::xs) ->
+              begin match xs with
+              | y::_ys -> (x, Some(Ast_helper.Exp.tuple xs))
+              | [] -> (x, None)
+              end
+          | _ -> (tupArg, None)
+        in
+        let ctor =
+          Ast_helper.Exp.construct
+            ~attrs:[Location.mknoloc "explicit_arity", PStr []]
+            lident ctorChild
+        in
+        Ast_helper.Exp.apply
+          minusGreater
+          [(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

src/reason-parser/reason_ast.mli

@@ -0,0 +1,5 @@
+(** rewrites `a -> f(b)` as `[@reason.fast_pipe] f(a, b)` *)
+val parseFastPipe : Ast_404.Parsetree.expression -> Ast_404.Parsetree.expression -> Ast_404.Parsetree.expression
+
+(** rewrites `[@reason.fast_pipe] f(a, b)` as `a -> f(b)` *)
+val unparseFastPipe : Ast_404.Parsetree.expression -> Ast_404.Parsetree.expression

src/reason-parser/reason_parser.mly

@@ -1267,7 +1267,7 @@ conflicts.
 
 %right    OR BARBAR                     (* expr (e || e || e) *)
 %right    AMPERSAND AMPERAMPER          (* expr (e && e && e) *)
-%left     INFIXOP0 INFIXOP_WITH_EQUAL LESS GREATER (* expr (e OP e OP e) *)
+%left     INFIXOP0 INFIXOP_WITH_EQUAL LESS GREATER MINUSGREATER (* expr (e OP e OP e) *)
 %left     LESSDOTDOTGREATER (* expr (e OP e OP e) *)
 %right    INFIXOP1                      (* expr (e OP e OP e) *)
 %right    COLONCOLON                    (* expr (e :: e :: e) *)
@@ -2831,7 +2831,11 @@ mark_position_exp
       mkexp_cons loc_colon (mkexp ~ghost:true ~loc (Pexp_tuple[$5;$7])) loc
     }
   | E as_loc(infix_operator) expr
-    { mkinfix $1 $2 $3 }
+    { match $2.txt with
+      | "|."
+      | "->" -> Reason_ast.parseFastPipe $1 $3
+      | _ -> mkinfix $1 $2 $3
+    }
   | as_loc(subtractive) expr %prec prec_unary
     { mkuminus $1 $2 }
   | as_loc(additive) expr %prec prec_unary
@@ -4528,6 +4532,7 @@ val_ident:
      operator swapping requires that we express that as != *)
   | LESSDOTDOTGREATER { "<..>" }
   | GREATER GREATER   { ">>" }
+  | MINUSGREATER { "->" }
 ;
 
 operator: