Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Commit d10ac6e

Browse files
Merge pull request #12 from tomgasson/iflet
Add `if let` syntax
2 parents 5e87f9d + 2131063 commit d10ac6e

File tree

8 files changed

+808
-120
lines changed

8 files changed

+808
-120
lines changed

src/napkin_core.ml

Lines changed: 76 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,8 @@ end
8383
let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr [])
8484
let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr [])
8585
let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr [])
86+
let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr [])
87+
let suppressFragileMatchWarningAttr = (Location.mknoloc "warning", Parsetree.PStr [Ast_helper.Str.eval (Ast_helper.Exp.constant (Pconst_string ("-4", None)))])
8688
let makeBracesAttr loc = (Location.mkloc "ns.braces" loc, Parsetree.PStr [])
8789

8890
type typDefOrExt =
@@ -2000,7 +2002,7 @@ and parseOperandExpr ~context p =
20002002
| Try ->
20012003
parseTryExpression p
20022004
| If ->
2003-
parseIfExpression p
2005+
parseIfOrIfLetExpression p
20042006
| For ->
20052007
parseForExpression p
20062008
| While ->
@@ -2996,20 +2998,30 @@ and parseTryExpression p =
29962998
let loc = mkLoc startPos p.prevEndPos in
29972999
Ast_helper.Exp.try_ ~loc expr cases
29983000

2999-
and parseIfExpression p =
3000-
Parser.beginRegion p;
3001-
Parser.leaveBreadcrumb p Grammar.ExprIf;
3002-
let startPos = p.Parser.startPos in
3003-
Parser.expect If p;
3001+
and parseIfCondition p =
30043002
Parser.leaveBreadcrumb p Grammar.IfCondition;
30053003
(* doesn't make sense to try es6 arrow here? *)
30063004
let conditionExpr = parseExpr ~context:WhenExpr p in
30073005
Parser.eatBreadcrumb p;
3006+
conditionExpr
3007+
3008+
and parseThenBranch p =
30083009
Parser.leaveBreadcrumb p IfBranch;
30093010
Parser.expect Lbrace p;
30103011
let thenExpr = parseExprBlock p in
30113012
Parser.expect Rbrace p;
30123013
Parser.eatBreadcrumb p;
3014+
thenExpr
3015+
3016+
and parseElseBranch p =
3017+
Parser.expect Lbrace p;
3018+
let blockExpr = parseExprBlock p in
3019+
Parser.expect Rbrace p;
3020+
blockExpr;
3021+
3022+
and parseIfExpr startPos p =
3023+
let conditionExpr = parseIfCondition p in
3024+
let thenExpr = parseThenBranch p in
30133025
let elseExpr = match p.Parser.token with
30143026
| Else ->
30153027
Parser.endRegion p;
@@ -3018,12 +3030,9 @@ and parseIfExpression p =
30183030
Parser.beginRegion p;
30193031
let elseExpr = match p.token with
30203032
| If ->
3021-
parseIfExpression p
3033+
parseIfOrIfLetExpression p
30223034
| _ ->
3023-
Parser.expect Lbrace p;
3024-
let blockExpr = parseExprBlock p in
3025-
Parser.expect Rbrace p;
3026-
blockExpr
3035+
parseElseBranch p
30273036
in
30283037
Parser.eatBreadcrumb p;
30293038
Parser.endRegion p;
@@ -3033,9 +3042,55 @@ and parseIfExpression p =
30333042
None
30343043
in
30353044
let loc = mkLoc startPos p.prevEndPos in
3036-
Parser.eatBreadcrumb p;
30373045
Ast_helper.Exp.ifthenelse ~loc conditionExpr thenExpr elseExpr
30383046

3047+
and parseIfLetExpr startPos p =
3048+
let pattern = parsePattern p in
3049+
Parser.expect Equal p;
3050+
let conditionExpr = parseIfCondition p in
3051+
let thenExpr = parseThenBranch p in
3052+
let elseExpr = match p.Parser.token with
3053+
| Else ->
3054+
Parser.endRegion p;
3055+
Parser.leaveBreadcrumb p Grammar.ElseBranch;
3056+
Parser.next p;
3057+
Parser.beginRegion p;
3058+
let elseExpr = match p.token with
3059+
| If ->
3060+
parseIfOrIfLetExpression p
3061+
| _ ->
3062+
parseElseBranch p
3063+
in
3064+
Parser.eatBreadcrumb p;
3065+
Parser.endRegion p;
3066+
elseExpr
3067+
| _ ->
3068+
Parser.endRegion p;
3069+
let startPos = p.Parser.startPos in
3070+
let loc = mkLoc startPos p.prevEndPos in
3071+
Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None
3072+
in
3073+
let loc = mkLoc startPos p.prevEndPos in
3074+
Ast_helper.Exp.match_ ~attrs:[ifLetAttr; suppressFragileMatchWarningAttr] ~loc conditionExpr [
3075+
Ast_helper.Exp.case pattern thenExpr;
3076+
Ast_helper.Exp.case (Ast_helper.Pat.any ()) elseExpr;
3077+
]
3078+
3079+
and parseIfOrIfLetExpression p =
3080+
Parser.beginRegion p;
3081+
Parser.leaveBreadcrumb p Grammar.ExprIf;
3082+
let startPos = p.Parser.startPos in
3083+
Parser.expect If p;
3084+
let expr = match p.Parser.token with
3085+
| Let ->
3086+
Parser.next p;
3087+
parseIfLetExpr startPos p
3088+
| _ ->
3089+
parseIfExpr startPos p
3090+
in
3091+
Parser.eatBreadcrumb p;
3092+
expr;
3093+
30393094
and parseForRest hasOpeningParen pattern startPos p =
30403095
Parser.expect In p;
30413096
let e1 = parseExpr p in
@@ -3098,20 +3153,22 @@ and parseWhileExpression p =
30983153
let loc = mkLoc startPos p.prevEndPos in
30993154
Ast_helper.Exp.while_ ~loc expr1 expr2
31003155

3156+
and parsePatternGuard p =
3157+
match p.Parser.token with
3158+
| When ->
3159+
Parser.next p;
3160+
Some (parseExpr ~context:WhenExpr p)
3161+
| _ ->
3162+
None
3163+
31013164
and parsePatternMatchCase p =
31023165
Parser.beginRegion p;
31033166
Parser.leaveBreadcrumb p Grammar.PatternMatchCase;
31043167
match p.Parser.token with
31053168
| Token.Bar ->
31063169
Parser.next p;
31073170
let lhs = parsePattern p in
3108-
let guard = match p.Parser.token with
3109-
| When ->
3110-
Parser.next p;
3111-
Some (parseExpr ~context:WhenExpr p)
3112-
| _ ->
3113-
None
3114-
in
3171+
let guard = parsePatternGuard p in
31153172
let () = match p.token with
31163173
| EqualGreater -> Parser.next p
31173174
| _ -> Recover.recoverEqualGreater p

src/napkin_parsetree_viewer.ml

Lines changed: 72 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -42,18 +42,6 @@ open Parsetree
4242
in
4343
process false [] attrs
4444

45-
let collectIfExpressions expr =
46-
let rec collect acc expr = match expr.pexp_desc with
47-
| Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) ->
48-
collect ((ifExpr, thenExpr)::acc) elseExpr
49-
| Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) ->
50-
let ifs = List.rev ((ifExpr, thenExpr)::acc) in
51-
(ifs, elseExpr)
52-
| _ ->
53-
(List.rev acc, Some expr)
54-
in
55-
collect [] expr
56-
5745
let collectListExpressions expr =
5846
let rec collect acc expr = match expr.pexp_desc with
5947
| Pexp_construct ({txt = Longident.Lident "[]"}, _) ->
@@ -165,7 +153,7 @@ open Parsetree
165153
let filterParsingAttrs attrs =
166154
List.filter (fun attr ->
167155
match attr with
168-
| ({Location.txt = ("ns.ternary" | "ns.braces" | "bs" | "ns.namedArgLoc")}, _) -> false
156+
| ({Location.txt = ("ns.ternary" | "ns.braces" | "bs" | "ns.iflet" | "ns.namedArgLoc")}, _) -> false
169157
| _ -> true
170158
) attrs
171159

@@ -267,9 +255,30 @@ open Parsetree
267255
else
268256
false
269257

258+
let rec hasIfLetAttribute attrs =
259+
match attrs with
260+
| [] -> false
261+
| ({Location.txt="ns.iflet"},_)::_ -> true
262+
| _::attrs -> hasIfLetAttribute attrs
263+
264+
let isIfLetExpr expr = match expr with
265+
| {
266+
pexp_attributes = attrs;
267+
pexp_desc = Pexp_match _
268+
} when hasIfLetAttribute attrs -> true
269+
| _ -> false
270+
270271
let hasAttributes attrs =
271272
List.exists (fun attr -> match attr with
272-
| ({Location.txt = "bs" | "ns.ternary" | "ns.braces"}, _) -> false
273+
| ({Location.txt = "bs" | "ns.ternary" | "ns.braces" | "ns.iflet"}, _) -> false
274+
(* Remove the fragile pattern warning for iflet expressions *)
275+
| ({Location.txt="warning"}, PStr [{
276+
pstr_desc = Pstr_eval ({
277+
pexp_desc = Pexp_constant (
278+
Pconst_string ("-4", None)
279+
)
280+
}, _)
281+
}]) -> not (hasIfLetAttribute attrs)
273282
| _ -> true
274283
) attrs
275284

@@ -280,6 +289,40 @@ open Parsetree
280289
) -> true
281290
| _ -> false
282291

292+
293+
type ifConditionKind =
294+
| If of Parsetree.expression
295+
| IfLet of Parsetree.pattern * Parsetree.expression
296+
297+
let collectIfExpressions expr =
298+
let rec collect acc expr = match expr.pexp_desc with
299+
| Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) ->
300+
collect ((If(ifExpr), thenExpr)::acc) elseExpr
301+
| Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) ->
302+
let ifs = List.rev ((If(ifExpr), thenExpr)::acc) in
303+
(ifs, elseExpr)
304+
| Pexp_match (condition, [{
305+
pc_lhs = pattern;
306+
pc_guard = None;
307+
pc_rhs = thenExpr;
308+
}; {
309+
pc_rhs = {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}
310+
}]) when isIfLetExpr expr ->
311+
let ifs = List.rev ((IfLet(pattern, condition), thenExpr)::acc) in
312+
(ifs, None)
313+
| Pexp_match (condition, [{
314+
pc_lhs = pattern;
315+
pc_guard = None;
316+
pc_rhs = thenExpr;
317+
}; {
318+
pc_rhs = elseExpr;
319+
}]) when isIfLetExpr expr ->
320+
collect ((IfLet(pattern, condition), thenExpr)::acc) elseExpr
321+
| _ ->
322+
(List.rev acc, Some expr)
323+
in
324+
collect [] expr
325+
283326
let rec hasTernaryAttribute attrs =
284327
match attrs with
285328
| [] -> false
@@ -318,6 +361,18 @@ open Parsetree
318361
| _ -> true
319362
) attrs
320363

364+
let filterFragileMatchAttributes attrs =
365+
List.filter (fun attr -> match attr with
366+
| ({Location.txt="warning"}, PStr [{
367+
pstr_desc = Pstr_eval ({
368+
pexp_desc = Pexp_constant (
369+
Pconst_string ("-4", _)
370+
)
371+
}, _)
372+
}]) -> false
373+
| _ -> true
374+
) attrs
375+
321376
let isJsxExpression expr =
322377
let rec loop attrs =
323378
match attrs with
@@ -371,13 +426,13 @@ open Parsetree
371426

372427
let filterPrinteableAttributes attrs =
373428
List.filter (fun attr -> match attr with
374-
| ({Location.txt="bs" | "ns.ternary"}, _) -> false
429+
| ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
375430
| _ -> true
376431
) attrs
377432

378433
let partitionPrinteableAttributes attrs =
379434
List.partition (fun attr -> match attr with
380-
| ({Location.txt="bs" | "ns.ternary"}, _) -> false
435+
| ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
381436
| _ -> true
382437
) attrs
383438

@@ -513,4 +568,4 @@ open Parsetree
513568
{ppat_desc = Ppat_var {txt="__x"}},
514569
{pexp_desc = Pexp_apply _}
515570
) -> true
516-
| _ -> false
571+
| _ -> false

src/napkin_parsetree_viewer.mli

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,16 @@ val functorType: Parsetree.module_type ->
1313
(* filters @bs out of the provided attributes *)
1414
val processUncurriedAttribute: Parsetree.attributes -> bool * Parsetree.attributes
1515

16+
type ifConditionKind =
17+
| If of Parsetree.expression
18+
| IfLet of Parsetree.pattern * Parsetree.expression
19+
1620
(* if ... else if ... else ... is represented as nested expressions: if ... else { if ... }
1721
* The purpose of this function is to flatten nested ifs into one sequence.
1822
* Basically compute: ([if, else if, else if, else if], else) *)
1923
val collectIfExpressions:
2024
Parsetree.expression ->
21-
(Parsetree.expression * Parsetree.expression) list * Parsetree.expression option
25+
(ifConditionKind * Parsetree.expression) list * Parsetree.expression option
2226

2327
val collectListExpressions:
2428
Parsetree.expression -> (Parsetree.expression list * Parsetree.expression option)
@@ -62,13 +66,15 @@ val hasAttributes: Parsetree.attributes -> bool
6266

6367
val isArrayAccess: Parsetree.expression -> bool
6468
val isTernaryExpr: Parsetree.expression -> bool
69+
val isIfLetExpr: Parsetree.expression -> bool
6570

6671
val collectTernaryParts: Parsetree.expression -> ((Parsetree.expression * Parsetree.expression) list * Parsetree.expression)
6772

6873
val parametersShouldHug:
6974
funParamKind list -> bool
7075

7176
val filterTernaryAttributes: Parsetree.attributes -> Parsetree.attributes
77+
val filterFragileMatchAttributes: Parsetree.attributes -> Parsetree.attributes
7278

7379
val isJsxExpression: Parsetree.expression -> bool
7480
val hasJsxAttribute: Parsetree.attributes -> bool
@@ -90,7 +96,7 @@ val modExprApply : Parsetree.module_expr -> (
9096
* Example: given a ptyp_arrow type, what are its arguments and what is the
9197
* returnType? *)
9298

93-
99+
94100
val modExprFunctor : Parsetree.module_expr -> (
95101
(Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list *
96102
Parsetree.module_expr
@@ -130,4 +136,4 @@ val classifyJsImport: Parsetree.value_description -> jsImportScope
130136
val rewriteUnderscoreApply: Parsetree.expression -> Parsetree.expression
131137

132138
(* (__x) => f(a, __x, c) -----> f(a, _, c) *)
133-
val isUnderscoreApplySugar: Parsetree.expression -> bool
139+
val isUnderscoreApplySugar: Parsetree.expression -> bool

0 commit comments

Comments
 (0)