{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Hs.Pat (
Pat(..), LPat,
EpAnnSumPat(..),
ConPatTc (..),
CoPat (..),
ListPatTc(..),
ConLikeP,
HsConPatDetails, hsConPatArgs,
HsRecFields(..), HsRecField'(..), LHsRecField',
HsRecField, LHsRecField,
HsRecUpdField, LHsRecUpdField,
hsRecFields, hsRecFieldSel, hsRecFieldId, hsRecFieldsArgs,
hsRecUpdFieldId, hsRecUpdFieldOcc, hsRecUpdFieldRdr,
mkPrefixConPat, mkCharLitPat, mkNilPat,
isSimplePat,
looksLazyPatBind,
isBangedLPat,
patNeedsParens, parenthesizePat,
isIrrefutableHsPat,
collectEvVarsPat, collectEvVarsPats,
pprParendLPat, pprConArgs,
pprLPat
) where
import GHC.Prelude
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Expr (HsExpr, SyntaxExpr)
import {-# SOURCE #-} GHC.Hs.Expr (pprLExpr, pprSplice)
import GHC.Hs.Binds
import GHC.Hs.Lit
import Language.Haskell.Syntax.Extension
import GHC.Parser.Annotation
import GHC.Hs.Extension
import GHC.Hs.Type
import GHC.Tc.Types.Evidence
import GHC.Types.Basic
import GHC.Types.SourceText
import GHC.Core.Ppr ( )
import GHC.Builtin.Types
import GHC.Types.Var
import GHC.Types.Name.Reader ( RdrName )
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Core.Type
import GHC.Types.SrcLoc
import GHC.Data.Bag
import GHC.Data.Maybe
import GHC.Types.Name (Name)
import GHC.Driver.Session
import qualified GHC.LanguageExtensions as LangExt
import Data.Data
data ListPatTc
= ListPatTc
Type
(Maybe (Type, SyntaxExpr GhcTc))
type instance XWildPat GhcPs = NoExtField
type instance XWildPat GhcRn = NoExtField
type instance XWildPat GhcTc = Type
type instance XVarPat (GhcPass _) = NoExtField
type instance XLazyPat GhcPs = EpAnn [AddEpAnn]
type instance XLazyPat GhcRn = NoExtField
type instance XLazyPat GhcTc = NoExtField
type instance XAsPat GhcPs = EpAnn [AddEpAnn]
type instance XAsPat GhcRn = NoExtField
type instance XAsPat GhcTc = NoExtField
type instance XParPat (GhcPass _) = EpAnn AnnParen
type instance XBangPat GhcPs = EpAnn [AddEpAnn]
type instance XBangPat GhcRn = NoExtField
type instance XBangPat GhcTc = NoExtField
type instance XListPat GhcPs = EpAnn AnnList
type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
type instance XListPat GhcTc = ListPatTc
type instance XTuplePat GhcPs = EpAnn [AddEpAnn]
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
type instance XSumPat GhcPs = EpAnn EpAnnSumPat
type instance XSumPat GhcRn = NoExtField
type instance XSumPat GhcTc = [Type]
type instance XConPat GhcPs = EpAnn [AddEpAnn]
type instance XConPat GhcRn = NoExtField
type instance XConPat GhcTc = ConPatTc
type instance XViewPat GhcPs = EpAnn [AddEpAnn]
type instance XViewPat GhcRn = NoExtField
type instance XViewPat GhcTc = Type
type instance XSplicePat (GhcPass _) = NoExtField
type instance XLitPat (GhcPass _) = NoExtField
type instance XNPat GhcPs = EpAnn [AddEpAnn]
type instance XNPat GhcRn = EpAnn [AddEpAnn]
type instance XNPat GhcTc = Type
type instance XNPlusKPat GhcPs = EpAnn EpaLocation
type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type
type instance XSigPat GhcPs = EpAnn [AddEpAnn]
type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
type instance XXPat GhcPs = NoExtCon
type instance XXPat GhcRn = NoExtCon
type instance XXPat GhcTc = CoPat
type instance ConLikeP GhcPs = RdrName
type instance ConLikeP GhcRn = Name
type instance ConLikeP GhcTc = ConLike
type instance XHsRecField _ = EpAnn [AddEpAnn]
data EpAnnSumPat = EpAnnSumPat
{ EpAnnSumPat -> [AddEpAnn]
sumPatParens :: [AddEpAnn]
, EpAnnSumPat -> [EpaLocation]
sumPatVbarsBefore :: [EpaLocation]
, EpAnnSumPat -> [EpaLocation]
sumPatVbarsAfter :: [EpaLocation]
} deriving Typeable EpAnnSumPat
EpAnnSumPat -> DataType
EpAnnSumPat -> Constr
(forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EpAnnSumPat -> m EpAnnSumPat
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EpAnnSumPat -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EpAnnSumPat -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EpAnnSumPat -> r
gmapT :: (forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
$cgmapT :: (forall b. Data b => b -> b) -> EpAnnSumPat -> EpAnnSumPat
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EpAnnSumPat)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EpAnnSumPat)
dataTypeOf :: EpAnnSumPat -> DataType
$cdataTypeOf :: EpAnnSumPat -> DataType
toConstr :: EpAnnSumPat -> Constr
$ctoConstr :: EpAnnSumPat -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EpAnnSumPat
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EpAnnSumPat -> c EpAnnSumPat
Data
data ConPatTc
= ConPatTc
{
ConPatTc -> [Type]
cpt_arg_tys :: [Type]
,
ConPatTc -> [TyVar]
cpt_tvs :: [TyVar]
,
ConPatTc -> [TyVar]
cpt_dicts :: [EvVar]
,
ConPatTc -> TcEvBinds
cpt_binds :: TcEvBinds
,
ConPatTc -> HsWrapper
cpt_wrap :: HsWrapper
}
data CoPat
= CoPat
{
CoPat -> HsWrapper
co_cpt_wrap :: HsWrapper
,
CoPat -> Pat GhcTc
co_pat_inner :: Pat GhcTc
,
CoPat -> Type
co_pat_ty :: Type
}
hsRecFieldId :: HsRecField GhcTc arg -> Located Id
hsRecFieldId :: forall arg. HsRecField GhcTc arg -> Located TyVar
hsRecFieldId = forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel
hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr :: forall (p :: Pass). HsRecUpdField (GhcPass p) -> Located RdrName
hsRecUpdFieldRdr = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl
hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
hsRecUpdFieldId :: forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located TyVar
hsRecUpdFieldId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc
hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc :: forall arg.
HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
hsRecUpdFieldOcc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl
instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
ppr :: Pat (GhcPass p) -> SDoc
ppr = forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat
pprLPat :: (OutputableBndrId p) => LPat (GhcPass p) -> SDoc
pprLPat :: forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> SDoc
pprLPat (L SrcSpanAnnA
_ Pat (GhcPass p)
e) = forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
e
pprPatBndr :: OutputableBndr name => name -> SDoc
pprPatBndr :: forall name. OutputableBndr name => name -> SDoc
pprPatBndr name
var
= (Bool -> SDoc) -> SDoc
getPprDebug forall a b. (a -> b) -> a -> b
$ \case
Bool
True -> SDoc -> SDoc
parens (forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LambdaBind name
var)
Bool
False -> forall name. OutputableBndr name => name -> SDoc
pprPrefixOcc name
var
pprParendLPat :: (OutputableBndrId p)
=> PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat :: forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
p = forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
pprParendPat :: forall p. OutputableBndrId p
=> PprPrec
-> Pat (GhcPass p)
-> SDoc
pprParendPat :: forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
p Pat (GhcPass p)
pat = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration forall a b. (a -> b) -> a -> b
$ \ Bool
print_tc_elab ->
if Bool -> Pat (GhcPass p) -> Bool
need_parens Bool
print_tc_elab Pat (GhcPass p)
pat
then SDoc -> SDoc
parens (forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
pat)
else forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat (GhcPass p)
pat
where
need_parens :: Bool -> Pat (GhcPass p) -> Bool
need_parens Bool
print_tc_elab Pat (GhcPass p)
pat
| GhcPass p
GhcTc <- forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p
, XPat XXPat GhcTc
ext <- Pat (GhcPass p)
pat
, CoPat {} <- XXPat GhcTc
ext
= Bool
print_tc_elab
| Bool
otherwise
= forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p Pat (GhcPass p)
pat
pprPat :: forall p. (OutputableBndrId p) => Pat (GhcPass p) -> SDoc
pprPat :: forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat (VarPat XVarPat (GhcPass p)
_ LIdP (GhcPass p)
lvar) = forall name. OutputableBndr name => name -> SDoc
pprPatBndr (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
lvar)
pprPat (WildPat XWildPat (GhcPass p)
_) = Char -> SDoc
char Char
'_'
pprPat (LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
pat) = Char -> SDoc
char Char
'~' SDoc -> SDoc -> SDoc
<> forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat
pprPat (BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat) = Char -> SDoc
char Char
'!' SDoc -> SDoc -> SDoc
<> forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat
pprPat (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
name LPat (GhcPass p)
pat) = [SDoc] -> SDoc
hcat [forall name. OutputableBndr name => name -> SDoc
pprPrefixOcc (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
name), Char -> SDoc
char Char
'@',
forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat]
pprPat (ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
expr LPat (GhcPass p)
pat) = [SDoc] -> SDoc
hcat [forall (p :: Pass).
OutputableBndrId p =>
LHsExpr (GhcPass p) -> SDoc
pprLExpr LHsExpr (GhcPass p)
expr, String -> SDoc
text String
" -> ", forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat]
pprPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat) = SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat)
pprPat (LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
s) = forall a. Outputable a => a -> SDoc
ppr HsLit (GhcPass p)
s
pprPat (NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
l Maybe (SyntaxExpr (GhcPass p))
Nothing SyntaxExpr (GhcPass p)
_) = forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
l
pprPat (NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
l (Just SyntaxExpr (GhcPass p)
_) SyntaxExpr (GhcPass p)
_) = Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
l
pprPat (NPlusKPat XNPlusKPat (GhcPass p)
_ LIdP (GhcPass p)
n XRec (GhcPass p) (HsOverLit (GhcPass p))
k HsOverLit (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_) = [SDoc] -> SDoc
hcat [SDoc
ppr_n, Char -> SDoc
char Char
'+', forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (HsOverLit (GhcPass p))
k]
where ppr_n :: SDoc
ppr_n = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
GhcPass p
GhcRn -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
GhcPass p
GhcTc -> forall a. Outputable a => a -> SDoc
ppr LIdP (GhcPass p)
n
pprPat (SplicePat XSplicePat (GhcPass p)
_ HsSplice (GhcPass p)
splice) = forall (p :: Pass).
OutputableBndrId p =>
HsSplice (GhcPass p) -> SDoc
pprSplice HsSplice (GhcPass p)
splice
pprPat (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
ty) = forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr HsPatSigType (NoGhcTc (GhcPass p))
ty
pprPat (ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats) = SDoc -> SDoc
brackets (forall a. Outputable a => [a] -> SDoc
interpp'SP [LPat (GhcPass p)]
pats)
pprPat (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
bx)
| [LPat (GhcPass p)
pat] <- [LPat (GhcPass p)]
pats
, Boxity
Boxed <- Boxity
bx
= [SDoc] -> SDoc
hcat [String -> SDoc
text (Boxity -> Int -> String
mkTupleStr Boxity
Boxed Int
1), forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
pat]
| Bool
otherwise
= TupleSort -> SDoc -> SDoc
tupleParens (Boxity -> TupleSort
boxityTupleSort Boxity
bx) (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [LPat (GhcPass p)]
pats)
pprPat (SumPat XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat Int
alt Int
arity) = SDoc -> SDoc
sumParens (forall a. (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
pat Int
alt Int
arity)
pprPat (ConPat { pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con
, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
details
, pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = XConPat (GhcPass p)
ext
}
)
= case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
GhcPass p
GhcRn -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
GhcPass p
GhcTc -> forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypecheckerElaboration forall a b. (a -> b) -> a -> b
$ \case
Bool
False -> forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (ConLikeP (GhcPass p))
con) HsConPatDetails (GhcPass p)
details
Bool
True ->
forall a. Outputable a => a -> SDoc
ppr XRec (GhcPass p) (ConLikeP (GhcPass p))
con
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ [SDoc] -> SDoc
hsep (forall a b. (a -> b) -> [a] -> [b]
map forall name. OutputableBndr name => name -> SDoc
pprPatBndr ([TyVar]
tvs forall a. [a] -> [a] -> [a]
++ [TyVar]
dicts))
, forall a. Outputable a => a -> SDoc
ppr TcEvBinds
binds ])
SDoc -> SDoc -> SDoc
<+> forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs HsConPatDetails (GhcPass p)
details
where ConPatTc { cpt_tvs :: ConPatTc -> [TyVar]
cpt_tvs = [TyVar]
tvs
, cpt_dicts :: ConPatTc -> [TyVar]
cpt_dicts = [TyVar]
dicts
, cpt_binds :: ConPatTc -> TcEvBinds
cpt_binds = TcEvBinds
binds
} = XConPat (GhcPass p)
ext
pprPat (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
GhcPs -> noExtCon ext
GhcRn -> noExtCon ext
#endif
GhcPass p
GhcTc -> HsWrapper -> (Bool -> SDoc) -> SDoc
pprHsWrapper HsWrapper
co forall a b. (a -> b) -> a -> b
$ \Bool
parens ->
if Bool
parens
then forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> Pat (GhcPass p) -> SDoc
pprParendPat PprPrec
appPrec Pat GhcTc
pat
else forall (p :: Pass). OutputableBndrId p => Pat (GhcPass p) -> SDoc
pprPat Pat GhcTc
pat
where CoPat HsWrapper
co Pat GhcTc
pat Type
_ = XXPat (GhcPass p)
ext
pprUserCon :: (OutputableBndr con, OutputableBndrId p,
Outputable (Anno (IdGhcP p)))
=> con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon :: forall con (p :: Pass).
(OutputableBndr con, OutputableBndrId p,
Outputable (Anno (IdGhcP p))) =>
con -> HsConPatDetails (GhcPass p) -> SDoc
pprUserCon con
c (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2) = forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
p1 SDoc -> SDoc -> SDoc
<+> forall name. OutputableBndr name => name -> SDoc
pprInfixOcc con
c SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr LPat (GhcPass p)
p2
pprUserCon con
c HsConDetails
(HsPatSigType (NoGhcTc (GhcPass p)))
(LPat (GhcPass p))
(HsRecFields (GhcPass p) (LPat (GhcPass p)))
details = forall name. OutputableBndr name => name -> SDoc
pprPrefixOcc con
c SDoc -> SDoc -> SDoc
<+> forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs HsConDetails
(HsPatSigType (NoGhcTc (GhcPass p)))
(LPat (GhcPass p))
(HsRecFields (GhcPass p) (LPat (GhcPass p)))
details
pprConArgs :: (OutputableBndrId p,
Outputable (Anno (IdGhcP p)))
=> HsConPatDetails (GhcPass p) -> SDoc
pprConArgs :: forall (p :: Pass).
(OutputableBndrId p, Outputable (Anno (IdGhcP p))) =>
HsConPatDetails (GhcPass p) -> SDoc
pprConArgs (PrefixCon [HsPatSigType (NoGhcTc (GhcPass p))]
ts [LPat (GhcPass p)]
pats) = [SDoc] -> SDoc
fsep (forall a. Outputable a => [a] -> SDoc
pprTyArgs [HsPatSigType (NoGhcTc (GhcPass p))]
ts forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec) [LPat (GhcPass p)]
pats)
where pprTyArgs :: [a] -> SDoc
pprTyArgs [a]
tyargs = [SDoc] -> SDoc
fsep (forall a b. (a -> b) -> [a] -> [b]
map (\a
ty -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr a
ty) [a]
tyargs)
pprConArgs (InfixCon LPat (GhcPass p)
p1 LPat (GhcPass p)
p2) = [SDoc] -> SDoc
sep [ forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
p1
, forall (p :: Pass).
OutputableBndrId p =>
PprPrec -> LPat (GhcPass p) -> SDoc
pprParendLPat PprPrec
appPrec LPat (GhcPass p)
p2 ]
pprConArgs (RecCon HsRecFields (GhcPass p) (LPat (GhcPass p))
rpats) = forall a. Outputable a => a -> SDoc
ppr HsRecFields (GhcPass p) (LPat (GhcPass p))
rpats
mkPrefixConPat :: DataCon ->
[LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat :: DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
dc [LPat GhcTc]
pats [Type]
tys
= forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ ConPat { pat_con :: XRec GhcTc (ConLikeP GhcTc)
pat_con = forall a an. a -> LocatedAn an a
noLocA (DataCon -> ConLike
RealDataCon DataCon
dc)
, pat_args :: HsConPatDetails GhcTc
pat_args = forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [LPat GhcTc]
pats
, pat_con_ext :: XConPat GhcTc
pat_con_ext = ConPatTc
{ cpt_tvs :: [TyVar]
cpt_tvs = []
, cpt_dicts :: [TyVar]
cpt_dicts = []
, cpt_binds :: TcEvBinds
cpt_binds = TcEvBinds
emptyTcEvBinds
, cpt_arg_tys :: [Type]
cpt_arg_tys = [Type]
tys
, cpt_wrap :: HsWrapper
cpt_wrap = HsWrapper
idHsWrapper
}
}
mkNilPat :: Type -> LPat GhcTc
mkNilPat :: Type -> LPat GhcTc
mkNilPat Type
ty = DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
nilDataCon [] [Type
ty]
mkCharLitPat :: SourceText -> Char -> LPat GhcTc
mkCharLitPat :: SourceText -> Char -> LPat GhcTc
mkCharLitPat SourceText
src Char
c = DataCon -> [LPat GhcTc] -> [Type] -> LPat GhcTc
mkPrefixConPat DataCon
charDataCon
[forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XLitPat p -> HsLit p -> Pat p
LitPat NoExtField
noExtField (forall x. XHsCharPrim x -> Char -> HsLit x
HsCharPrim SourceText
src Char
c)] []
isBangedLPat :: LPat (GhcPass p) -> Bool
isBangedLPat :: forall (p :: Pass). LPat (GhcPass p) -> Bool
isBangedLPat = forall (p :: Pass). Pat (GhcPass p) -> Bool
isBangedPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
isBangedPat :: Pat (GhcPass p) -> Bool
isBangedPat :: forall (p :: Pass). Pat (GhcPass p) -> Bool
isBangedPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
p) = forall (p :: Pass). LPat (GhcPass p) -> Bool
isBangedLPat LPat (GhcPass p)
p
isBangedPat (BangPat {}) = Bool
True
isBangedPat Pat (GhcPass p)
_ = Bool
False
looksLazyPatBind :: HsBind (GhcPass p) -> Bool
looksLazyPatBind :: forall (p :: Pass). HsBind (GhcPass p) -> Bool
looksLazyPatBind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass p)
p })
= forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPatBind (AbsBinds { abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds (GhcPass p)
binds })
= forall a. (a -> Bool) -> Bag a -> Bool
anyBag (forall (p :: Pass). HsBind (GhcPass p) -> Bool
looksLazyPatBind forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) LHsBinds (GhcPass p)
binds
looksLazyPatBind HsBindLR (GhcPass p) (GhcPass p)
_
= Bool
False
looksLazyLPat :: LPat (GhcPass p) -> Bool
looksLazyLPat :: forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat = forall (p :: Pass). Pat (GhcPass p) -> Bool
looksLazyPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
looksLazyPat :: Pat (GhcPass p) -> Bool
looksLazyPat :: forall (p :: Pass). Pat (GhcPass p) -> Bool
looksLazyPat (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
p) = forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPat (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LPat (GhcPass p)
p) = forall (p :: Pass). LPat (GhcPass p) -> Bool
looksLazyLPat LPat (GhcPass p)
p
looksLazyPat (BangPat {}) = Bool
False
looksLazyPat (VarPat {}) = Bool
False
looksLazyPat (WildPat {}) = Bool
False
looksLazyPat Pat (GhcPass p)
_ = Bool
True
isIrrefutableHsPat :: forall p. (OutputableBndrId p)
=> DynFlags -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat :: forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat DynFlags
dflags =
forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' (Extension -> DynFlags -> Bool
xopt Extension
LangExt.Strict DynFlags
dflags)
isIrrefutableHsPat' :: forall p. (OutputableBndrId p)
=> Bool
-> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' :: forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' Bool
is_strict = LPat (GhcPass p) -> Bool
goL
where
goL :: LPat (GhcPass p) -> Bool
goL :: LPat (GhcPass p) -> Bool
goL = Pat (GhcPass p) -> Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
go :: Pat (GhcPass p) -> Bool
go :: Pat (GhcPass p) -> Bool
go (WildPat {}) = Bool
True
go (VarPat {}) = Bool
True
go (LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
p')
| Bool
is_strict
= forall (p :: Pass).
OutputableBndrId p =>
Bool -> LPat (GhcPass p) -> Bool
isIrrefutableHsPat' Bool
False LPat (GhcPass p)
p'
| Bool
otherwise = Bool
True
go (BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat) = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
go (ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat) = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
go (AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LPat (GhcPass p)
pat) = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
go (ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
pat) = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
go (SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
_) = LPat (GhcPass p) -> Bool
goL LPat (GhcPass p)
pat
go (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
_) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
goL [LPat (GhcPass p)]
pats
go (SumPat {}) = Bool
False
go (ListPat {}) = Bool
False
go (ConPat
{ pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con
, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
details })
= case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
GhcPass p
GhcPs -> Bool
False
GhcPass p
GhcRn -> Bool
False
GhcPass p
GhcTc -> case XRec (GhcPass p) (ConLikeP (GhcPass p))
con of
L SrcSpanAnnN
_ (PatSynCon PatSyn
_pat) -> Bool
False
L SrcSpanAnnN
_ (RealDataCon DataCon
con) ->
forall a. Maybe a -> Bool
isJust (TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (DataCon -> TyCon
dataConTyCon DataCon
con))
Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LPat (GhcPass p) -> Bool
goL (forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails (GhcPass p)
details)
go (LitPat {}) = Bool
False
go (NPat {}) = Bool
False
go (NPlusKPat {}) = Bool
False
go (SplicePat {}) = Bool
False
go (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 811
GhcPs -> noExtCon ext
GhcRn -> noExtCon ext
#endif
GhcPass p
GhcTc -> Pat (GhcPass p) -> Bool
go Pat GhcTc
pat
where CoPat HsWrapper
_ Pat GhcTc
pat Type
_ = XXPat (GhcPass p)
ext
isSimplePat :: LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat :: forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
p = case forall l e. GenLocated l e -> e
unLoc LPat (GhcPass x)
p of
ParPat XParPat (GhcPass x)
_ LPat (GhcPass x)
x -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
SigPat XSigPat (GhcPass x)
_ LPat (GhcPass x)
x HsPatSigType (NoGhcTc (GhcPass x))
_ -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
LazyPat XLazyPat (GhcPass x)
_ LPat (GhcPass x)
x -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
BangPat XBangPat (GhcPass x)
_ LPat (GhcPass x)
x -> forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
isSimplePat LPat (GhcPass x)
x
VarPat XVarPat (GhcPass x)
_ LIdP (GhcPass x)
x -> forall a. a -> Maybe a
Just (forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass x)
x)
Pat (GhcPass x)
_ -> forall a. Maybe a
Nothing
patNeedsParens :: forall p. IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens :: forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p = Pat (GhcPass p) -> Bool
go
where
go :: Pat (GhcPass p) -> Bool
go :: Pat (GhcPass p) -> Bool
go (NPlusKPat {}) = PprPrec
p forall a. Ord a => a -> a -> Bool
> PprPrec
opPrec
go (SplicePat {}) = Bool
False
go (ConPat { pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
ds })
= forall t a b. PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens PprPrec
p HsConPatDetails (GhcPass p)
ds
go (SigPat {}) = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
sigPrec
go (ViewPat {}) = Bool
True
go (XPat XXPat (GhcPass p)
ext) = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
#if __GLASGOW_HASKELL__ < 901
GhcPs -> noExtCon ext
GhcRn -> noExtCon ext
#endif
GhcPass p
GhcTc -> Pat (GhcPass p) -> Bool
go Pat GhcTc
inner
where CoPat HsWrapper
_ Pat GhcTc
inner Type
_ = XXPat (GhcPass p)
ext
go (WildPat {}) = Bool
False
go (VarPat {}) = Bool
False
go (LazyPat {}) = Bool
False
go (BangPat {}) = Bool
False
go (ParPat {}) = Bool
False
go (AsPat {}) = Bool
False
go (TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)
_] Boxity
Boxed)
= PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec
go (TuplePat{}) = Bool
False
go (SumPat {}) = Bool
False
go (ListPat {}) = Bool
False
go (LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
l) = forall x. PprPrec -> HsLit x -> Bool
hsLitNeedsParens PprPrec
p HsLit (GhcPass p)
l
go (NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
lol Maybe (SyntaxExpr (GhcPass p))
_ SyntaxExpr (GhcPass p)
_) = forall x. PprPrec -> HsOverLit x -> Bool
hsOverLitNeedsParens PprPrec
p (forall l e. GenLocated l e -> e
unLoc XRec (GhcPass p) (HsOverLit (GhcPass p))
lol)
conPatNeedsParens :: PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens :: forall t a b. PprPrec -> HsConDetails t a b -> Bool
conPatNeedsParens PprPrec
p = HsConDetails t a b -> Bool
go
where
go :: HsConDetails t a b -> Bool
go (PrefixCon [t]
ts [a]
args) = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
appPrec Bool -> Bool -> Bool
&& (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
args) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
ts))
go (InfixCon {}) = PprPrec
p forall a. Ord a => a -> a -> Bool
>= PprPrec
opPrec
go (RecCon {}) = Bool
False
parenthesizePat :: IsPass p
=> PprPrec
-> LPat (GhcPass p)
-> LPat (GhcPass p)
parenthesizePat :: forall (p :: Pass).
IsPass p =>
PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat PprPrec
p lpat :: LPat (GhcPass p)
lpat@(L SrcSpanAnnA
loc Pat (GhcPass p)
pat)
| forall (p :: Pass). IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
patNeedsParens PprPrec
p Pat (GhcPass p)
pat = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (forall p. XParPat p -> LPat p -> Pat p
ParPat forall a. EpAnn a
noAnn LPat (GhcPass p)
lpat)
| Bool
otherwise = LPat (GhcPass p)
lpat
collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
collectEvVarsPats :: [Pat GhcTc] -> Bag TyVar
collectEvVarsPats = forall a. [Bag a] -> Bag a
unionManyBags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Pat GhcTc -> Bag TyVar
collectEvVarsPat
collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
collectEvVarsLPat :: LPat GhcTc -> Bag TyVar
collectEvVarsLPat = Pat GhcTc -> Bag TyVar
collectEvVarsPat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
collectEvVarsPat :: Pat GhcTc -> Bag EvVar
collectEvVarsPat :: Pat GhcTc -> Bag TyVar
collectEvVarsPat Pat GhcTc
pat =
case Pat GhcTc
pat of
LazyPat XLazyPat GhcTc
_ LPat GhcTc
p -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
AsPat XAsPat GhcTc
_ LIdP GhcTc
_ LPat GhcTc
p -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
ParPat XParPat GhcTc
_ LPat GhcTc
p -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
BangPat XBangPat GhcTc
_ LPat GhcTc
p -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
ListPat XListPat GhcTc
_ [LPat GhcTc]
ps -> forall a. [Bag a] -> Bag a
unionManyBags forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat [LPat GhcTc]
ps
TuplePat XTuplePat GhcTc
_ [LPat GhcTc]
ps Boxity
_ -> forall a. [Bag a] -> Bag a
unionManyBags forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat [LPat GhcTc]
ps
SumPat XSumPat GhcTc
_ LPat GhcTc
p Int
_ Int
_ -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
ConPat
{ pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails GhcTc
args
, pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = ConPatTc
{ cpt_dicts :: ConPatTc -> [TyVar]
cpt_dicts = [TyVar]
dicts
}
}
-> forall a. Bag a -> Bag a -> Bag a
unionBags (forall a. [a] -> Bag a
listToBag [TyVar]
dicts)
forall a b. (a -> b) -> a -> b
$ forall a. [Bag a] -> Bag a
unionManyBags
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LPat GhcTc -> Bag TyVar
collectEvVarsLPat
forall a b. (a -> b) -> a -> b
$ forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs HsConPatDetails GhcTc
args
SigPat XSigPat GhcTc
_ LPat GhcTc
p HsPatSigType (NoGhcTc GhcTc)
_ -> LPat GhcTc -> Bag TyVar
collectEvVarsLPat LPat GhcTc
p
XPat (CoPat HsWrapper
_ Pat GhcTc
p Type
_) -> Pat GhcTc -> Bag TyVar
collectEvVarsPat Pat GhcTc
p
Pat GhcTc
_other_pat -> forall a. Bag a
emptyBag
type instance Anno (Pat (GhcPass p)) = SrcSpanAnnA
type instance Anno (HsOverLit (GhcPass p)) = SrcSpan
type instance Anno ConLike = SrcSpanAnnN
type instance Anno (HsRecField' p arg) = SrcSpanAnnA
type instance Anno (HsRecField' (GhcPass p) (LocatedA (HsExpr (GhcPass p)))) = SrcSpanAnnA
type instance Anno (HsRecField (GhcPass p) arg) = SrcSpanAnnA
type instance Anno (HsRecField' (AmbiguousFieldOcc p) (LocatedA (HsExpr p))) = SrcSpanAnnA
type instance Anno (AmbiguousFieldOcc GhcTc) = SrcSpanAnnA