summaryrefslogtreecommitdiff
path: root/compiler/hsSyn/HsPat.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/hsSyn/HsPat.hs')
-rw-r--r--compiler/hsSyn/HsPat.hs283
1 files changed, 177 insertions, 106 deletions
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index cfd923c0aa..8ffde32b5a 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -50,6 +50,7 @@ import HsExtension
import HsTypes
import TcEvidence
import BasicTypes
+import PlaceHolder
-- others:
import PprCore ( {- instance OutputableBndr TyVar -} )
import TysWiredIn
@@ -79,42 +80,49 @@ type LPat p = Located (Pat p)
-- For details on above see note [Api annotations] in ApiAnnotation
data Pat p
= ------------ Simple patterns ---------------
- WildPat (PostTc p Type) -- ^ Wildcard Pattern
+ WildPat (XWildPat p) -- ^ Wildcard Pattern
-- The sole reason for a type on a WildPat is to
-- support hsPatType :: Pat Id -> Type
-- AZ:TODO above comment needs to be updated
- | VarPat (Located (IdP p)) -- ^ Variable Pattern
+ | VarPat (XVarPat p)
+ (Located (IdP p)) -- ^ Variable Pattern
-- See Note [Located RdrNames] in HsExpr
- | LazyPat (LPat p) -- ^ Lazy Pattern
+ | LazyPat (XLazyPat p)
+ (LPat p) -- ^ Lazy Pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
-- For details on above see note [Api annotations] in ApiAnnotation
- | AsPat (Located (IdP p)) (LPat p) -- ^ As pattern
+ | AsPat (XAsPat p)
+ (Located (IdP p)) (LPat p) -- ^ As pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
-- For details on above see note [Api annotations] in ApiAnnotation
- | ParPat (LPat p) -- ^ Parenthesised pattern
+ | ParPat (XParPat p)
+ (LPat p) -- ^ Parenthesised pattern
-- See Note [Parens in HsSyn] in HsExpr
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | BangPat (LPat p) -- ^ Bang pattern
+ | BangPat (XBangPat p)
+ (LPat p) -- ^ Bang pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
-- For details on above see note [Api annotations] in ApiAnnotation
------------ Lists, tuples, arrays ---------------
- | ListPat [LPat p]
+ | ListPat (XListPat p)
+ [LPat p]
(PostTc p Type) -- The type of the elements
(Maybe (PostTc p Type, SyntaxExpr p)) -- For rebindable syntax
-- For OverloadedLists a Just (ty,fn) gives
-- overall type of the pattern, and the toList
- -- function to convert the scrutinee to a list value
+-- function to convert the scrutinee to a list value
+
-- ^ Syntactic List
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
@@ -122,12 +130,13 @@ data Pat p
-- For details on above see note [Api annotations] in ApiAnnotation
- | TuplePat [LPat p] -- Tuple sub-patterns
+ | TuplePat (XTuplePat p)
+ -- after typechecking, holds the types of the tuple components
+ [LPat p] -- Tuple sub-patterns
Boxity -- UnitPat is TuplePat []
- [PostTc p Type] -- [] before typechecker, filled in afterwards
- -- with the types of the tuple components
- -- You might think that the PostTc p Type was redundant, because we can
- -- get the pattern type by getting the types of the sub-patterns.
+ -- You might think that the post typechecking Type was redundant,
+ -- because we can get the pattern type by getting the types of the
+ -- sub-patterns.
-- But it's essential
-- data T a where
-- T1 :: Int -> T Int
@@ -147,12 +156,12 @@ data Pat p
-- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
-- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@
- | SumPat (LPat p) -- Sum sub-pattern
- ConTag -- Alternative (one-based)
- Arity -- Arity (INVARIANT: ≥ 2)
- (PostTc p [Type]) -- PlaceHolder before typechecker, filled in
+ | SumPat (XSumPat p) -- PlaceHolder before typechecker, filled in
-- afterwards with the types of the
-- alternative
+ (LPat p) -- Sum sub-pattern
+ ConTag -- Alternative (one-based)
+ Arity -- Arity (INVARIANT: ≥ 2)
-- ^ Anonymous sum pattern
--
-- - 'ApiAnnotation.AnnKeywordId' :
@@ -160,8 +169,8 @@ data Pat p
-- 'ApiAnnotation.AnnClose' @'#)'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | PArrPat [LPat p] -- Syntactic parallel array
- (PostTc p Type) -- The type of the elements
+ | PArrPat (XPArrPat p) -- After typechecking, the type of the elements
+ [LPat p] -- Syntactic parallel array
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
-- 'ApiAnnotation.AnnClose' @':]'@
@@ -196,11 +205,11 @@ data Pat p
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
-- For details on above see note [Api annotations] in ApiAnnotation
- | ViewPat (LHsExpr p)
+ | ViewPat (XViewPat p) -- The overall type of the pattern
+ -- (= the argument type of the view function)
+ -- for hsPatType.
+ (LHsExpr p)
(LPat p)
- (PostTc p Type) -- The overall type of the pattern
- -- (= the argument type of the view function)
- -- for hsPatType.
-- ^ View Pattern
------------ Pattern splices ---------------
@@ -208,31 +217,34 @@ data Pat p
-- 'ApiAnnotation.AnnClose' @')'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | SplicePat (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
+ | SplicePat (XSplicePat p)
+ (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes)
------------ Literal and n+k patterns ---------------
- | LitPat (HsLit p) -- ^ Literal Pattern
+ | LitPat (XLitPat p)
+ (HsLit p) -- ^ Literal Pattern
-- Used for *non-overloaded* literal patterns:
-- Int#, Char#, Int, Char, String, etc.
| NPat -- Natural Pattern
-- Used for all overloaded literals,
-- including overloaded strings with -XOverloadedStrings
+ (XNPat p) -- Overall type of pattern. Might be
+ -- different than the literal's type
+ -- if (==) or negate changes the type
(Located (HsOverLit p)) -- ALWAYS positive
(Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
-- negative patterns, Nothing
-- otherwise
(SyntaxExpr p) -- Equality checker, of type t->t->Bool
- (PostTc p Type) -- Overall type of pattern. Might be
- -- different than the literal's type
- -- if (==) or negate changes the type
-- ^ Natural Pattern
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
-- For details on above see note [Api annotations] in ApiAnnotation
- | NPlusKPat (Located (IdP p)) -- n+k pattern
+ | NPlusKPat (XNPlusKPat p) -- Type of overall pattern
+ (Located (IdP p)) -- n+k pattern
(Located (HsOverLit p)) -- It'll always be an HsIntegral
(HsOverLit p) -- See Note [NPlusK patterns] in TcPat
-- NB: This could be (PostTc ...), but that induced a
@@ -240,24 +252,22 @@ data Pat p
(SyntaxExpr p) -- (>=) function, of type t1->t2->Bool
(SyntaxExpr p) -- Name of '-' (see RnEnv.lookupSyntaxName)
- (PostTc p Type) -- Type of overall pattern
-- ^ n+k pattern
------------ Pattern type signatures ---------------
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
-- For details on above see note [Api annotations] in ApiAnnotation
- | SigPatIn (LPat p) -- Pattern with a type signature
- (LHsSigWcType p) -- Signature can bind both
- -- kind and type vars
- -- ^ Pattern with a type signature
-
- | SigPatOut (LPat p)
- Type
+ | SigPat (XSigPat p) -- Before typechecker
+ -- Signature can bind both
+ -- kind and type vars
+ -- After typechecker: Type
+ (LPat p) -- Pattern with a type signature
-- ^ Pattern with a type signature
------------ Pattern coercions (translation only) ---------------
- | CoPat HsWrapper -- Coercion Pattern
+ | CoPat (XCoPat p)
+ HsWrapper -- Coercion Pattern
-- If co :: t1 ~ t2, p :: t2,
-- then (CoPat co p) :: t1
(Pat p) -- Why not LPat? Ans: existing locn will do
@@ -265,7 +275,65 @@ data Pat p
-- During desugaring a (CoPat co pat) turns into a cast with 'co' on
-- the scrutinee, followed by a match on 'pat'
-- ^ Coercion Pattern
-deriving instance (DataId p) => Data (Pat p)
+
+ -- | Trees that Grow extension point for new constructors
+ | XPat
+ (XXPat p)
+deriving instance (DataIdLR p p) => Data (Pat p)
+
+-- ---------------------------------------------------------------------
+
+type instance XWildPat GhcPs = PlaceHolder
+type instance XWildPat GhcRn = PlaceHolder
+type instance XWildPat GhcTc = Type
+
+type instance XVarPat (GhcPass _) = PlaceHolder
+type instance XLazyPat (GhcPass _) = PlaceHolder
+type instance XAsPat (GhcPass _) = PlaceHolder
+type instance XParPat (GhcPass _) = PlaceHolder
+type instance XBangPat (GhcPass _) = PlaceHolder
+
+-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
+-- compiler, as it triggers https://ghc.haskell.org/trac/ghc/ticket/14396 for
+-- `SyntaxExpr`
+type instance XListPat (GhcPass _) = PlaceHolder
+
+type instance XTuplePat GhcPs = PlaceHolder
+type instance XTuplePat GhcRn = PlaceHolder
+type instance XTuplePat GhcTc = [Type]
+
+type instance XSumPat GhcPs = PlaceHolder
+type instance XSumPat GhcRn = PlaceHolder
+type instance XSumPat GhcTc = [Type]
+
+type instance XPArrPat GhcPs = PlaceHolder
+type instance XPArrPat GhcRn = PlaceHolder
+type instance XPArrPat GhcTc = Type
+
+type instance XViewPat GhcPs = PlaceHolder
+type instance XViewPat GhcRn = PlaceHolder
+type instance XViewPat GhcTc = Type
+
+type instance XSplicePat (GhcPass _) = PlaceHolder
+type instance XLitPat (GhcPass _) = PlaceHolder
+
+type instance XNPat GhcPs = PlaceHolder
+type instance XNPat GhcRn = PlaceHolder
+type instance XNPat GhcTc = Type
+
+type instance XNPlusKPat GhcPs = PlaceHolder
+type instance XNPlusKPat GhcRn = PlaceHolder
+type instance XNPlusKPat GhcTc = Type
+
+type instance XSigPat GhcPs = (LHsSigWcType GhcPs)
+type instance XSigPat GhcRn = (LHsSigWcType GhcRn)
+type instance XSigPat GhcTc = Type
+
+type instance XCoPat (GhcPass _) = PlaceHolder
+type instance XXPat (GhcPass _) = PlaceHolder
+
+-- ---------------------------------------------------------------------
+
-- | Haskell Constructor Pattern Details
type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
@@ -383,24 +451,24 @@ data HsRecField' id arg = HsRecField {
--
-- See also Note [Disambiguating record fields] in TcExpr.
-hsRecFields :: HsRecFields p arg -> [PostRn p (IdP p)]
+hsRecFields :: HsRecFields p arg -> [XFieldOcc p]
hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
-- Probably won't typecheck at once, things have changed :/
hsRecFieldsArgs :: HsRecFields p arg -> [arg]
hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)
-hsRecFieldSel :: HsRecField pass arg -> Located (PostRn pass (IdP pass))
-hsRecFieldSel = fmap selectorFieldOcc . hsRecFieldLbl
+hsRecFieldSel :: HsRecField pass arg -> Located (XFieldOcc pass)
+hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl
hsRecFieldId :: HsRecField GhcTc arg -> Located Id
hsRecFieldId = hsRecFieldSel
-hsRecUpdFieldRdr :: HsRecUpdField p -> Located RdrName
+hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
-hsRecUpdFieldId = fmap selectorFieldOcc . hsRecUpdFieldOcc
+hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
@@ -444,28 +512,30 @@ pprParendPat p = sdocWithDynFlags $ \ dflags ->
-- is the pattern inside that matters. Sigh.
pprPat :: (OutputableBndrId (GhcPass p)) => Pat (GhcPass p) -> SDoc
-pprPat (VarPat (L _ var)) = pprPatBndr var
-pprPat (WildPat _) = char '_'
-pprPat (LazyPat pat) = char '~' <> pprParendLPat pat
-pprPat (BangPat pat) = char '!' <> pprParendLPat pat
-pprPat (AsPat name pat) = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
-pprPat (ViewPat expr pat _) = hcat [pprLExpr expr, text " -> ", ppr pat]
-pprPat (ParPat pat) = parens (ppr pat)
-pprPat (LitPat s) = ppr s
-pprPat (NPat l Nothing _ _) = ppr l
-pprPat (NPat l (Just _) _ _) = char '-' <> ppr l
-pprPat (NPlusKPat n k _ _ _ _)= hcat [ppr n, char '+', ppr k]
-pprPat (SplicePat splice) = pprSplice splice
-pprPat (CoPat co pat _) = pprHsWrapper co (\parens -> if parens
- then pprParendPat pat
- else pprPat pat)
-pprPat (SigPatIn pat ty) = ppr pat <+> dcolon <+> ppr ty
-pprPat (SigPatOut pat ty) = ppr pat <+> dcolon <+> ppr ty
-pprPat (ListPat pats _ _) = brackets (interpp'SP pats)
-pprPat (PArrPat pats _) = paBrackets (interpp'SP pats)
-pprPat (TuplePat pats bx _) = tupleParens (boxityTupleSort bx) (pprWithCommas ppr pats)
-pprPat (SumPat pat alt arity _) = sumParens (pprAlternative ppr pat alt arity)
-pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
+pprPat (VarPat _ (L _ var)) = pprPatBndr var
+pprPat (WildPat _) = char '_'
+pprPat (LazyPat _ pat) = char '~' <> pprParendLPat pat
+pprPat (BangPat _ pat) = char '!' <> pprParendLPat pat
+pprPat (AsPat _ name pat) = hcat [pprPrefixOcc (unLoc name), char '@',
+ pprParendLPat pat]
+pprPat (ViewPat _ expr pat) = hcat [pprLExpr expr, text " -> ", ppr pat]
+pprPat (ParPat _ pat) = parens (ppr pat)
+pprPat (LitPat _ s) = ppr s
+pprPat (NPat _ l Nothing _) = ppr l
+pprPat (NPat _ l (Just _) _) = char '-' <> ppr l
+pprPat (NPlusKPat _ n k _ _ _) = hcat [ppr n, char '+', ppr k]
+pprPat (SplicePat _ splice) = pprSplice splice
+pprPat (CoPat _ co pat _) = pprHsWrapper co (\parens
+ -> if parens
+ then pprParendPat pat
+ else pprPat pat)
+pprPat (SigPat ty pat) = ppr pat <+> dcolon <+> ppr ty
+pprPat (ListPat _ pats _ _) = brackets (interpp'SP pats)
+pprPat (PArrPat _ pats) = paBrackets (interpp'SP pats)
+pprPat (TuplePat _ pats bx) = tupleParens (boxityTupleSort bx)
+ (pprWithCommas ppr pats)
+pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)
+pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
pat_binds = binds, pat_args = details })
= sdocWithDynFlags $ \dflags ->
@@ -478,6 +548,7 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
, ppr binds])
<+> pprConArgs details
else pprUserCon (unLoc con) details
+pprPat (XPat x) = ppr x
pprUserCon :: (OutputableBndr con, OutputableBndrId (GhcPass p))
@@ -527,7 +598,7 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
mkCharLitPat src c = mkPrefixConPat charDataCon
- [noLoc $ LitPat (HsCharPrim src c)] []
+ [noLoc $ LitPat PlaceHolder (HsCharPrim src c)] []
{-
************************************************************************
@@ -562,7 +633,7 @@ The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
-}
isBangedLPat :: LPat p -> Bool
-isBangedLPat (L _ (ParPat p)) = isBangedLPat p
+isBangedLPat (L _ (ParPat _ p)) = isBangedLPat p
isBangedLPat (L _ (BangPat {})) = True
isBangedLPat _ = False
@@ -580,8 +651,8 @@ looksLazyPatBind _
= False
looksLazyLPat :: LPat p -> Bool
-looksLazyLPat (L _ (ParPat p)) = looksLazyLPat p
-looksLazyLPat (L _ (AsPat _ p)) = looksLazyLPat p
+looksLazyLPat (L _ (ParPat _ p)) = looksLazyLPat p
+looksLazyLPat (L _ (AsPat _ _ p)) = looksLazyLPat p
looksLazyLPat (L _ (BangPat {})) = False
looksLazyLPat (L _ (VarPat {})) = False
looksLazyLPat (L _ (WildPat {})) = False
@@ -608,15 +679,14 @@ isIrrefutableHsPat pat
go1 (WildPat {}) = True
go1 (VarPat {}) = True
go1 (LazyPat {}) = True
- go1 (BangPat pat) = go pat
- go1 (CoPat _ pat _) = go1 pat
- go1 (ParPat pat) = go pat
- go1 (AsPat _ pat) = go pat
- go1 (ViewPat _ pat _) = go pat
- go1 (SigPatIn pat _) = go pat
- go1 (SigPatOut pat _) = go pat
- go1 (TuplePat pats _ _) = all go pats
- go1 (SumPat _ _ _ _) = False
+ go1 (BangPat _ pat) = go pat
+ go1 (CoPat _ _ pat _) = go1 pat
+ go1 (ParPat _ pat) = go pat
+ go1 (AsPat _ _ pat) = go pat
+ go1 (ViewPat _ _ pat) = go pat
+ go1 (SigPat _ pat) = go pat
+ go1 (TuplePat _ pats _) = all go pats
+ go1 (SumPat {}) = False
-- See Note [Unboxed sum patterns aren't irrefutable]
go1 (ListPat {}) = False
go1 (PArrPat {}) = False -- ?
@@ -638,6 +708,8 @@ isIrrefutableHsPat pat
-- since we cannot know until the splice is evaluated.
go1 (SplicePat {}) = False
+ go1 (XPat {}) = False
+
{- Note [Unboxed sum patterns aren't irrefutable]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
@@ -667,10 +739,9 @@ hsPatNeedsParens (NPlusKPat {}) = True
hsPatNeedsParens (SplicePat {}) = False
hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds
hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p)
-hsPatNeedsParens (SigPatIn {}) = True
-hsPatNeedsParens (SigPatOut {}) = True
+hsPatNeedsParens (SigPat {}) = True
hsPatNeedsParens (ViewPat {}) = True
-hsPatNeedsParens (CoPat _ p _) = hsPatNeedsParens p
+hsPatNeedsParens (CoPat _ _ p _) = hsPatNeedsParens p
hsPatNeedsParens (WildPat {}) = False
hsPatNeedsParens (VarPat {}) = False
hsPatNeedsParens (LazyPat {}) = False
@@ -683,6 +754,7 @@ hsPatNeedsParens (ListPat {}) = False
hsPatNeedsParens (PArrPat {}) = False
hsPatNeedsParens (LitPat {}) = False
hsPatNeedsParens (NPat {}) = False
+hsPatNeedsParens (XPat {}) = True -- conservative default
-- | Returns 'True' if a constructor pattern must be parenthesized in order
-- to parse.
@@ -704,10 +776,9 @@ isCompoundPat (NPlusKPat {}) = True
isCompoundPat (SplicePat {}) = False
isCompoundPat (ConPatIn _ ds) = isCompoundConPat ds
isCompoundPat p@(ConPatOut {}) = isCompoundConPat (pat_args p)
-isCompoundPat (SigPatIn {}) = True
-isCompoundPat (SigPatOut {}) = True
+isCompoundPat (SigPat {}) = True
isCompoundPat (ViewPat {}) = True
-isCompoundPat (CoPat _ p _) = isCompoundPat p
+isCompoundPat (CoPat _ _ p _) = isCompoundPat p
isCompoundPat (WildPat {}) = False
isCompoundPat (VarPat {}) = False
isCompoundPat (LazyPat {}) = False
@@ -718,8 +789,9 @@ isCompoundPat (TuplePat {}) = False
isCompoundPat (SumPat {}) = False
isCompoundPat (ListPat {}) = False
isCompoundPat (PArrPat {}) = False
-isCompoundPat (LitPat p) = isCompoundHsLit p
-isCompoundPat (NPat (L _ p) _ _ _) = isCompoundHsOverLit p
+isCompoundPat (LitPat _ p) = isCompoundHsLit p
+isCompoundPat (NPat _ (L _ p) _ _) = isCompoundHsOverLit p
+isCompoundPat (XPat {}) = False -- Assumption
-- | Returns 'True' for compound constructor patterns that need parentheses
-- when used in an argument position.
@@ -736,9 +808,9 @@ isCompoundConPat (RecCon {}) = False
-- | @'parenthesizeCompoundPat' p@ checks if @'isCompoundPat' p@ is true, and
-- if so, surrounds @p@ with a 'ParPat'. Otherwise, it simply returns @p@.
-parenthesizeCompoundPat :: LPat p -> LPat p
+parenthesizeCompoundPat :: LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizeCompoundPat lp@(L loc p)
- | isCompoundPat p = L loc (ParPat lp)
+ | isCompoundPat p = L loc (ParPat PlaceHolder lp)
| otherwise = lp
{-
@@ -746,30 +818,29 @@ parenthesizeCompoundPat lp@(L loc p)
-}
-- May need to add more cases
-collectEvVarsPats :: [Pat p] -> Bag EvVar
+collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
collectEvVarsPats = unionManyBags . map collectEvVarsPat
-collectEvVarsLPat :: LPat p -> Bag EvVar
+collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
collectEvVarsLPat (L _ pat) = collectEvVarsPat pat
-collectEvVarsPat :: Pat p -> Bag EvVar
+collectEvVarsPat :: Pat GhcTc -> Bag EvVar
collectEvVarsPat pat =
case pat of
- LazyPat p -> collectEvVarsLPat p
- AsPat _ p -> collectEvVarsLPat p
- ParPat p -> collectEvVarsLPat p
- BangPat p -> collectEvVarsLPat p
- ListPat ps _ _ -> unionManyBags $ map collectEvVarsLPat ps
- TuplePat ps _ _ -> unionManyBags $ map collectEvVarsLPat ps
- SumPat p _ _ _ -> collectEvVarsLPat p
- PArrPat ps _ -> unionManyBags $ map collectEvVarsLPat ps
+ LazyPat _ p -> collectEvVarsLPat p
+ AsPat _ _ p -> collectEvVarsLPat p
+ ParPat _ p -> collectEvVarsLPat p
+ BangPat _ p -> collectEvVarsLPat p
+ ListPat _ ps _ _ -> unionManyBags $ map collectEvVarsLPat ps
+ TuplePat _ ps _ -> unionManyBags $ map collectEvVarsLPat ps
+ SumPat _ p _ _ -> collectEvVarsLPat p
+ PArrPat _ ps -> unionManyBags $ map collectEvVarsLPat ps
ConPatOut {pat_dicts = dicts, pat_args = args}
- -> unionBags (listToBag dicts)
+ -> unionBags (listToBag dicts)
$ unionManyBags
$ map collectEvVarsLPat
$ hsConPatArgs args
- SigPatOut p _ -> collectEvVarsLPat p
- CoPat _ p _ -> collectEvVarsPat p
- ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn"
- SigPatIn _ _ -> panic "foldMapPatBag: SigPatIn"
- _other_pat -> emptyBag
+ SigPat _ p -> collectEvVarsLPat p
+ CoPat _ _ p _ -> collectEvVarsPat p
+ ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn"
+ _other_pat -> emptyBag