diff options
Diffstat (limited to 'compiler/hsSyn/HsPat.hs')
| -rw-r--r-- | compiler/hsSyn/HsPat.hs | 290 |
1 files changed, 106 insertions, 184 deletions
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 863f00c99b..e05d8bbf68 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -15,7 +15,6 @@ -- in module PlaceHolder {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleInstances #-} module HsPat ( Pat(..), InPat, OutPat, LPat, @@ -50,7 +49,6 @@ import HsExtension import HsTypes import TcEvidence import BasicTypes -import PlaceHolder -- others: import PprCore ( {- instance OutputableBndr TyVar -} ) import TysWiredIn @@ -80,49 +78,42 @@ type LPat p = Located (Pat p) -- For details on above see note [Api annotations] in ApiAnnotation data Pat p = ------------ Simple patterns --------------- - WildPat (XWildPat p) -- ^ Wildcard Pattern + WildPat (PostTc p Type) -- ^ 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 (XVarPat p) - (Located (IdP p)) -- ^ Variable Pattern + | VarPat (Located (IdP p)) -- ^ Variable Pattern -- See Note [Located RdrNames] in HsExpr - | LazyPat (XLazyPat p) - (LPat p) -- ^ Lazy Pattern + | LazyPat (LPat p) -- ^ Lazy Pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde' -- For details on above see note [Api annotations] in ApiAnnotation - | AsPat (XAsPat p) - (Located (IdP p)) (LPat p) -- ^ As pattern + | AsPat (Located (IdP p)) (LPat p) -- ^ As pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt' -- For details on above see note [Api annotations] in ApiAnnotation - | ParPat (XParPat p) - (LPat p) -- ^ Parenthesised pattern + | ParPat (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 (XBangPat p) - (LPat p) -- ^ Bang pattern + | BangPat (LPat p) -- ^ Bang pattern -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang' -- For details on above see note [Api annotations] in ApiAnnotation ------------ Lists, tuples, arrays --------------- - | ListPat (XListPat p) - [LPat p] + | ListPat [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' @'['@, @@ -130,13 +121,12 @@ data Pat p -- For details on above see note [Api annotations] in ApiAnnotation - | TuplePat (XTuplePat p) - -- after typechecking, holds the types of the tuple components - [LPat p] -- Tuple sub-patterns + | TuplePat [LPat p] -- Tuple sub-patterns Boxity -- UnitPat is TuplePat [] - -- 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. + [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. -- But it's essential -- data T a where -- T1 :: Int -> T Int @@ -156,12 +146,12 @@ data Pat p -- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@, -- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@ - | SumPat (XSumPat p) -- PlaceHolder before typechecker, filled in - -- afterwards with the types of the - -- alternative - (LPat p) -- Sum sub-pattern + | SumPat (LPat p) -- Sum sub-pattern ConTag -- Alternative (one-based) Arity -- Arity (INVARIANT: ≥ 2) + (PostTc p [Type]) -- PlaceHolder before typechecker, filled in + -- afterwards with the types of the + -- alternative -- ^ Anonymous sum pattern -- -- - 'ApiAnnotation.AnnKeywordId' : @@ -169,8 +159,8 @@ data Pat p -- 'ApiAnnotation.AnnClose' @'#)'@ -- For details on above see note [Api annotations] in ApiAnnotation - | PArrPat (XPArrPat p) -- After typechecking, the type of the elements - [LPat p] -- Syntactic parallel array + | PArrPat [LPat p] -- Syntactic parallel array + (PostTc p Type) -- The type of the elements -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@, -- 'ApiAnnotation.AnnClose' @':]'@ @@ -205,11 +195,11 @@ data Pat p -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow' -- For details on above see note [Api annotations] in ApiAnnotation - | ViewPat (XViewPat p) -- The overall type of the pattern - -- (= the argument type of the view function) - -- for hsPatType. - (LHsExpr p) + | ViewPat (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 --------------- @@ -217,34 +207,31 @@ data Pat p -- 'ApiAnnotation.AnnClose' @')'@ -- For details on above see note [Api annotations] in ApiAnnotation - | SplicePat (XSplicePat p) - (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes) + | SplicePat (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes) ------------ Literal and n+k patterns --------------- - | LitPat (XLitPat p) - (HsLit p) -- ^ Literal Pattern + | LitPat (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 (XNPlusKPat p) -- Type of overall pattern - (Located (IdP p)) -- n+k pattern + | NPlusKPat (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 @@ -252,22 +239,24 @@ 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 - | SigPat (XSigPat p) -- Before typechecker - -- Signature can bind both - -- kind and type vars - -- After typechecker: Type - (LPat p) -- Pattern with a type signature + | 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 -- ^ Pattern with a type signature ------------ Pattern coercions (translation only) --------------- - | CoPat (XCoPat p) - HsWrapper -- Coercion Pattern + | CoPat HsWrapper -- Coercion Pattern -- If co :: t1 ~ t2, p :: t2, -- then (CoPat co p) :: t1 (Pat p) -- Why not LPat? Ans: existing locn will do @@ -275,65 +264,7 @@ 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 - - -- | 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 - --- --------------------------------------------------------------------- - +deriving instance (DataId p) => Data (Pat p) -- | Haskell Constructor Pattern Details type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p)) @@ -451,24 +382,24 @@ data HsRecField' id arg = HsRecField { -- -- See also Note [Disambiguating record fields] in TcExpr. -hsRecFields :: HsRecFields p arg -> [XFieldOcc p] +hsRecFields :: HsRecFields p arg -> [PostRn p (IdP 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 (XFieldOcc pass) -hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl +hsRecFieldSel :: HsRecField pass arg -> Located (PostRn pass (IdP pass)) +hsRecFieldSel = fmap selectorFieldOcc . hsRecFieldLbl hsRecFieldId :: HsRecField GhcTc arg -> Located Id hsRecFieldId = hsRecFieldSel -hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName +hsRecUpdFieldRdr :: HsRecUpdField p -> Located RdrName hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id -hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc +hsRecUpdFieldId = fmap selectorFieldOcc . hsRecUpdFieldOcc hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl @@ -482,8 +413,8 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl ************************************************************************ -} -instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Outputable (Pat (GhcPass p)) where +instance (SourceTextX pass, OutputableBndrId pass) + => Outputable (Pat pass) where ppr = pprPat pprPatBndr :: OutputableBndr name => name -> SDoc @@ -495,12 +426,10 @@ pprPatBndr var -- Print with type info if -dppr-debug is on else pprPrefixOcc var -pprParendLPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => LPat (GhcPass p) -> SDoc +pprParendLPat :: (SourceTextX pass, OutputableBndrId pass) => LPat pass -> SDoc pprParendLPat (L _ p) = pprParendPat p -pprParendPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Pat (GhcPass p) -> SDoc +pprParendPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> SDoc pprParendPat p = sdocWithDynFlags $ \ dflags -> if need_parens dflags p then parens (pprPat p) @@ -514,31 +443,29 @@ pprParendPat p = sdocWithDynFlags $ \ dflags -> -- But otherwise the CoPat is discarded, so it -- is the pattern inside that matters. Sigh. -pprPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => Pat (GhcPass p) -> SDoc -pprPat (VarPat _ (L _ var)) = pprPatBndr var +pprPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> 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 +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 (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 (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts, pat_binds = binds, pat_args = details }) = sdocWithDynFlags $ \dflags -> @@ -551,16 +478,14 @@ 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 :: (SourceTextX (GhcPass p), OutputableBndr con, - OutputableBndrId (GhcPass p)) - => con -> HsConPatDetails (GhcPass p) -> SDoc + +pprUserCon :: (SourceTextX p, OutputableBndr con, OutputableBndrId p) + => con -> HsConPatDetails p -> SDoc pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2 pprUserCon c details = pprPrefixOcc c <+> pprConArgs details -pprConArgs :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p)) - => HsConPatDetails (GhcPass p) -> SDoc +pprConArgs :: (SourceTextX p, OutputableBndrId p) => HsConPatDetails p -> SDoc pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats) pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2] pprConArgs (RecCon rpats) = ppr rpats @@ -599,12 +524,9 @@ mkPrefixConPat dc pats tys mkNilPat :: Type -> OutPat p mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] -mkCharLitPat :: (SourceTextX (GhcPass p)) - => SourceText -> Char -> OutPat (GhcPass p) +mkCharLitPat :: (SourceTextX p) => SourceText -> Char -> OutPat p mkCharLitPat src c = mkPrefixConPat charDataCon - [noLoc $ LitPat noExt - (HsCharPrim (setSourceText src) c)] - [] + [noLoc $ LitPat (HsCharPrim (setSourceText src) c)] [] {- ************************************************************************ @@ -639,7 +561,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 @@ -657,8 +579,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 @@ -685,14 +607,15 @@ 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 (SigPat _ 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 (SigPatIn pat _) = go pat + go1 (SigPatOut 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 -- ? @@ -714,8 +637,6 @@ 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 @@ -743,9 +664,10 @@ hsPatNeedsParens (NPlusKPat {}) = True hsPatNeedsParens (SplicePat {}) = False hsPatNeedsParens (ConPatIn _ ds) = conPatNeedsParens ds hsPatNeedsParens p@(ConPatOut {}) = conPatNeedsParens (pat_args p) -hsPatNeedsParens (SigPat {}) = True +hsPatNeedsParens (SigPatIn {}) = True +hsPatNeedsParens (SigPatOut {}) = True hsPatNeedsParens (ViewPat {}) = True -hsPatNeedsParens (CoPat _ _ p _) = hsPatNeedsParens p +hsPatNeedsParens (CoPat _ p _) = hsPatNeedsParens p hsPatNeedsParens (WildPat {}) = False hsPatNeedsParens (VarPat {}) = False hsPatNeedsParens (LazyPat {}) = False @@ -758,7 +680,6 @@ hsPatNeedsParens (ListPat {}) = False hsPatNeedsParens (PArrPat {}) = False hsPatNeedsParens (LitPat {}) = False hsPatNeedsParens (NPat {}) = False -hsPatNeedsParens (XPat {}) = True -- conservative default conPatNeedsParens :: HsConDetails a b -> Bool conPatNeedsParens (PrefixCon {}) = False @@ -770,29 +691,30 @@ conPatNeedsParens (RecCon {}) = False -} -- May need to add more cases -collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar +collectEvVarsPats :: [Pat p] -> Bag EvVar collectEvVarsPats = unionManyBags . map collectEvVarsPat -collectEvVarsLPat :: LPat GhcTc -> Bag EvVar +collectEvVarsLPat :: LPat p -> Bag EvVar collectEvVarsLPat (L _ pat) = collectEvVarsPat pat -collectEvVarsPat :: Pat GhcTc -> Bag EvVar +collectEvVarsPat :: Pat p -> 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 - SigPat _ p -> collectEvVarsLPat p - CoPat _ _ p _ -> collectEvVarsPat p - ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn" - _other_pat -> emptyBag + SigPatOut p _ -> collectEvVarsLPat p + CoPat _ p _ -> collectEvVarsPat p + ConPatIn _ _ -> panic "foldMapPatBag: ConPatIn" + SigPatIn _ _ -> panic "foldMapPatBag: SigPatIn" + _other_pat -> emptyBag |