Skip to content

Commit

Permalink
Add prototype for tuple dispatch with fast pipe
Browse files Browse the repository at this point in the history
  • Loading branch information
Iwan committed Jun 12, 2018
1 parent 2530ceb commit 1899203
Show file tree
Hide file tree
Showing 4 changed files with 130 additions and 80 deletions.
88 changes: 47 additions & 41 deletions formatTest/typeCheckedTests/expected_output/fastPipe.re
View file
Original file line number Diff line number Diff line change
@@ -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;
Expand All @@ -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;
Expand All @@ -74,36 +77,39 @@ 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, _);

/* 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));
54 changes: 27 additions & 27 deletions formatTest/typeCheckedTests/input/fastPipe.re
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand All @@ -48,28 +48,28 @@ 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, _);
Expand Down
50 changes: 47 additions & 3 deletions src/reason-parser/reason_ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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) ->
Expand All @@ -23,12 +23,17 @@ let parseFastPipe e1 e2 =
| Pexp_fun(
Nolabel,
None,
{ppat_desc=Ppat_var({txt="__x"} )},
(* {ppat_desc=Ppat_var({txt="__x"} )}, *)
_,
{pexp_desc=Pexp_apply(f, args)})
->
Ast_helper.Exp.apply e2 [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)))
Expand Down Expand Up @@ -65,5 +70,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
18 changes: 9 additions & 9 deletions src/reason-parser/reason_pprint_ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -3682,8 +3682,8 @@ let printer = object(self:'self)
if fastPipe then Reason_ast.unparseFastPipe e else e
method unparseExprRecurse x =
let x = self#processFastPipe x in
let x = self#process_underscore_application x in
let x = self#processFastPipe x in
(* If there are any attributes, render unary like `(~-) x [@ppx]`, and infix like `(+) x y [@attr]` *)
let {arityAttrs; stdAttrs; jsxAttrs; literalAttrs; uncurried} =
Expand Down

0 comments on commit 1899203

Please sign in to comment.