{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.Tc.Types.Origin (
UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,
ReportRedundantConstraints(..), reportRedundantConstraints,
redundantConstraintsSpan,
SkolemInfo(..), SkolemInfoAnon(..), mkSkolemInfo, getSkolemInfo, pprSigSkolInfo, pprSkolInfo,
unkSkol, unkSkolAnon, mkClsInstSkol,
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
isVisibleOrigin, toInvisibleOrigin,
pprCtOrigin, isGivenOrigin, isWantedWantedFunDepOrigin,
isWantedSuperclassOrigin,
ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..),
TypedThing(..), TyVarBndrs(..),
isPushCallStackOrigin, callStackOriginFS,
FixedRuntimeRepOrigin(..),
FixedRuntimeRepContext(..),
pprFixedRuntimeRepContext,
StmtOrigin(..), ArgPos(..),
mkFRRUnboxedTuple, mkFRRUnboxedSum,
RepPolyId(..), Polarity(..), Position(..),
FRRArrowContext(..), pprFRRArrowContext,
ExpectedFunTyOrigin(..), pprExpectedFunTyOrigin, pprExpectedFunTyHerald,
InstanceWhat(..), SafeOverlapping
) where
import GHC.Prelude
import GHC.Tc.Utils.TcType
import GHC.Hs
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Class
import GHC.Core.InstEnv
import GHC.Core.PatSyn
import GHC.Core.Multiplicity ( scaledThing )
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Stack
import GHC.Utils.Monad
import GHC.Utils.Misc( HasDebugCallStack )
import GHC.Types.Unique
import GHC.Types.Unique.Supply
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
import qualified Data.Kind as Hs
data UserTypeCtxt
= FunSigCtxt
Name
ReportRedundantConstraints
| InfSigCtxt Name
| ExprSigCtxt
ReportRedundantConstraints
| KindSigCtxt
| StandaloneKindSigCtxt
Name
| TypeAppCtxt
| ConArgCtxt Name
| TySynCtxt Name
| PatSynCtxt Name
| PatSigCtxt
| RuleSigCtxt FastString Name
| ForSigCtxt Name
| DefaultDeclCtxt
| InstDeclCtxt Bool
| SpecInstCtxt
| GenSigCtxt
| GhciCtxt Bool
| ClassSCCtxt Name
| SigmaCtxt
| DataTyCtxt Name
| DerivClauseCtxt
| TyVarBndrKindCtxt Name
| DataKindCtxt Name
| TySynKindCtxt Name
| TyFamResKindCtxt Name
deriving( UserTypeCtxt -> UserTypeCtxt -> Bool
(UserTypeCtxt -> UserTypeCtxt -> Bool)
-> (UserTypeCtxt -> UserTypeCtxt -> Bool) -> Eq UserTypeCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserTypeCtxt -> UserTypeCtxt -> Bool
== :: UserTypeCtxt -> UserTypeCtxt -> Bool
$c/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
Eq )
data ReportRedundantConstraints
= NoRRC
| WantRRC SrcSpan
deriving( ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
(ReportRedundantConstraints -> ReportRedundantConstraints -> Bool)
-> (ReportRedundantConstraints
-> ReportRedundantConstraints -> Bool)
-> Eq ReportRedundantConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
$c/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
Eq )
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints ReportRedundantConstraints
NoRRC = Bool
False
reportRedundantConstraints (WantRRC {}) = Bool
True
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan (FunSigCtxt Name
_ (WantRRC SrcSpan
span)) = SrcSpan
span
redundantConstraintsSpan (ExprSigCtxt (WantRRC SrcSpan
span)) = SrcSpan
span
redundantConstraintsSpan UserTypeCtxt
_ = SrcSpan
noSrcSpan
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt Name
n ReportRedundantConstraints
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (InfSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the inferred type for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (RuleSigCtxt FastString
_ Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (ExprSigCtxt ReportRedundantConstraints
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression type signature"
pprUserTypeCtxt UserTypeCtxt
KindSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
TypeAppCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument"
pprUserTypeCtxt (ConArgCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type of the constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt (TySynCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the RHS of the type synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
PatSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern type signature"
pprUserTypeCtxt (ForSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the foreign declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
DefaultDeclCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `default' declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
False) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an instance declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
True) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a stand-alone deriving instance declaration"
pprUserTypeCtxt UserTypeCtxt
SpecInstCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE instance pragma"
pprUserTypeCtxt UserTypeCtxt
GenSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type expected by the context"
pprUserTypeCtxt (GhciCtxt {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the super-classes of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
SigmaCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt Name
tc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the context of the data type declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc)
pprUserTypeCtxt (PatSynCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the signature for pattern synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (UserTypeCtxt
DerivClauseCtxt) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `deriving' clause"
pprUserTypeCtxt (TyVarBndrKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (DataKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TySynKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TyFamResKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the result kind for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt Name
n ReportRedundantConstraints
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ConArgCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ForSigCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (PatSynCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe UserTypeCtxt
_ = Maybe Name
forall a. Maybe a
Nothing
data SkolemInfo
= SkolemInfo
Unique
SkolemInfoAnon
instance Uniquable SkolemInfo where
getUnique :: SkolemInfo -> Unique
getUnique (SkolemInfo Unique
u SkolemInfoAnon
_) = Unique
u
data SkolemInfoAnon
= SigSkol
UserTypeCtxt
TcType
[(Name,TcTyVar)]
| SigTypeSkol UserTypeCtxt
| ForAllSkol
TyVarBndrs
| DerivSkol Type
| InstSkol
ClsInstOrQC
PatersonSize
| FamInstSkol
| PatSkol
ConLike
HsMatchContextRn
| IPSkol [HsIPName]
| RuleSkol RuleName
| InferSkol [(Name,TcType)]
| BracketSkol
| UnifyForAllSkol
TcType
| TyConSkol (TyConFlavour TyCon) Name
| DataConSkol Name
| ReifySkol
| RuntimeUnkSkol
| ArrowReboundIfSkol
| UnkSkol CallStack
unkSkol :: HasDebugCallStack => SkolemInfo
unkSkol :: HasDebugCallStack => SkolemInfo
unkSkol = Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo (Word64 -> Unique
mkUniqueGrimily Word64
0) SkolemInfoAnon
HasDebugCallStack => SkolemInfoAnon
unkSkolAnon
unkSkolAnon :: HasDebugCallStack => SkolemInfoAnon
unkSkolAnon :: HasDebugCallStack => SkolemInfoAnon
unkSkolAnon = CallStack -> SkolemInfoAnon
UnkSkol CallStack
HasCallStack => CallStack
callStack
mkSkolemInfo :: MonadIO m => SkolemInfoAnon -> m SkolemInfo
mkSkolemInfo :: forall (m :: * -> *). MonadIO m => SkolemInfoAnon -> m SkolemInfo
mkSkolemInfo SkolemInfoAnon
sk_anon = do
u <- IO Unique -> m Unique
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Unique -> m Unique) -> IO Unique -> m Unique
forall a b. (a -> b) -> a -> b
$! Char -> IO Unique
uniqFromTag Char
's'
return (SkolemInfo u sk_anon)
getSkolemInfo :: SkolemInfo -> SkolemInfoAnon
getSkolemInfo :: SkolemInfo -> SkolemInfoAnon
getSkolemInfo (SkolemInfo Unique
_ SkolemInfoAnon
skol_anon) = SkolemInfoAnon
skol_anon
mkClsInstSkol :: Class -> [Type] -> SkolemInfoAnon
mkClsInstSkol :: Class -> [TcType] -> SkolemInfoAnon
mkClsInstSkol Class
cls [TcType]
tys = ClsInstOrQC -> PatersonSize -> SkolemInfoAnon
InstSkol ClsInstOrQC
IsClsInst (Class -> [TcType] -> PatersonSize
pSizeClassPred Class
cls [TcType]
tys)
instance Outputable SkolemInfo where
ppr :: SkolemInfo -> SDoc
ppr (SkolemInfo Unique
_ SkolemInfoAnon
sk_info ) = SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
sk_info
instance Outputable SkolemInfoAnon where
ppr :: SkolemInfoAnon -> SDoc
ppr = SkolemInfoAnon -> SDoc
pprSkolInfo
pprSkolInfo :: SkolemInfoAnon -> SDoc
pprSkolInfo :: SkolemInfoAnon -> SDoc
pprSkolInfo (SigSkol UserTypeCtxt
cx TcType
ty [(Name, Id)]
_) = UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
cx TcType
ty
pprSkolInfo (SigTypeSkol UserTypeCtxt
cx) = UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
cx
pprSkolInfo (ForAllSkol TyVarBndrs
tvs) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an explicit forall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVarBndrs -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
tvs
pprSkolInfo (IPSkol [HsIPName]
ips) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the implicit-parameter binding" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [HsIPName] -> SDoc
forall a. [a] -> SDoc
plural [HsIPName]
ips SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (HsIPName -> SDoc) -> [HsIPName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsIPName]
ips
pprSkolInfo (DerivSkol TcType
pred) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the deriving clause for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred)
pprSkolInfo (InstSkol ClsInstOrQC
IsClsInst PatersonSize
sz) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the instance declaration"
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (PatersonSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatersonSize
sz)) ]
pprSkolInfo (InstSkol (IsQC {}) PatersonSize
sz) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a quantified context"
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (PatersonSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatersonSize
sz)) ]
pprSkolInfo SkolemInfoAnon
FamInstSkol = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a family instance declaration"
pprSkolInfo SkolemInfoAnon
BracketSkol = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a Template Haskell bracket"
pprSkolInfo (RuleSkol FastString
name) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the RULE" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
pprRuleName FastString
name
pprSkolInfo (PatSkol ConLike
cl HsMatchContextRn
mc) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ ConLike -> SDoc
pprPatSkolInfo ConLike
cl
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsMatchContext (GenLocated SrcSpanAnnN Name) -> SDoc
forall fn. Outputable fn => HsMatchContext fn -> SDoc
pprMatchContext HsMatchContextRn
HsMatchContext (GenLocated SrcSpanAnnN Name)
mc ]
pprSkolInfo (InferSkol [(Name, TcType)]
ids) = SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the inferred type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [(Name, TcType)] -> SDoc
forall a. [a] -> SDoc
plural [(Name, TcType)]
ids SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of")
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
| (Name
name,TcType
ty) <- [(Name, TcType)]
ids ])
pprSkolInfo (UnifyForAllSkol TcType
ty) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
pprSkolInfo (TyConSkol TyConFlavour TyCon
flav Name
name) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyConFlavour TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour TyCon
flav SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo (DataConSkol Name
name) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo SkolemInfoAnon
ReifySkol = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type being reified"
pprSkolInfo SkolemInfoAnon
RuntimeUnkSkol = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unknown type from GHCi runtime"
pprSkolInfo SkolemInfoAnon
ArrowReboundIfSkol = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the expected type of a rebound if-then-else command"
pprSkolInfo (UnkSkol CallStack
cs) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnkSkol (please report this as a bug)" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ CallStack -> SDoc
prettyCallStackDoc CallStack
cs
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
ctxt TcType
ty
= case UserTypeCtxt
ctxt of
FunSigCtxt Name
f ReportRedundantConstraints
_ -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for:"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (Name -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc Name
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
PatSynCtxt {} -> UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt
UserTypeCtxt
_ -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo (RealDataCon DataCon
dc)
= (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes (\Bool
show_linear_types ->
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern with constructor:"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
pprType (Bool -> DataCon -> TcType
dataConDisplayType Bool
show_linear_types DataCon
dc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma ])
pprPatSkolInfo (PatSynCon PatSyn
ps)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern with pattern synonym:"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
ps SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma ]
data TypedThing
= HsTypeRnThing (HsType GhcRn)
| TypeThing Type
| HsExprRnThing (HsExpr GhcRn)
| HsExprTcThing (HsExpr GhcTc)
| NameThing Name
data TyVarBndrs
= forall flag. OutputableBndrFlag flag 'Renamed =>
HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
instance Outputable TypedThing where
ppr :: TypedThing -> SDoc
ppr (HsTypeRnThing HsType GhcRn
ty) = HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
ppr (TypeThing TcType
ty) = TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
ppr (HsExprRnThing HsExpr GhcRn
expr) = HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr
ppr (HsExprTcThing HsExpr GhcTc
expr) = HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
expr
ppr (NameThing Name
name) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
instance Outputable TyVarBndrs where
ppr :: TyVarBndrs -> SDoc
ppr (HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
bndrs) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ((HsTyVarBndr flag GhcRn -> SDoc)
-> [HsTyVarBndr flag GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map HsTyVarBndr flag GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsTyVarBndr flag GhcRn]
bndrs)
data CtOrigin
=
GivenOrigin SkolemInfoAnon
| GivenSCOrigin
SkolemInfoAnon
ScDepth
Bool
| OccurrenceOf Name
| OccurrenceOfRecSel RdrName
| AppOrigin
| SpecPragOrigin UserTypeCtxt
| TypeEqOrigin { CtOrigin -> TcType
uo_actual :: TcType
, CtOrigin -> TcType
uo_expected :: TcType
, CtOrigin -> Maybe TypedThing
uo_thing :: Maybe TypedThing
, CtOrigin -> Bool
uo_visible :: Bool
}
| KindEqOrigin
TcType TcType
CtOrigin
(Maybe TypeOrKind)
| IPOccOrigin HsIPName
| OverLabelOrigin FastString
| LiteralOrigin (HsOverLit GhcRn)
| NegateOrigin
| ArithSeqOrigin (ArithSeqInfo GhcRn)
| AssocFamPatOrigin
| SectionOrigin
| GetFieldOrigin FastString
| TupleOrigin
| ExprSigOrigin
| PatSigOrigin
| PatOrigin
| ProvCtxtOrigin
(PatSynBind GhcRn GhcRn)
| RecordUpdOrigin
| ViewPatOrigin
| ScOrigin
ClsInstOrQC
NakedScFlag
| DerivClauseOrigin
| DerivOriginDC DataCon Int Bool
| DerivOriginCoerce Id Type Type Bool
| StandAloneDerivOrigin
| DefaultOrigin
| DoOrigin
| DoPatOrigin (LPat GhcRn)
| MCompOrigin
| MCompPatOrigin (LPat GhcRn)
| ProcOrigin
| ArrowCmdOrigin
| AnnOrigin
| FunDepOrigin1
PredType CtOrigin RealSrcSpan
PredType CtOrigin RealSrcSpan
| FunDepOrigin2
PredType CtOrigin
PredType SrcSpan
| InjTFOrigin1
PredType CtOrigin RealSrcSpan
PredType CtOrigin RealSrcSpan
| ExprHoleOrigin (Maybe RdrName)
| TypeHoleOrigin OccName
| PatCheckOrigin
| ListOrigin
| IfThenElseOrigin
| BracketOrigin
| StaticOrigin
| ImpedanceMatching Id
| Shouldn'tHappenOrigin String
| InstProvidedOrigin
Module
ClsInst
| NonLinearPatternOrigin NonLinearPatternReason (LPat GhcRn)
| OmittedFieldOrigin (Maybe FieldLabel)
| UsageEnvironmentOf Name
| CycleBreakerOrigin
CtOrigin
| FRROrigin
FixedRuntimeRepOrigin
| WantedSuperclassOrigin PredType CtOrigin
| InstanceSigOrigin
Name
Type
Type
| AmbiguityCheckOrigin UserTypeCtxt
data NonLinearPatternReason
= LazyPatternReason
| GeneralisedPatternReason
| PatternSynonymReason
| ViewPatternReason
| OtherPatternReason
type ScDepth = Int
data ClsInstOrQC = IsClsInst
| IsQC CtOrigin
data NakedScFlag = NakedSc | NotNakedSc
instance Outputable NakedScFlag where
ppr :: NakedScFlag -> SDoc
ppr NakedScFlag
NakedSc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NakedSc"
ppr NakedScFlag
NotNakedSc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NotNakedSc"
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin (TypeEqOrigin { uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis }) = Bool
vis
isVisibleOrigin (KindEqOrigin TcType
_ TcType
_ CtOrigin
sub_orig Maybe TypeOrKind
_) = CtOrigin -> Bool
isVisibleOrigin CtOrigin
sub_orig
isVisibleOrigin CtOrigin
_ = Bool
True
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin orig :: CtOrigin
orig@(TypeEqOrigin {}) = CtOrigin
orig { uo_visible = False }
toInvisibleOrigin CtOrigin
orig = CtOrigin
orig
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin (GivenOrigin {}) = Bool
True
isGivenOrigin (GivenSCOrigin {}) = Bool
True
isGivenOrigin (CycleBreakerOrigin CtOrigin
o) = CtOrigin -> Bool
isGivenOrigin CtOrigin
o
isGivenOrigin CtOrigin
_ = Bool
False
isWantedWantedFunDepOrigin :: CtOrigin -> Bool
isWantedWantedFunDepOrigin :: CtOrigin -> Bool
isWantedWantedFunDepOrigin (FunDepOrigin1 TcType
_ CtOrigin
orig1 RealSrcSpan
_ TcType
_ CtOrigin
orig2 RealSrcSpan
_)
= Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig2)
isWantedWantedFunDepOrigin (InjTFOrigin1 TcType
_ CtOrigin
orig1 RealSrcSpan
_ TcType
_ CtOrigin
orig2 RealSrcSpan
_)
= Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig2)
isWantedWantedFunDepOrigin CtOrigin
_ = Bool
False
isWantedSuperclassOrigin :: CtOrigin -> Bool
isWantedSuperclassOrigin :: CtOrigin -> Bool
isWantedSuperclassOrigin (WantedSuperclassOrigin {}) = Bool
True
isWantedSuperclassOrigin CtOrigin
_ = Bool
False
instance Outputable CtOrigin where
ppr :: CtOrigin -> SDoc
ppr = CtOrigin -> SDoc
pprCtOrigin
ctoHerald :: SDoc
ctoHerald :: SDoc
ctoHerald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising from"
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin (L SrcSpanAnnA
_ HsExpr GhcRn
e) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
name)) = Name -> CtOrigin
OccurrenceOf Name
name
exprCtOrigin (HsGetField XGetField GhcRn
_ LHsExpr GhcRn
_ (L EpAnnCO
_ DotFieldOcc GhcRn
f)) = FastString -> CtOrigin
GetFieldOrigin (FieldLabelString -> FastString
field_label (FieldLabelString -> FastString) -> FieldLabelString -> FastString
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString)
-> GenLocated SrcSpanAnnN FieldLabelString -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ DotFieldOcc GhcRn -> XRec GhcRn FieldLabelString
forall p. DotFieldOcc p -> XRec p FieldLabelString
dfoLabel DotFieldOcc GhcRn
f)
exprCtOrigin (HsUnboundVar {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"unbound variable"
exprCtOrigin (HsOverLabel XOverLabel GhcRn
_ FastString
l) = FastString -> CtOrigin
OverLabelOrigin FastString
l
exprCtOrigin (ExplicitList {}) = CtOrigin
ListOrigin
exprCtOrigin (HsIPVar XIPVar GhcRn
_ HsIPName
ip) = HsIPName -> CtOrigin
IPOccOrigin HsIPName
ip
exprCtOrigin (HsOverLit XOverLitE GhcRn
_ HsOverLit GhcRn
lit) = HsOverLit GhcRn -> CtOrigin
LiteralOrigin HsOverLit GhcRn
lit
exprCtOrigin (HsLit {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"concrete literal"
exprCtOrigin (HsLam XLam GhcRn
_ HsLamVariant
_ MatchGroup GhcRn (LHsExpr GhcRn)
ms) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
ms
exprCtOrigin (HsApp XApp GhcRn
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
_) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e1 LHsWcType (NoGhcTc GhcRn)
_) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (OpApp XOpApp GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
op LHsExpr GhcRn
_) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
op
exprCtOrigin (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsPar XPar GhcRn
_ LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsProjection XProjection GhcRn
_ NonEmpty (DotFieldOcc GhcRn)
_) = CtOrigin
SectionOrigin
exprCtOrigin (SectionL XSectionL GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_) = CtOrigin
SectionOrigin
exprCtOrigin (SectionR XSectionR GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_) = CtOrigin
SectionOrigin
exprCtOrigin (ExplicitTuple {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit tuple"
exprCtOrigin ExplicitSum{} = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit sum"
exprCtOrigin (HsCase XCase GhcRn
_ LHsExpr GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsIf {}) = CtOrigin
IfThenElseOrigin
exprCtOrigin (HsMultiIf XMultiIf GhcRn
_ [LGRHS GhcRn (LHsExpr GhcRn)]
rhs) = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
rhs
exprCtOrigin (HsLet XLet GhcRn
_ HsLocalBinds GhcRn
_ LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsDo {}) = CtOrigin
DoOrigin
exprCtOrigin (RecordCon {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"record construction"
exprCtOrigin (RecordUpd {}) = CtOrigin
RecordUpdOrigin
exprCtOrigin (ExprWithTySig {}) = CtOrigin
ExprSigOrigin
exprCtOrigin (ArithSeq {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"arithmetic sequence"
exprCtOrigin (HsPragE XPragE GhcRn
_ HsPragE GhcRn
_ LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsTypedBracket {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH typed bracket"
exprCtOrigin (HsUntypedBracket {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH untyped bracket"
exprCtOrigin (HsTypedSplice {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH typed splice"
exprCtOrigin (HsUntypedSplice {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH untyped splice"
exprCtOrigin (HsProc {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"proc"
exprCtOrigin (HsStatic {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"static expression"
exprCtOrigin (HsEmbTy {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"type expression"
exprCtOrigin (HsForAll {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"forall telescope"
exprCtOrigin (HsQual {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"constraint context"
exprCtOrigin (HsFunArr {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"function arrow"
exprCtOrigin (XExpr (ExpandedThingRn HsThingRn
thing HsExpr GhcRn
_)) | OrigExpr HsExpr GhcRn
a <- HsThingRn
thing = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
a
| OrigStmt ExprLStmt GhcRn
_ <- HsThingRn
thing = CtOrigin
DoOrigin
| OrigPat LPat GhcRn
p <- HsThingRn
thing = LPat GhcRn -> CtOrigin
DoPatOrigin LPat GhcRn
p
exprCtOrigin (XExpr (PopErrCtxt {})) = String -> CtOrigin
Shouldn'tHappenOrigin String
"PopErrCtxt"
exprCtOrigin (XExpr (HsRecSelRn FieldOcc GhcRn
f)) = RdrName -> CtOrigin
OccurrenceOfRecSel (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt FieldOcc GhcRn
f)
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts })
| L SrcSpanAnnLW
_ [L SrcSpanAnnA
_ Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match] <- XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts
, Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhss } <- Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match
= GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin GRHSs GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhss
| Bool
otherwise
= String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way match"
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin (GRHSs { grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs = [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss }) = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [L EpAnnCO
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [ExprLStmt GhcRn]
_ (L SrcSpanAnnA
_ HsExpr GhcRn
e))] = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
_ = String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way GRHS"
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin SkolemInfoAnon
sk)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
sk
pprCtOrigin (GivenSCOrigin SkolemInfoAnon
sk ScDepth
d Bool
blk)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
pprSkolInfo SkolemInfoAnon
sk
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"given-sc:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
forall a. Outputable a => a -> SDoc
ppr ScDepth
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
blk)) ]
pprCtOrigin (SpecPragOrigin UserTypeCtxt
ctxt)
= case UserTypeCtxt
ctxt of
FunSigCtxt Name
n ReportRedundantConstraints
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
UserTypeCtxt
SpecInstCtxt -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE INSTANCE pragma"
UserTypeCtxt
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE pragma"
pprCtOrigin (FunDepOrigin1 TcType
pred1 CtOrigin
orig1 RealSrcSpan
loc1 TcType
pred2 CtOrigin
orig2 RealSrcSpan
loc2)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a functional dependency between constraints:")
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) ScDepth
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
, SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) ScDepth
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])
pprCtOrigin (FunDepOrigin2 TcType
pred1 CtOrigin
orig1 TcType
pred2 SrcSpan
loc2)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a functional dependency between:")
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1))
ScDepth
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 )
, SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2))
ScDepth
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc2) ])
pprCtOrigin (InjTFOrigin1 TcType
pred1 CtOrigin
orig1 RealSrcSpan
loc1 TcType
pred2 CtOrigin
orig2 RealSrcSpan
loc2)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"reasoning about an injective type family using constraints:")
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) ScDepth
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
, SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) ScDepth
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])
pprCtOrigin CtOrigin
AssocFamPatOrigin
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"when matching a family LHS with its class instance head"
pprCtOrigin (TypeEqOrigin { uo_actual :: CtOrigin -> TcType
uo_actual = TcType
t1, uo_expected :: CtOrigin -> TcType
uo_expected = TcType
t2, uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis })
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type equality" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
vis)))
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])
pprCtOrigin (KindEqOrigin TcType
t1 TcType
t2 CtOrigin
_ Maybe TypeOrKind
_)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a kind equality arising from")
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])
pprCtOrigin (DerivOriginDC DataCon
dc ScDepth
n Bool
_)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
n
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"field of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc))
ScDepth
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Scaled TcType -> TcType
forall a. Scaled a -> a
scaledThing Scaled TcType
ty))))
where
ty :: Scaled TcType
ty = DataCon -> [Scaled TcType]
dataConOrigArgTys DataCon
dc [Scaled TcType] -> ScDepth -> Scaled TcType
forall a. HasCallStack => [a] -> ScDepth -> a
!! (ScDepth
nScDepth -> ScDepth -> ScDepth
forall a. Num a => a -> a -> a
-ScDepth
1)
pprCtOrigin (DerivOriginCoerce Id
meth TcType
ty1 TcType
ty2 Bool
_)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the coercion of the method" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
meth))
ScDepth
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty1)
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty2) ])
pprCtOrigin (DoPatOrigin LPat GhcRn
pat)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a do statement"
SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with the failable pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat)
pprCtOrigin (MCompPatOrigin LPat GhcRn
pat)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the failable pattern"
, SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a statement in a monad comprehension" ]
pprCtOrigin (Shouldn'tHappenOrigin String
note)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<< This should not appear in error messages. If you see this"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in an error message, please report a bug mentioning"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
note) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>"
]
pprCtOrigin (ProvCtxtOrigin PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = (L SrcSpanAnnN
_ Name
name) })
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the \"provided\" constraints claimed by")
ScDepth
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the signature of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name))
pprCtOrigin (InstProvidedOrigin Module
mod ClsInst
cls_inst)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising when attempting to show that"
, ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClsInst
cls_inst
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is provided by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)]
pprCtOrigin (ImpedanceMatching Id
x)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising when matching required constraints"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a group involving" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
x)]
pprCtOrigin (CycleBreakerOrigin CtOrigin
orig)
= CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig
pprCtOrigin (WantedSuperclassOrigin TcType
subclass_pred CtOrigin
subclass_orig)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a superclass required to satisfy" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
subclass_pred) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
, CtOrigin -> SDoc
pprCtOrigin CtOrigin
subclass_orig ]
pprCtOrigin (InstanceSigOrigin Name
method_name TcType
sig_type TcType
orig_method_type)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the check that an instance signature is more general"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"than the type of the method (instantiated for this instance)"
, SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance signature:")
ScDepth
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
method_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
sig_type)
, SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instantiated method type:")
ScDepth
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
orig_method_type) ]
pprCtOrigin (AmbiguityCheckOrigin UserTypeCtxt
ctxt)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type ambiguity check for" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt
pprCtOrigin (ScOrigin ClsInstOrQC
IsClsInst NakedScFlag
nkd)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the superclasses of an instance declaration"
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sc-origin:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> NakedScFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr NakedScFlag
nkd)) ]
pprCtOrigin (ScOrigin (IsQC CtOrigin
orig) NakedScFlag
nkd)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the head of a quantified constraint"
, SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sc-origin:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> NakedScFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr NakedScFlag
nkd))
, CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig ]
pprCtOrigin (NonLinearPatternOrigin NonLinearPatternReason
reason LPat GhcRn
pat)
= SDoc -> ScDepth -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a non-linear pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat))
ScDepth
2 (HasDebugCallStack => NonLinearPatternReason -> SDoc
NonLinearPatternReason -> SDoc
pprNonLinearPatternReason NonLinearPatternReason
reason)
pprCtOrigin CtOrigin
simple_origin
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HasDebugCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
simple_origin
pprCtO :: HasDebugCallStack => CtOrigin -> SDoc
pprCtO :: HasDebugCallStack => CtOrigin -> SDoc
pprCtO (OccurrenceOf Name
name) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)]
pprCtO (OccurrenceOfRecSel RdrName
name) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]
pprCtO CtOrigin
AppOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an application"
pprCtO (IPOccOrigin HsIPName
name) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of implicit parameter", SDoc -> SDoc
quotes (HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
name)]
pprCtO (OverLabelOrigin FastString
l) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the overloaded label"
,SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
l)]
pprCtO CtOrigin
RecordUpdOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a record update"
pprCtO CtOrigin
ExprSigOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression type signature"
pprCtO CtOrigin
PatSigOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern type signature"
pprCtO CtOrigin
PatOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern"
pprCtO CtOrigin
ViewPatOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a view pattern"
pprCtO (LiteralOrigin HsOverLit GhcRn
lit) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the literal", SDoc -> SDoc
quotes (HsOverLit GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcRn
lit)]
pprCtO (ArithSeqOrigin ArithSeqInfo GhcRn
seq) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the arithmetic sequence", SDoc -> SDoc
quotes (ArithSeqInfo GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArithSeqInfo GhcRn
seq)]
pprCtO CtOrigin
SectionOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an operator section"
pprCtO (GetFieldOrigin FastString
f) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"selecting the field", SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
f)]
pprCtO CtOrigin
AssocFamPatOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the LHS of a family instance"
pprCtO CtOrigin
TupleOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a tuple"
pprCtO CtOrigin
NegateOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of syntactic negation"
pprCtO (ScOrigin ClsInstOrQC
IsClsInst NakedScFlag
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the superclasses of an instance declaration"
pprCtO (ScOrigin (IsQC {}) NakedScFlag
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the head of a quantified constraint"
pprCtO CtOrigin
DerivClauseOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the 'deriving' clause of a data type declaration"
pprCtO CtOrigin
StandAloneDerivOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a 'deriving' declaration"
pprCtO CtOrigin
DefaultOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a 'default' declaration"
pprCtO CtOrigin
DoOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a do statement"
pprCtO CtOrigin
MCompOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a statement in a monad comprehension"
pprCtO CtOrigin
ProcOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a proc expression"
pprCtO CtOrigin
ArrowCmdOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an arrow command"
pprCtO CtOrigin
AnnOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an annotation"
pprCtO (ExprHoleOrigin Maybe RdrName
Nothing) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression hole"
pprCtO (ExprHoleOrigin (Just RdrName
occ)) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
occ)
pprCtO (TypeHoleOrigin OccName
occ) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a use of wildcard" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
pprCtO CtOrigin
PatCheckOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern-match completeness check"
pprCtO CtOrigin
ListOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an overloaded list"
pprCtO CtOrigin
IfThenElseOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an if-then-else expression"
pprCtO CtOrigin
StaticOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a static form"
pprCtO (UsageEnvironmentOf Name
x) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"multiplicity of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
x)]
pprCtO (OmittedFieldOrigin Maybe FieldLabel
Nothing) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an omitted anonymous field"
pprCtO (OmittedFieldOrigin (Just FieldLabel
fl)) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"omitted field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl)]
pprCtO CtOrigin
BracketOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a quotation bracket"
pprCtO (GivenOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a given constraint"
pprCtO (GivenSCOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the superclass of a given constraint"
pprCtO (SpecPragOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE pragma"
pprCtO (FunDepOrigin1 {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a functional dependency"
pprCtO (FunDepOrigin2 {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a functional dependency"
pprCtO (InjTFOrigin1 {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an injective type family"
pprCtO (TypeEqOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type equality"
pprCtO (KindEqOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a kind equality"
pprCtO (DerivOriginDC {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a deriving clause"
pprCtO (DerivOriginCoerce {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a derived method"
pprCtO (DoPatOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a do statement"
pprCtO (MCompPatOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a monad comprehension pattern"
pprCtO (Shouldn'tHappenOrigin String
note) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
note
pprCtO (ProvCtxtOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a provided constraint"
pprCtO (InstProvidedOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a provided constraint"
pprCtO (CycleBreakerOrigin CtOrigin
orig) = HasDebugCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig
pprCtO (FRROrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a representation-polymorphism check"
pprCtO (WantedSuperclassOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a superclass constraint"
pprCtO (InstanceSigOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type signature in an instance"
pprCtO (AmbiguityCheckOrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type ambiguity check"
pprCtO (ImpedanceMatching {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"combining required constraints"
pprCtO (NonLinearPatternOrigin NonLinearPatternReason
_ LPat GhcRn
pat) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a non-linear pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat)]
pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc
pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc
pprNonLinearPatternReason NonLinearPatternReason
LazyPatternReason = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"non-variable lazy pattern aren't linear")
pprNonLinearPatternReason NonLinearPatternReason
GeneralisedPatternReason = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"non-variable pattern bindings that have been generalised aren't linear")
pprNonLinearPatternReason NonLinearPatternReason
PatternSynonymReason = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern synonyms aren't linear")
pprNonLinearPatternReason NonLinearPatternReason
ViewPatternReason = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"view patterns aren't linear")
pprNonLinearPatternReason NonLinearPatternReason
OtherPatternReason = SDoc
forall doc. IsOutput doc => doc
empty
isPushCallStackOrigin :: CtOrigin -> Bool
isPushCallStackOrigin :: CtOrigin -> Bool
isPushCallStackOrigin (IPOccOrigin {}) = Bool
False
isPushCallStackOrigin CtOrigin
_ = Bool
True
callStackOriginFS :: CtOrigin -> FastString
callStackOriginFS :: CtOrigin -> FastString
callStackOriginFS (OccurrenceOf Name
fun) = OccName -> FastString
occNameFS (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
fun)
callStackOriginFS CtOrigin
orig = String -> FastString
mkFastString (SDoc -> String
showSDocUnsafe (HasDebugCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig))
data FixedRuntimeRepOrigin
= FixedRuntimeRepOrigin
{ FixedRuntimeRepOrigin -> TcType
frr_type :: Type
, FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context :: FixedRuntimeRepContext
}
instance Outputable FixedRuntimeRepOrigin where
ppr :: FixedRuntimeRepOrigin -> SDoc
ppr (FixedRuntimeRepOrigin { frr_type :: FixedRuntimeRepOrigin -> TcType
frr_type = TcType
ty, frr_context :: FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context = FixedRuntimeRepContext
cxt })
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"FrOrigin" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"frr_type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"frr_context:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FixedRuntimeRepContext -> SDoc
forall a. Outputable a => a -> SDoc
ppr FixedRuntimeRepContext
cxt ])
data FixedRuntimeRepContext
= FRRRecordCon !RdrName !(HsExpr GhcTc)
| FRRRecordUpdate !Name !(HsExpr GhcRn)
| FRRBinder !Name
| FRRRepPolyId
!Name
!RepPolyId
!(Position Neg)
| FRRRepPolyUnliftedNewtype !DataCon
| FRRPatBind
| FRRPatSynArg
| FRRCase
| FRRDataConPatArg !DataCon !Int
| FRRUnboxedTuple !Int
| FRRUnboxedTupleSection !Int
| FRRUnboxedSum !(Maybe Int)
| FRRBodyStmt !StmtOrigin !Int
| FRRBodyStmtGuard
| FRRBindStmt !StmtOrigin
| FRRBindStmtGuard
| FRRArrow !FRRArrowContext
| FRRExpectedFunTy
!ExpectedFunTyOrigin
!Int
data RepPolyId
= RepPolyPrimOp
| RepPolyTuple
| RepPolySum
| RepPolyFunction
mkFRRUnboxedTuple :: Int -> FixedRuntimeRepContext
mkFRRUnboxedTuple :: ScDepth -> FixedRuntimeRepContext
mkFRRUnboxedTuple = ScDepth -> FixedRuntimeRepContext
FRRUnboxedTuple
mkFRRUnboxedSum :: Maybe Int -> FixedRuntimeRepContext
mkFRRUnboxedSum :: Maybe ScDepth -> FixedRuntimeRepContext
mkFRRUnboxedSum = Maybe ScDepth -> FixedRuntimeRepContext
FRRUnboxedSum
pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext (FRRRecordCon RdrName
lbl HsExpr GhcTc
_arg)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The field", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
lbl)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the record constructor" ]
pprFixedRuntimeRepContext (FRRRecordUpdate Name
lbl HsExpr GhcRn
_arg)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The record update at field"
, SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
lbl) ]
pprFixedRuntimeRepContext (FRRBinder Name
binder)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The binder"
, SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
binder) ]
pprFixedRuntimeRepContext (FRRRepPolyId Name
nm RepPolyId
id Position 'Neg
what)
= RepPolyId -> Name -> Position 'Neg -> SDoc
pprFRRRepPolyId RepPolyId
id Name
nm Position 'Neg
what
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRPatBind
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The pattern binding"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRPatSynArg
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The pattern synonym argument pattern"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRCase
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The scrutinee of the case statement"
pprFixedRuntimeRepContext (FRRDataConPatArg DataCon
con ScDepth
i)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
where
what :: SDoc
what :: SDoc
what
| DataCon -> Bool
isNewDataCon DataCon
con
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newtype constructor pattern"
| Bool
otherwise
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data constructor pattern in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"position"
pprFixedRuntimeRepContext (FRRRepPolyUnliftedNewtype DataCon
dc)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsaturated use of a representation-polymorphic unlifted newtype."
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The argument of the newtype constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc) ]
pprFixedRuntimeRepContext (FRRUnboxedTuple ScDepth
i)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"component of the unboxed tuple"
pprFixedRuntimeRepContext (FRRUnboxedTupleSection ScDepth
i)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"component of the unboxed tuple section"
pprFixedRuntimeRepContext (FRRUnboxedSum Maybe ScDepth
Nothing)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The unboxed sum"
pprFixedRuntimeRepContext (FRRUnboxedSum (Just ScDepth
i))
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"component of the unboxed sum"
pprFixedRuntimeRepContext (FRRBodyStmt StmtOrigin
stmtOrig ScDepth
i)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument to (>>)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising from the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
stmtOrig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma ]
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRBodyStmtGuard
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The argument to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"guard") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising from the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
MonadComprehension SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma ]
pprFixedRuntimeRepContext (FRRBindStmt StmtOrigin
stmtOrig)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The first argument to (>>=)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"arising from the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
stmtOrig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma ]
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRBindStmtGuard
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The body of the bind statement" ]
pprFixedRuntimeRepContext (FRRArrow FRRArrowContext
arrowContext)
= FRRArrowContext -> SDoc
pprFRRArrowContext FRRArrowContext
arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy ExpectedFunTyOrigin
funTyOrig ScDepth
arg_pos)
= ExpectedFunTyOrigin -> ScDepth -> SDoc
pprExpectedFunTyOrigin ExpectedFunTyOrigin
funTyOrig ScDepth
arg_pos
instance Outputable FixedRuntimeRepContext where
ppr :: FixedRuntimeRepContext -> SDoc
ppr = FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext
data StmtOrigin
= MonadComprehension
| DoNotation
instance Outputable StmtOrigin where
ppr :: StmtOrigin -> SDoc
ppr StmtOrigin
MonadComprehension = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"monad comprehension"
ppr StmtOrigin
DoNotation = SDoc -> SDoc
quotes ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"do" ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"statement"
data ArgPos
= ArgPosInvis
| ArgPosVis !Int
data Polarity = Pos | Neg
type FlipPolarity :: Polarity -> Polarity
type family FlipPolarity p where
FlipPolarity Pos = Neg
FlipPolarity Neg = Pos
type Position :: Polarity -> Hs.Type
data Position p where
Argument :: Int -> Position (FlipPolarity p) -> Position p
Result :: Position p -> Position p
Top :: Position Pos
pprFRRRepPolyId :: RepPolyId -> Name -> Position Neg -> SDoc
pprFRRRepPolyId :: RepPolyId -> Name -> Position 'Neg -> SDoc
pprFRRRepPolyId RepPolyId
id Name
nm (Argument ScDepth
i Position (FlipPolarity 'Neg)
pos) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RepPolyId -> Name -> SDoc
pprRepPolyId RepPolyId
id Name
nm
where
what :: SDoc
what = case Position (FlipPolarity 'Neg)
pos of
Position (FlipPolarity 'Neg)
Top -> SDoc
forall doc. IsOutput doc => doc
empty
Result {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"return type of the"
Position (FlipPolarity 'Neg)
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"nested return type inside the"
pprFRRRepPolyId RepPolyId
id Name
nm (Result {}) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The result of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RepPolyId -> Name -> SDoc
pprRepPolyId RepPolyId
id Name
nm
pprRepPolyId :: RepPolyId -> Name -> SDoc
pprRepPolyId :: RepPolyId -> Name -> SDoc
pprRepPolyId RepPolyId
id Name
nm = SDoc
id_desc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm)
where
id_desc :: SDoc
id_desc = case RepPolyId
id of
RepPolyPrimOp {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the primop"
RepPolySum {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the unboxed sum constructor"
RepPolyTuple {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the unboxed tuple constructor"
RepPolyFunction {} -> SDoc
forall doc. IsOutput doc => doc
empty
data FRRArrowContext
= ArrowCmdResTy !(HsCmd GhcRn)
| ArrowCmdApp !(HsCmd GhcRn) !(HsExpr GhcRn)
| ArrowCmdArrApp !(HsExpr GhcRn) !(HsExpr GhcRn) !HsArrAppType
| ArrowCmdCase
| ArrowFun !(HsExpr GhcRn)
pprFRRArrowContext :: FRRArrowContext -> SDoc
pprFRRArrowContext :: FRRArrowContext -> SDoc
pprFRRArrowContext (ArrowCmdResTy HsCmd GhcRn
cmd)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The arrow command") ScDepth
2 (SDoc -> SDoc
quotes (HsCmd GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcRn
cmd)) ]
pprFRRArrowContext (ArrowCmdApp HsCmd GhcRn
fun HsExpr GhcRn
arg)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The argument in the arrow command application of"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc
quotes (HsCmd GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcRn
fun))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
arg)) ]
pprFRRArrowContext (ArrowCmdArrApp HsExpr GhcRn
fun HsExpr GhcRn
arg HsArrAppType
ho_app)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The function in the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsArrAppType -> SDoc
pprHsArrType HsArrAppType
ho_app SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
fun))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
arg)) ]
pprFRRArrowContext FRRArrowContext
ArrowCmdCase
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The scrutinee of the arrow case command"
pprFRRArrowContext (ArrowFun HsExpr GhcRn
fun)
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The return type of the arrow function"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
fun)) ]
instance Outputable FRRArrowContext where
ppr :: FRRArrowContext -> SDoc
ppr = FRRArrowContext -> SDoc
pprFRRArrowContext
data ExpectedFunTyOrigin
= forall (p :: Pass)
. (OutputableBndrId p)
=> ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p))
| ExpectedFunTyViewPat
!(HsExpr GhcRn)
| forall (p :: Pass)
. Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
!TypedThing
!(HsExpr (GhcPass p))
| ExpectedFunTyMatches
!TypedThing
!(MatchGroup GhcRn (LHsExpr GhcRn))
| ExpectedFunTyLam HsLamVariant
!(HsExpr GhcRn)
pprExpectedFunTyOrigin :: ExpectedFunTyOrigin
-> Int
-> SDoc
pprExpectedFunTyOrigin :: ExpectedFunTyOrigin -> ScDepth -> SDoc
pprExpectedFunTyOrigin ExpectedFunTyOrigin
funTy_origin ScDepth
i =
case ExpectedFunTyOrigin
funTy_origin of
ExpectedFunTySyntaxOp CtOrigin
orig HsExpr (GhcPass p)
op ->
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
the_arg_of
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the rebindable syntax operator"
, SDoc -> SDoc
quotes (HsExpr (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass p)
op) ]
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (CtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr CtOrigin
orig) ]
ExpectedFunTyViewPat HsExpr GhcRn
expr ->
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
the_arg_of SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the view pattern"
, ScDepth -> SDoc -> SDoc
nest ScDepth
2 (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr) ]
ExpectedFunTyArg TypedThing
fun HsExpr (GhcPass p)
arg ->
[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The argument"
, SDoc -> SDoc
quotes (HsExpr (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass p)
arg)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of"
, SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun) ]
ExpectedFunTyMatches TypedThing
fun (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnLW
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts })
| [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
-> SDoc
the_arg_of SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
| Bool
otherwise
-> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern in the equation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
plural [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
ExpectedFunTyLam HsLamVariant
lam_variant HsExpr GhcRn
_ -> SDoc -> SDoc
binder_of (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
lam_variant
where
the_arg_of :: SDoc
the_arg_of :: SDoc
the_arg_of = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ScDepth -> SDoc
speakNth ScDepth
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument of"
binder_of :: SDoc -> SDoc
binder_of :: SDoc -> SDoc
binder_of SDoc
what = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The binder of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expression"
pprExpectedFunTyHerald :: ExpectedFunTyOrigin -> SDoc
pprExpectedFunTyHerald :: ExpectedFunTyOrigin -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This rebindable syntax expects a function with"
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A view pattern expression expects"
pprExpectedFunTyHerald (ExpectedFunTyArg TypedThing
fun HsExpr (GhcPass p)
_)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The function" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is applied to" ]
pprExpectedFunTyHerald (ExpectedFunTyMatches TypedThing
fun (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnLW
_ [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts }))
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The equation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
plural [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
hasOrHave [GenLocated
SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
pprExpectedFunTyHerald (ExpectedFunTyLam HsLamVariant
lam_variant HsExpr GhcRn
expr)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsLamVariant -> SDoc
lamCaseKeyword HsLamVariant
lam_variant SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expression"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Depth -> SDoc -> SDoc
pprSetDepth (ScDepth -> Depth
PartWay ScDepth
1) (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr))
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" ]
type SafeOverlapping = Bool
data InstanceWhat
= BuiltinEqInstance
| BuiltinTypeableInstance TyCon
| BuiltinInstance
| LocalInstance
| TopLevInstance
{ InstanceWhat -> Id
iw_dfun_id :: DFunId
, InstanceWhat -> Bool
iw_safe_over :: SafeOverlapping
, InstanceWhat -> Maybe (WarningTxt GhcRn)
iw_warn :: Maybe (WarningTxt GhcRn) }
instance Outputable InstanceWhat where
ppr :: InstanceWhat -> SDoc
ppr InstanceWhat
BuiltinInstance = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a built-in instance"
ppr BuiltinTypeableInstance {} = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a built-in typeable instance"
ppr InstanceWhat
BuiltinEqInstance = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a built-in equality instance"
ppr InstanceWhat
LocalInstance = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a locally-quantified instance"
ppr (TopLevInstance { iw_dfun_id :: InstanceWhat -> Id
iw_dfun_id = Id
dfun })
= SDoc -> ScDepth -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcType -> SDoc
pprSigmaType (Id -> TcType
idType Id
dfun))
ScDepth
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"--" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
pprDefinedAt (Id -> Name
idName Id
dfun))