{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
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,
TypedThing(..), TyVarBndrs(..),
isPushCallStackOrigin, callStackOriginFS,
FixedRuntimeRepOrigin(..), FixedRuntimeRepContext(..),
pprFixedRuntimeRepContext,
StmtOrigin(..), RepPolyFun(..), ArgPos(..),
ClsInstOrQC(..), NakedScFlag(..),
FRRArrowContext(..), pprFRRArrowContext,
ExpectedFunTyOrigin(..), pprExpectedFunTyOrigin, pprExpectedFunTyHerald,
) 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.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.Types.Unique
import GHC.Types.Unique.Supply
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
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 type in 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
(HsMatchContext GhcTc)
| IPSkol [HsIPName]
| RuleSkol RuleName
| InferSkol [(Name,TcType)]
| BracketSkol
| UnifyForAllSkol
TcType
| TyConSkol TyConFlavour Name
| DataConSkol Name
| ReifySkol
| RuntimeUnkSkol
| ArrowReboundIfSkol
| UnkSkol CallStack
unkSkol :: HasCallStack => SkolemInfo
unkSkol :: HasCallStack => SkolemInfo
unkSkol = Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo (ScDepth -> Unique
mkUniqueGrimily ScDepth
0) SkolemInfoAnon
HasCallStack => SkolemInfoAnon
unkSkolAnon
unkSkolAnon :: HasCallStack => SkolemInfoAnon
unkSkolAnon :: HasCallStack => 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
Unique
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
uniqFromMask Char
's'
SkolemInfo -> m SkolemInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo Unique
u SkolemInfoAnon
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 HsMatchContext GhcTc
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 GhcTc -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContext HsMatchContext GhcTc
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
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 -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
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)
| 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 (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
| HasFieldOrigin 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
| Shouldn'tHappenOrigin String
| GhcBug20076
| InstProvidedOrigin
Module
ClsInst
| NonLinearPatternOrigin
| UsageEnvironmentOf Name
| CycleBreakerOrigin
CtOrigin
| FRROrigin
FixedRuntimeRepOrigin
| WantedSuperclassOrigin PredType CtOrigin
| InstanceSigOrigin
Name
Type
Type
| AmbiguityCheckOrigin UserTypeCtxt
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 SrcAnn NoEpAnns
_ DotFieldOcc GhcRn
f)) = FastString -> CtOrigin
HasFieldOrigin (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 (HsRecSel XRecSel GhcRn
_ FieldOcc GhcRn
f) = RdrName -> CtOrigin
OccurrenceOfRecSel (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcRn -> XRec GhcRn RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel FieldOcc GhcRn
f)
exprCtOrigin (HsOverLabel XOverLabel GhcRn
_ SourceText
_ 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
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsLamCase XLamCase GhcRn
_ LamCaseVariant
_ 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 LHsToken "@" GhcRn
_ 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
_ LHsToken "(" GhcRn
_ LHsExpr GhcRn
e LHsToken ")" GhcRn
_) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsProjection XProjection GhcRn
_ NonEmpty (XRec GhcRn (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
_ LHsToken "let" GhcRn
_ HsLocalBinds GhcRn
_ LHsToken "in" 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 (XExpr (HsExpanded HsExpr GhcRn
a HsExpr GhcRn
_)) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
a
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 SrcSpanAnnL
_ [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 SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [GuardLStmt 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 CtOrigin
GhcBug20076
= [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC Bug #20076 <https://gitlab.haskell.org/ghc/ghc/-/issues/20076>"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Assuming you have a partial type signature, you can avoid this error"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"by either adding an extra-constraints wildcard (like `(..., _) => ...`,"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with the underscore at the end of the constraint), or by avoiding the"
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"use of a simplifiable constraint in your partial type signature." ]
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 (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 CtOrigin
simple_origin
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
simple_origin
pprCtO :: HasCallStack => CtOrigin -> SDoc
pprCtO :: HasCallStack => 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 (HasFieldOrigin 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 CtOrigin
NonLinearPatternOrigin = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a non-linear pattern"
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 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) = HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig
pprCtO (FRROrigin {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a representation-polymorphism check"
pprCtO CtOrigin
GhcBug20076 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC Bug #20076"
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"
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 (HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig))
data FixedRuntimeRepOrigin
= FixedRuntimeRepOrigin
{ FixedRuntimeRepOrigin -> TcType
frr_type :: Type
, FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context :: FixedRuntimeRepContext
}
data FixedRuntimeRepContext
= FRRRecordCon !RdrName !(HsExpr GhcTc)
| FRRRecordUpdate !Name !(HsExpr GhcRn)
| FRRBinder !Name
| FRRPatBind
| FRRPatSynArg
| FRRCase
| FRRDataConPatArg !DataCon !Int
| FRRNoBindingResArg !RepPolyFun !ArgPos
| FRRTupleArg !Int
| FRRTupleSection !Int
| FRRUnboxedSum
| FRRBodyStmt !StmtOrigin !Int
| FRRBodyStmtGuard
| FRRBindStmt !StmtOrigin
| FRRBindStmtGuard
| FRRArrow !FRRArrowContext
| FRRExpectedFunTy
!ExpectedFunTyOrigin
!Int
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 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 (FRRNoBindingResArg RepPolyFun
fn ArgPos
arg_pos)
= [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" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what_fun SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
, SDoc
what_arg 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
<+> SDoc -> SDoc
quotes (RepPolyFun -> SDoc
forall a. Outputable a => a -> SDoc
ppr RepPolyFun
fn) ]
where
what_fun, what_arg :: SDoc
what_fun :: SDoc
what_fun = case RepPolyFun
fn of
RepPolyWiredIn {} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"primitive function"
RepPolyDataCon DataCon
dc -> SDoc
what_con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constructor"
where
what_con :: SDoc
what_con :: SDoc
what_con
| DataCon -> Bool
isNewDataCon DataCon
dc
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newtype"
| Bool
otherwise
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data"
what_arg :: SDoc
what_arg = case ArgPos
arg_pos of
ArgPos
ArgPosInvis -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"An invisible"
ArgPosVis 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
pprFixedRuntimeRepContext (FRRTupleArg ScDepth
i)
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The tuple argument 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 (FRRTupleSection 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 tuple section"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRUnboxedSum
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"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 RepPolyFun
= RepPolyWiredIn !Id
| RepPolyDataCon !DataCon
instance Outputable RepPolyFun where
ppr :: RepPolyFun -> SDoc
ppr (RepPolyWiredIn Id
id) = Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id
ppr (RepPolyDataCon DataCon
dc) = DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc
data ArgPos
= ArgPosInvis
| ArgPosVis !Int
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
= ExpectedFunTySyntaxOp
!CtOrigin
!(HsExpr GhcRn)
| ExpectedFunTyViewPat
!(HsExpr GhcRn)
| forall (p :: Pass)
. (OutputableBndrId p)
=> ExpectedFunTyArg
!TypedThing
!(HsExpr (GhcPass p))
| ExpectedFunTyMatches
!TypedThing
!(MatchGroup GhcRn (LHsExpr GhcRn))
| ExpectedFunTyLam
!(MatchGroup GhcRn (LHsExpr GhcRn))
| ExpectedFunTyLamCase
LamCaseVariant
!(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 GhcRn
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 GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
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 SrcSpanAnnL
_ [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 {} -> SDoc -> SDoc
binder_of (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lambda"
ExpectedFunTyLamCase LamCaseVariant
lc_variant HsExpr GhcRn
_ -> SDoc -> SDoc
binder_of (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> SDoc
lamCaseKeyword LamCaseVariant
lc_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 SrcSpanAnnL
_ [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 MatchGroup GhcRn (LHsExpr GhcRn)
match)
= [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The lambda expression" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
SDoc -> SDoc
quotes (Depth -> SDoc -> SDoc
pprSetDepth (ScDepth -> Depth
PartWay ScDepth
1) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
MatchGroup (GhcPass idR) body -> SDoc
pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" ]
pprExpectedFunTyHerald (ExpectedFunTyLamCase LamCaseVariant
_ HsExpr GhcRn
expr)
= [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 (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr)
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"requires" ]