Add support for or-patterns

Rust got full-blown support for or-patterns (see [RFC 2535][0]). This
means a couple changes:

  * `OrP` is a new variant of `Pat`
  * `WhileLet`, `IfLet`, `Arm` now just take a `Pat` (instead of a list)
  * in the parser, or-patterns are not allowed everywhere that regular
    patterns are!

Tests cases were heavily inspired by [the PR that implemented the RFC][1].

[0]: https://github.com/rust-lang/rfcs/blob/master/text/2535-or-patterns.md#grammar
[1]: rust-lang/rust#63693

Author: harpocrates

src/Language/Rust/Parser/Internal.y

@@ -72,7 +72,7 @@ import qualified Data.List.NonEmpty as N
 %name parseLit lit
 %name parseAttr export_attribute
 %name parseTy ty
-%name parsePat pat
+%name parsePat or_pat
 %name parseStmt stmt
 %name parseExpr expr
 %name parseItem mod_item
@@ -805,6 +805,10 @@ lambda_arg :: { Arg Span }
 -- Patterns --
 --------------
 
+top_pat :: { Pat Span }
+  : '|' or_pat  { $> }
+  |     or_pat  { $> }
+
 -- There is a funky trick going on here around 'IdentP'. When there is a binding mode (ie a 'mut' or
 -- 'ref') or an '@' pattern, everything is fine, but otherwise there is no difference between an
 -- expression variable path and a pattern. To deal with this, we intercept expression paths with
@@ -831,20 +835,27 @@ pat :: { Pat Span }
   | expr_qual_path                  { PathP (Just (fst (unspan $1))) (snd (unspan $1)) ($1 # $>) }
   | lit_or_path '...' lit_or_path   { RangeP $1 $3 ($1 # $>) }
   | lit_or_path '..=' lit_or_path   { RangeP $1 $3 ($1 # $>) }
-  | expr_path '{' '..' '}'          { StructP $1 [] True ($1 # $>) }
   | expr_path '{' pat_fields '}'    { let (fs,b) = $3 in StructP $1 fs b ($1 # $>) }
-  | expr_path '(' sep_byT(pat,',') ')' { TupleStructP $1 $3 ($1 # $>) }
+  | expr_path '(' sep_byT(or_pat,',') ')' { TupleStructP $1 $3 ($1 # $>) }
   | expr_mac                        { MacP $1 (spanOf $1) }
-  | '[' sep_byT(pat,',') ']'        { SliceP $2 ($1 # $>) }
+  | '[' sep_byT(or_pat,',') ']'     { SliceP $2 ($1 # $>) }
   | '('                      ')'    { TupleP [] ($1 # $>) }
-  | '(' sep_by1(pat,',') ',' ')'    { TupleP (toList $2) ($1 # $>) }
-  | '(' sep_by1(pat,',')     ')'    {
+  | '(' sep_by1(or_pat,',') ',' ')' { TupleP (toList $2) ($1 # $>) }
+  | '(' sep_by1(or_pat,',')     ')' {
       case toList $2 of
         l @ [RestP _] -> TupleP l ($1 # $>)   -- (..) is a tuple pattern
         [p] -> ParenP p ($1 # $>)             -- (<pat>) is parenthesis around a pattern
         l -> TupleP l ($1 # $>)               -- (<pat1>, <pat2>) is a tuple pattern
     }
 
+-- Or-pattern
+or_pat :: { Pat Span }
+  : sep_by1(pat,'|')     {
+      case toNonEmpty $1 of
+        [p] -> p
+        ps -> OrP ps (spanOf ps)
+    }
+
 -- Endpoints of range patterns
 lit_or_path :: { Expr Span }
   : expr_path         { PathExpr [] Nothing $1 (spanOf $1) }
@@ -854,15 +865,16 @@ lit_or_path :: { Expr Span }
 
 -- Used in patterns for expression patterns
 pat_fields :: { ([FieldPat Span], Bool) }
-  : sep_byT(pat_field,',')           { ($1, False) }
+  : '..'                             { ([], True) }
+  | sep_byT(pat_field,',')           { ($1, False) }
   | sep_by1(pat_field,',') ',' '..'  { (toList $1, True) }
 
 pat_field :: { FieldPat Span }
   :     binding_mode ident
     { FieldPat Nothing (IdentP (unspan $1) (unspan $2) Nothing (spanOf $2)) ($1 # $2) }
   | box binding_mode ident
     { FieldPat Nothing (BoxP (IdentP (unspan $2) (unspan $3) Nothing ($2 # $3)) ($1 # $3)) ($1 # $3) }
-  |     binding_mode ident ':' pat
+  |     binding_mode ident ':' or_pat
     { FieldPat (Just (unspan $2)) $4 ($1 # $2 # $4) }
 
 
@@ -1090,12 +1102,12 @@ block_like_expr :: { Expr Span }
   : if_expr                                                      { $1 }
   |           loop                            inner_attrs_block  { let (as,b) = $> in Loop as b Nothing ($1 # b) }
   | label ':' loop                            inner_attrs_block  { let (as,b) = $> in Loop as b (Just $1) ($1 # b) }
-  |           for pat in nostruct_expr        inner_attrs_block  { let (as,b) = $> in ForLoop as $2 $4 b Nothing ($1 # b) }
-  | label ':' for pat in nostruct_expr        inner_attrs_block  { let (as,b) = $> in ForLoop as $4 $6 b (Just $1) ($1 # b) }
+  |           for top_pat in nostruct_expr        inner_attrs_block  { let (as,b) = $> in ForLoop as $2 $4 b Nothing ($1 # b) }
+  | label ':' for top_pat in nostruct_expr        inner_attrs_block  { let (as,b) = $> in ForLoop as $4 $6 b (Just $1) ($1 # b) }
   |           while             nostruct_expr inner_attrs_block  { let (as,b) = $> in While as $2 b Nothing ($1 # b) }
   | label ':' while             nostruct_expr inner_attrs_block  { let (as,b) = $> in While as $4 b (Just $1) ($1 # b) }
-  |           while let pats '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $3 $5 b Nothing ($1 # b) }
-  | label ':' while let pats '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $5 $7 b (Just $1) ($1 # b) }
+  |           while let top_pat '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $3 $5 b Nothing ($1 # b) }
+  | label ':' while let top_pat '=' nostruct_expr inner_attrs_block { let (as,b) = $> in WhileLet as $5 $7 b (Just $1) ($1 # b) }
   | match nostruct_expr '{'                  '}'                 { Match [] $2 [] ($1 # $>) }
   | match nostruct_expr '{' inner_attrs      '}'                 { Match (toList $4) $2 [] ($1 # $>) }
   | match nostruct_expr '{'             arms '}'                 { Match [] $2 $4 ($1 # $>) }
@@ -1107,8 +1119,8 @@ block_like_expr :: { Expr Span }
 
 -- 'if' expressions are a bit special since they can have an arbitrary number of 'else if' chains.
 if_expr :: { Expr Span }
-  : if              nostruct_expr block else_expr       { If [] $2 $3 $4 ($1 # $3 # $>) }
-  | if let pats '=' nostruct_expr block else_expr       { IfLet [] $3 $5 $6 $7 ($1 # $6 # $>) }
+  : if                 nostruct_expr block else_expr    { If [] $2 $3 $4 ($1 # $3 # $>) }
+  | if let top_pat '=' nostruct_expr block else_expr    { IfLet [] $3 $5 $6 $7 ($1 # $6 # $>) }
 
 else_expr :: { Maybe (Expr Span) }
   : else block                                          { Just (BlockExpr [] $2 (spanOf $2)) }
@@ -1120,11 +1132,7 @@ else_expr :: { Maybe (Expr Span) }
 arms :: { [Arm Span] }
   : ntArm                                               { [$1] }
   | ntArm arms                                          { $1 : $2 }
-  | many(outer_attribute) pats arm_guard '=>' expr_arms { let (e,as) = $> in (Arm $1 $2 $3 e ($1 # $2 # e) : as) }
-
-pats :: { NonEmpty (Pat Span) }
-  : '|' sep_by1(pat,'|')   { toNonEmpty $2 }
-  |     sep_by1(pat,'|')   { toNonEmpty $1 }
+  | many(outer_attribute) top_pat arm_guard '=>' expr_arms { let (e,as) = $> in (Arm $1 $2 $3 e ($1 # $2 # e) : as) }
 
 arm_guard :: { Maybe (Expr Span) }
   : {- empty -}  { Nothing }
@@ -1224,8 +1232,8 @@ union_default_expr :: { Expr Span }
 
 stmt :: { Stmt Span }
   : ntStmt                                                 { $1 }
-  | many(outer_attribute) let pat ':' ty initializer ';'   { Local $3 (Just $5) $6 $1 ($1 # $2 # $>) }
-  | many(outer_attribute) let pat        initializer ';'   { Local $3 Nothing $4 $1 ($1 # $2 # $>) }
+  | many(outer_attribute) let top_pat ':' ty initializer ';' { Local $3 (Just $5) $6 $1 ($1 # $2 # $>) }
+  | many(outer_attribute) let top_pat        initializer ';' { Local $3 Nothing $4 $1 ($1 # $2 # $>) }
   | many(outer_attribute) nonblock_expr ';'                { toStmt ($1 `addAttrs` $2) True  False ($1 # $2 # $3) }
   | many(outer_attribute) block_like_expr ';'              { toStmt ($1 `addAttrs` $2) True  True  ($1 # $2 # $3) }
   | many(outer_attribute) blockpostfix_expr ';'            { toStmt ($1 `addAttrs` $2) True  True  ($1 # $2 # $3) }

src/Language/Rust/Pretty/Internal.hs

@@ -375,9 +375,9 @@ printExprOuterAttrStyle expr isInline = glue (printEitherAttrs (expressionAttrs
                                    in annotate x (hsep [ f e, "as", printType ty ])
     TypeAscription _ e ty x     -> annotate x (printExpr e <> ":" <+> printType ty)
     If _ test blk els x         -> annotate x (hsep [ "if", printExpr test, printBlock blk, printElse els ])
-    IfLet _ pats e blk els x    -> annotate x (hsep [ "if let", printPats pats, "=", printExpr e, printBlock blk, printElse els ])
+    IfLet _ pats e blk els x    -> annotate x (hsep [ "if let", printPat pats, "=", printExpr e, printBlock blk, printElse els ])
     While as test blk lbl x     -> annotate x (hsep [ printLbl lbl, "while", printExpr test, printBlockWithAttrs True blk as ])
-    WhileLet as ps e blk lbl x  -> annotate x (hsep [ printLbl lbl, "while let", printPats ps, "=", printExpr e, printBlockWithAttrs True blk as ])
+    WhileLet as ps e blk lbl x  -> annotate x (hsep [ printLbl lbl, "while let", printPat ps, "=", printExpr e, printBlockWithAttrs True blk as ])
     ForLoop as pat e blk lbl x  -> annotate x (hsep [ printLbl lbl, "for", printPat pat, "in", printExpr e, printBlockWithAttrs True blk as ])
     Loop as blk lbl x           -> annotate x (hsep [ printLbl lbl, "loop", printBlockWithAttrs True blk as ])
     Match as e arms x           -> annotate x (hsep [ "match", printExpr e, block Brace False "," (printInnerAttrs as) (printArm `map` arms) ])
@@ -515,15 +515,12 @@ printFnBlockArgs (FnDecl args ret _ x) = annotate x ("|" <> args' <> "|" <+> ret
 
 -- | Print the arm of a match expression (@print_arm@)
 printArm :: Arm a -> Doc a
-printArm (Arm as pats guard body x) = annotate x $ printOuterAttrs as
-  </> printPats pats 
+printArm (Arm as pat guard body x) = annotate x $ printOuterAttrs as
+  </> printPat pat
   <+> perhaps (\e -> "if" <+> printExpr e) guard
   <+> "=>"
   <+> printExpr body
 
-printPats :: Foldable f => f (Pat a) -> Doc a
-printPats pats = group (foldr1 (\a b -> a <+> "|" <#> b) (printPat `map` toList pats))
-
 -- | Print a block
 printBlock :: Block a -> Doc a
 printBlock blk = printBlockWithAttrs True blk []
@@ -536,7 +533,7 @@ printBlockWithAttrs b (Block stmts rules x) as = annotate x (printUnsafety rules
          | otherwise = body ++ [ lastStmt ]
 
   body = printStmt `map` Prelude.init stmts
-  
+
   lastStmt = case last stmts of
                NoSemi expr _ -> printExprOuterAttrStyle expr False
                stmt -> printStmt stmt
@@ -545,11 +542,11 @@ printBlockWithAttrs b (Block stmts rules x) as = annotate x (printUnsafety rules
 printElse :: Maybe (Expr a) -> Doc a
 printElse Nothing = mempty
 printElse (Just (If _ e t s x))      = annotate x (hsep [ "else if", printExpr e, printBlock t, printElse s ])
-printElse (Just (IfLet _ p e t s x)) = annotate x (hsep [ "else if let", printPats p, "=", printExpr e, printBlock t, printElse s ])
+printElse (Just (IfLet _ p e t s x)) = annotate x (hsep [ "else if let", printPat p, "=", printExpr e, printBlock t, printElse s ])
 printElse (Just (BlockExpr _ blk x)) = annotate x (hsep [ "else", printBlock blk ])
 printElse _ = error "printElse saw `if` with a weird alternative"
 
--- | Print a binary operator 
+-- | Print a binary operator
 printBinOp :: BinOp -> Doc a
 printBinOp AddOp = "+"
 printBinOp SubOp = "-"
@@ -878,6 +875,7 @@ printPat (PathP (Just qself) path x)    = annotate x (printQPath path qself True
 printPat (TupleP [RestP y] x)           = annotate x ("(" <> annotate y ".." <> ")")
 printPat (TupleP [elt] x)               = annotate x ("(" <> printPat elt <> ",)")
 printPat (TupleP elts x)                = annotate x ("(" <> commas elts printPat <> ")")
+printPat (OrP ps x)                     = annotate x (group (foldr1 (\a b -> a <+> "|" <#> b) (printPat `map` toList ps)))
 printPat (BoxP inner x)                 = annotate x ("box" <+> printPat inner)
 printPat (RefP inner mutbl x)           = annotate x ("&" <> printMutability mutbl <+> printPat inner)
 printPat (LitP expr x)                  = annotate x (printExpr expr)

src/Language/Rust/Pretty/Resolve.hs

@@ -575,6 +575,7 @@ instance (Typeable a, Monoid a) => Resolve (LifetimeDef a) where resolveM = reso
 --------------
 -- TODO: consider disallowind `..` not in the allowed contexts
 -- TODO: use parenP
+-- TODO: handling of Or patterns. They are not allowed everywhere!
 
 -- | A pattern can be invalid of
 --
@@ -601,6 +602,10 @@ resolvePat p@(PathP q@(Just (QSelf _ i)) p'@(Path g s x) x')
 resolvePat p@(TupleP ps x) = scope p $ do
   ps' <- traverse resolvePat ps
   pure (TupleP ps' x)
+-- OrP
+resolvePat p@(OrP ps x) = scope p $ do
+  ps' <- traverse resolvePat ps
+  pure (OrP ps' x)
 
 -- Everything else...
 resolvePat p@(LitP e x) = scope p (LitP <$> resolveExpr LitExpr e <*> pure x)
@@ -990,7 +995,7 @@ resolveExprP p c i@(If as e b es x) = scope i $ do
   pure (If as' e' b' es' x)
 resolveExprP p c i@(IfLet as p' e b es x) = scope i $ do
   as' <- traverse (resolveAttr OuterAttr) as
-  p'' <- traverse resolvePat p'
+  p'' <- resolvePat p'
   e' <- resolveExprP 0 NoStructExpr e
   b' <- resolveBlock b
   es' <- case es of
@@ -1008,7 +1013,7 @@ resolveExprP _ _ w@(While as e b l x) = scope w $ do
   pure (While as' e' b' l' x)
 resolveExprP _ _ w@(WhileLet as p' e b l x) = scope w $ do
   as' <- traverse (resolveAttr EitherAttr) as
-  p'' <- traverse resolvePat p'
+  p'' <- resolvePat p'
   e' <- resolveExprP 0 NoStructExpr e
   b' <- resolveBlock b
   l' <- traverse resolveLbl l
@@ -1069,12 +1074,12 @@ instance (Typeable a, Monoid a) => Resolve (Field a) where resolveM = resolveFie
 
 -- | Arms are invalid only if the underlying consitutents are
 resolveArm :: (Typeable a, Monoid a) => Arm a -> ResolveM (Arm a)
-resolveArm a@(Arm as ps g b x) = scope a $ do
+resolveArm a@(Arm as p g b x) = scope a $ do
   as' <- traverse (resolveAttr OuterAttr) as
-  ps' <- traverse resolvePat ps
+  p' <- resolvePat p
   g' <- traverse (resolveExpr AnyExpr) g
   b' <- resolveExpr SemiExpr b
-  pure (Arm as' ps' g' b' x)
+  pure (Arm as' p' g' b' x)
 
 instance (Typeable a, Monoid a) => Resolve (Arm a) where resolveM = resolveArm
 

src/Language/Rust/Syntax/AST.hs

@@ -169,8 +169,8 @@ data Abi
 -- }
 -- @
 data Arg a
-  = Arg (Maybe (Pat a)) (Ty a) a                   -- ^ Regular argument 
-  | SelfValue Mutability a                         -- ^ Self argument, by value 
+  = Arg (Maybe (Pat a)) (Ty a) a                   -- ^ Regular argument
+  | SelfValue Mutability a                         -- ^ Self argument, by value
   | SelfRegion (Maybe (Lifetime a)) Mutability a   -- ^ Self argument, by reference
   | SelfExplicit (Ty a) Mutability a               -- ^ Explicit self argument
   deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)
@@ -193,7 +193,7 @@ instance Located a => Located (Arg a) where
 --   _ => println!("{} % 2 = 0", n)
 -- }
 -- @
-data Arm a = Arm [Attribute a] (NonEmpty (Pat a)) (Maybe (Expr a)) (Expr a) a
+data Arm a = Arm [Attribute a] (Pat a) (Maybe (Expr a)) (Expr a) a
   deriving (Eq, Ord, Show, Functor, Typeable, Data, Generic, Generic1, NFData)
 
 instance Located a => Located (Arm a) where spanOf (Arm _ _ _ _ s) = spanOf s
@@ -316,11 +316,11 @@ data Expr a
   -- type of the @if@ is inferred to be @()@. (example: @if 1 == 2 { (1,1) } else { (2,2) }@
   | If [Attribute a] (Expr a) (Block a) (Maybe (Expr a)) a
   -- | if-let expression with an optional else block (example: @if let Some(x) = None { () }@)
-  | IfLet [Attribute a] (NonEmpty (Pat a)) (Expr a) (Block a) (Maybe (Expr a)) a
+  | IfLet [Attribute a] (Pat a) (Expr a) (Block a) (Maybe (Expr a)) a
   -- | while loop, with an optional label (example: @'lbl: while 1 == 1 { break 'lbl }@)
   | While [Attribute a] (Expr a) (Block a) (Maybe (Label a)) a
   -- | while-let loop, with an optional label (example: @while let Some(x) = None { x }@)
-  | WhileLet [Attribute a] (NonEmpty (Pat a)) (Expr a) (Block a) (Maybe (Label a)) a
+  | WhileLet [Attribute a] (Pat a) (Expr a) (Block a) (Maybe (Label a)) a
   -- | for loop, with an optional label (example: @for i in 1..10 { println!("{}",i) }@)
   | ForLoop [Attribute a] (Pat a) (Expr a) (Block a) (Maybe (Label a)) a
   -- | conditionless loop (can be exited with 'Break', 'Continue', or 'Ret')
@@ -783,6 +783,8 @@ data Pat a
   | PathP (Maybe (QSelf a)) (Path a) a
   -- | tuple pattern (example: @(a, b)@)
   | TupleP [Pat a] a
+  -- | or pattern, must have more than one variant (example: @Some(0) | None@)
+  | OrP (NonEmpty (Pat a)) a
   -- | box pattern (example: @box _@)
   | BoxP (Pat a) a
   -- | reference pattern (example: @&mut (a, b)@)
@@ -809,6 +811,7 @@ instance Located a => Located (Pat a) where
   spanOf (TupleStructP _ _ s) = spanOf s
   spanOf (PathP _ _ s) = spanOf s
   spanOf (TupleP _ s) = spanOf s
+  spanOf (OrP _ s) = spanOf s
   spanOf (BoxP _ s) = spanOf s
   spanOf (RefP _ _ s) = spanOf s
   spanOf (LitP _ s) = spanOf s