{-# LANGUAGE CPP #-}
module TcOrigin (
UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,
SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
isVisibleOrigin, toInvisibleOrigin,
pprCtOrigin, isGivenOrigin
) where
#include "GhclibHsVersions.h"
import GhcPrelude
import TcType
import GHC.Hs
import Id
import DataCon
import ConLike
import TyCon
import InstEnv
import PatSyn
import Module
import Name
import RdrName
import qualified GHC.LanguageExtensions as LangExt
import DynFlags
import SrcLoc
import FastString
import Outputable
import BasicTypes
data UserTypeCtxt
= FunSigCtxt
Name
Bool
| InfSigCtxt Name
| ExprSigCtxt
| KindSigCtxt
| StandaloneKindSigCtxt
Name
| TypeAppCtxt
| ConArgCtxt Name
| TySynCtxt Name
| PatSynCtxt Name
| PatSigCtxt
| RuleSigCtxt Name
| ResSigCtxt
| ForSigCtxt Name
| DefaultDeclCtxt
| InstDeclCtxt Bool
| SpecInstCtxt
| ThBrackCtxt
| GenSigCtxt
| GhciCtxt Bool
| ClassSCCtxt Name
| SigmaCtxt
| DataTyCtxt Name
| DerivClauseCtxt
| TyVarBndrKindCtxt Name
| DataKindCtxt Name
| TySynKindCtxt Name
| TyFamResKindCtxt Name
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt n :: Name
n _) = String -> SDoc
text "the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (InfSigCtxt n :: Name
n) = String -> SDoc
text "the inferred type for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (RuleSigCtxt n :: Name
n) = String -> SDoc
text "a RULE for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt ExprSigCtxt = String -> SDoc
text "an expression type signature"
pprUserTypeCtxt KindSigCtxt = String -> SDoc
text "a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt n :: Name
n) = String -> SDoc
text "a standalone kind signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt TypeAppCtxt = String -> SDoc
text "a type argument"
pprUserTypeCtxt (ConArgCtxt c :: Name
c) = String -> SDoc
text "the type of the constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt (TySynCtxt c :: Name
c) = String -> SDoc
text "the RHS of the type synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt ThBrackCtxt = String -> SDoc
text "a Template Haskell quotation [t|...|]"
pprUserTypeCtxt PatSigCtxt = String -> SDoc
text "a pattern type signature"
pprUserTypeCtxt ResSigCtxt = String -> SDoc
text "a result type signature"
pprUserTypeCtxt (ForSigCtxt n :: Name
n) = String -> SDoc
text "the foreign declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt DefaultDeclCtxt = String -> SDoc
text "a type in a `default' declaration"
pprUserTypeCtxt (InstDeclCtxt False) = String -> SDoc
text "an instance declaration"
pprUserTypeCtxt (InstDeclCtxt True) = String -> SDoc
text "a stand-alone deriving instance declaration"
pprUserTypeCtxt SpecInstCtxt = String -> SDoc
text "a SPECIALISE instance pragma"
pprUserTypeCtxt GenSigCtxt = String -> SDoc
text "a type expected by the context"
pprUserTypeCtxt (GhciCtxt {}) = String -> SDoc
text "a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt c :: Name
c) = String -> SDoc
text "the super-classes of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt SigmaCtxt = String -> SDoc
text "the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt tc :: Name
tc) = String -> SDoc
text "the context of the data type declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc)
pprUserTypeCtxt (PatSynCtxt n :: Name
n) = String -> SDoc
text "the signature for pattern synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (UserTypeCtxt
DerivClauseCtxt) = String -> SDoc
text "a `deriving' clause"
pprUserTypeCtxt (TyVarBndrKindCtxt n :: Name
n) = String -> SDoc
text "the kind annotation on the type variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (DataKindCtxt n :: Name
n) = String -> SDoc
text "the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TySynKindCtxt n :: Name
n) = String -> SDoc
text "the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TyFamResKindCtxt n :: Name
n) = String -> SDoc
text "the result kind for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt n :: Name
n _) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ConArgCtxt n :: Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ForSigCtxt n :: Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (PatSynCtxt n :: Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe _ = Maybe Name
forall a. Maybe a
Nothing
data SkolemInfo
= SigSkol
UserTypeCtxt
TcType
[(Name,TcTyVar)]
| SigTypeSkol UserTypeCtxt
| ForAllSkol SDoc
| DerivSkol Type
| InstSkol
| InstSC TypeSize
| FamInstSkol
| PatSkol
ConLike
(HsMatchContext Name)
| ArrowSkol
| IPSkol [HsIPName]
| RuleSkol RuleName
| InferSkol [(Name,TcType)]
| BracketSkol
| UnifyForAllSkol
TcType
| TyConSkol TyConFlavour Name
| DataConSkol Name
| ReifySkol
| QuantCtxtSkol
| UnkSkol
instance Outputable SkolemInfo where
ppr :: SkolemInfo -> SDoc
ppr = SkolemInfo -> SDoc
pprSkolInfo
pprSkolInfo :: SkolemInfo -> SDoc
pprSkolInfo :: SkolemInfo -> SDoc
pprSkolInfo (SigSkol cx :: UserTypeCtxt
cx ty :: TcType
ty _) = UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
cx TcType
ty
pprSkolInfo (SigTypeSkol cx :: UserTypeCtxt
cx) = UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
cx
pprSkolInfo (ForAllSkol doc :: SDoc
doc) = SDoc -> SDoc
quotes SDoc
doc
pprSkolInfo (IPSkol ips :: [HsIPName]
ips) = String -> SDoc
text "the implicit-parameter binding" SDoc -> SDoc -> SDoc
<> [HsIPName] -> SDoc
forall a. [a] -> SDoc
plural [HsIPName]
ips SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "for"
SDoc -> SDoc -> SDoc
<+> (HsIPName -> SDoc) -> [HsIPName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsIPName]
ips
pprSkolInfo (DerivSkol pred :: TcType
pred) = String -> SDoc
text "the deriving clause for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred)
pprSkolInfo InstSkol = String -> SDoc
text "the instance declaration"
pprSkolInfo (InstSC n :: TypeSize
n) = String -> SDoc
text "the instance declaration" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (SDoc -> SDoc
parens (TypeSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeSize
n))
pprSkolInfo FamInstSkol = String -> SDoc
text "a family instance declaration"
pprSkolInfo BracketSkol = String -> SDoc
text "a Template Haskell bracket"
pprSkolInfo (RuleSkol name :: RuleName
name) = String -> SDoc
text "the RULE" SDoc -> SDoc -> SDoc
<+> RuleName -> SDoc
pprRuleName RuleName
name
pprSkolInfo ArrowSkol = String -> SDoc
text "an arrow form"
pprSkolInfo (PatSkol cl :: ConLike
cl mc :: HsMatchContext Name
mc) = [SDoc] -> SDoc
sep [ ConLike -> SDoc
pprPatSkolInfo ConLike
cl
, String -> SDoc
text "in" SDoc -> SDoc -> SDoc
<+> HsMatchContext Name -> SDoc
forall id.
(Outputable (NameOrRdrName id), Outputable id) =>
HsMatchContext id -> SDoc
pprMatchContext HsMatchContext Name
mc ]
pprSkolInfo (InferSkol ids :: [(Name, TcType)]
ids) = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text "the inferred type" SDoc -> SDoc -> SDoc
<> [(Name, TcType)] -> SDoc
forall a. [a] -> SDoc
plural [(Name, TcType)]
ids SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "of")
2 ([SDoc] -> SDoc
vcat [ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
| (name :: Name
name,ty :: TcType
ty) <- [(Name, TcType)]
ids ])
pprSkolInfo (UnifyForAllSkol ty :: TcType
ty) = String -> SDoc
text "the type" SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
pprSkolInfo (TyConSkol flav :: TyConFlavour
flav name :: Name
name) = String -> SDoc
text "the" SDoc -> SDoc -> SDoc
<+> TyConFlavour -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
flav SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo (DataConSkol name :: Name
name)= String -> SDoc
text "the data constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo ReifySkol = String -> SDoc
text "the type being reified"
pprSkolInfo (QuantCtxtSkol {}) = String -> SDoc
text "a quantified context"
pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo ctxt :: UserTypeCtxt
ctxt ty :: TcType
ty
= case UserTypeCtxt
ctxt of
FunSigCtxt f :: Name
f _ -> [SDoc] -> SDoc
vcat [ String -> SDoc
text "the type signature for:"
, Int -> SDoc -> SDoc
nest 2 (Name -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc Name
f SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
PatSynCtxt {} -> UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt
_ -> [SDoc] -> SDoc
vcat [ UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt SDoc -> SDoc -> SDoc
<> SDoc
colon
, Int -> SDoc -> SDoc
nest 2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo (RealDataCon dc :: DataCon
dc)
= [SDoc] -> SDoc
sep [ String -> SDoc
text "a pattern with constructor:"
, Int -> SDoc -> SDoc
nest 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
<+> SDoc
dcolon
SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
pprType (DataCon -> TcType
dataConUserType DataCon
dc) SDoc -> SDoc -> SDoc
<> SDoc
comma ]
pprPatSkolInfo (PatSynCon ps :: PatSyn
ps)
= [SDoc] -> SDoc
sep [ String -> SDoc
text "a pattern with pattern synonym:"
, Int -> SDoc -> SDoc
nest 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
<+> SDoc
dcolon
SDoc -> SDoc -> SDoc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
ps SDoc -> SDoc -> SDoc
<> SDoc
comma ]
data CtOrigin
= GivenOrigin SkolemInfo
| OccurrenceOf Name
| OccurrenceOfRecSel RdrName
| AppOrigin
| SpecPragOrigin UserTypeCtxt
| TypeEqOrigin { CtOrigin -> TcType
uo_actual :: TcType
, CtOrigin -> TcType
uo_expected :: TcType
, CtOrigin -> Maybe SDoc
uo_thing :: Maybe SDoc
, CtOrigin -> Bool
uo_visible :: Bool
}
| KindEqOrigin
TcType (Maybe TcType)
CtOrigin
(Maybe TypeOrKind)
| IPOccOrigin HsIPName
| OverLabelOrigin FastString
| LiteralOrigin (HsOverLit GhcRn)
| NegateOrigin
| ArithSeqOrigin (ArithSeqInfo GhcRn)
| AssocFamPatOrigin
| SectionOrigin
| TupleOrigin
| ExprSigOrigin
| PatSigOrigin
| PatOrigin
| ProvCtxtOrigin
(PatSynBind GhcRn GhcRn)
| RecordUpdOrigin
| ViewPatOrigin
| ScOrigin TypeSize
| DerivClauseOrigin
| DerivOriginDC DataCon Int Bool
| DerivOriginCoerce Id Type Type Bool
| StandAloneDerivOrigin
| DefaultOrigin
| DoOrigin
| DoPatOrigin (LPat GhcRn)
| MCompOrigin
| MCompPatOrigin (LPat GhcRn)
| IfOrigin
| ProcOrigin
| AnnOrigin
| FunDepOrigin1
PredType CtOrigin RealSrcSpan
PredType CtOrigin RealSrcSpan
| FunDepOrigin2
PredType CtOrigin
PredType SrcSpan
| HoleOrigin
| UnboundOccurrenceOf OccName
| ListOrigin
| StaticOrigin
| FailablePattern (LPat GhcTcId)
| Shouldn'tHappenOrigin String
| InstProvidedOrigin Module ClsInst
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin (TypeEqOrigin { uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis }) = Bool
vis
isVisibleOrigin (KindEqOrigin _ _ sub_orig :: CtOrigin
sub_orig _) = CtOrigin -> Bool
isVisibleOrigin CtOrigin
sub_orig
isVisibleOrigin _ = Bool
True
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin orig :: CtOrigin
orig@(TypeEqOrigin {}) = CtOrigin
orig { uo_visible :: Bool
uo_visible = Bool
False }
toInvisibleOrigin orig :: CtOrigin
orig = CtOrigin
orig
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin (GivenOrigin {}) = Bool
True
isGivenOrigin (FunDepOrigin1 _ o1 :: CtOrigin
o1 _ _ o2 :: CtOrigin
o2 _) = CtOrigin -> Bool
isGivenOrigin CtOrigin
o1 Bool -> Bool -> Bool
&& CtOrigin -> Bool
isGivenOrigin CtOrigin
o2
isGivenOrigin (FunDepOrigin2 _ o1 :: CtOrigin
o1 _ _) = CtOrigin -> Bool
isGivenOrigin CtOrigin
o1
isGivenOrigin _ = Bool
False
instance Outputable CtOrigin where
ppr :: CtOrigin -> SDoc
ppr = CtOrigin -> SDoc
pprCtOrigin
ctoHerald :: SDoc
ctoHerald :: SDoc
ctoHerald = String -> SDoc
text "arising from"
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin (L _ e :: HsExpr GhcRn
e) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar _ (L _ name :: IdP GhcRn
name)) = Name -> CtOrigin
OccurrenceOf Name
IdP GhcRn
name
exprCtOrigin (HsUnboundVar _ uv :: UnboundVar
uv) = OccName -> CtOrigin
UnboundOccurrenceOf (UnboundVar -> OccName
unboundVarOcc UnboundVar
uv)
exprCtOrigin (HsConLikeOut {}) = String -> CtOrigin
forall a. String -> a
panic "exprCtOrigin HsConLikeOut"
exprCtOrigin (HsRecFld _ f :: AmbiguousFieldOcc GhcRn
f) = RdrName -> CtOrigin
OccurrenceOfRecSel (AmbiguousFieldOcc GhcRn -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc AmbiguousFieldOcc GhcRn
f)
exprCtOrigin (HsOverLabel _ _ l :: RuleName
l) = RuleName -> CtOrigin
OverLabelOrigin RuleName
l
exprCtOrigin (HsIPVar _ ip :: HsIPName
ip) = HsIPName -> CtOrigin
IPOccOrigin HsIPName
ip
exprCtOrigin (HsOverLit _ lit :: HsOverLit GhcRn
lit) = HsOverLit GhcRn -> CtOrigin
LiteralOrigin HsOverLit GhcRn
lit
exprCtOrigin (HsLit {}) = String -> CtOrigin
Shouldn'tHappenOrigin "concrete literal"
exprCtOrigin (HsLam _ matches :: MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsLamCase _ ms :: MatchGroup GhcRn (LHsExpr GhcRn)
ms) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
ms
exprCtOrigin (HsApp _ e1 :: LHsExpr GhcRn
e1 _) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (HsAppType _ e1 :: LHsExpr GhcRn
e1 _) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (OpApp _ _ op :: LHsExpr GhcRn
op _) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
op
exprCtOrigin (NegApp _ e :: LHsExpr GhcRn
e _) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsPar _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (SectionL _ _ _) = CtOrigin
SectionOrigin
exprCtOrigin (SectionR _ _ _) = CtOrigin
SectionOrigin
exprCtOrigin (ExplicitTuple {}) = String -> CtOrigin
Shouldn'tHappenOrigin "explicit tuple"
exprCtOrigin ExplicitSum{} = String -> CtOrigin
Shouldn'tHappenOrigin "explicit sum"
exprCtOrigin (HsCase _ _ matches :: MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsIf _ (Just syn :: SyntaxExpr GhcRn
syn) _ _ _) = HsExpr GhcRn -> CtOrigin
exprCtOrigin (SyntaxExpr GhcRn -> HsExpr GhcRn
forall p. SyntaxExpr p -> HsExpr p
syn_expr SyntaxExpr GhcRn
syn)
exprCtOrigin (HsIf {}) = String -> CtOrigin
Shouldn'tHappenOrigin "if expression"
exprCtOrigin (HsMultiIf _ rhs :: [LGRHS GhcRn (LHsExpr GhcRn)]
rhs) = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
rhs
exprCtOrigin (HsLet _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsDo {}) = CtOrigin
DoOrigin
exprCtOrigin (ExplicitList {}) = String -> CtOrigin
Shouldn'tHappenOrigin "list"
exprCtOrigin (RecordCon {}) = String -> CtOrigin
Shouldn'tHappenOrigin "record construction"
exprCtOrigin (RecordUpd {}) = String -> CtOrigin
Shouldn'tHappenOrigin "record update"
exprCtOrigin (ExprWithTySig {}) = CtOrigin
ExprSigOrigin
exprCtOrigin (ArithSeq {}) = String -> CtOrigin
Shouldn'tHappenOrigin "arithmetic sequence"
exprCtOrigin (HsSCC _ _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsCoreAnn _ _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsBracket {}) = String -> CtOrigin
Shouldn'tHappenOrigin "TH bracket"
exprCtOrigin (HsRnBracketOut {})= String -> CtOrigin
Shouldn'tHappenOrigin "HsRnBracketOut"
exprCtOrigin (HsTcBracketOut {})= String -> CtOrigin
forall a. String -> a
panic "exprCtOrigin HsTcBracketOut"
exprCtOrigin (HsSpliceE {}) = String -> CtOrigin
Shouldn'tHappenOrigin "TH splice"
exprCtOrigin (HsProc {}) = String -> CtOrigin
Shouldn'tHappenOrigin "proc"
exprCtOrigin (HsStatic {}) = String -> CtOrigin
Shouldn'tHappenOrigin "static expression"
exprCtOrigin (HsTick _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsBinTick _ _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsTickPragma _ _ _ _ e :: LHsExpr GhcRn
e) = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsWrap {}) = String -> CtOrigin
forall a. String -> a
panic "exprCtOrigin HsWrap"
exprCtOrigin (XExpr nec :: XXExpr GhcRn
nec) = NoExtCon -> CtOrigin
forall a. NoExtCon -> a
noExtCon XXExpr GhcRn
NoExtCon
nec
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = Located [LMatch GhcRn (LHsExpr GhcRn)]
alts })
| L _ [L _ match :: Match GhcRn (LHsExpr GhcRn)
match] <- Located [LMatch GhcRn (LHsExpr GhcRn)]
alts
, Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (LHsExpr GhcRn)
grhss } <- Match GhcRn (LHsExpr GhcRn)
match
= GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin GRHSs GhcRn (LHsExpr GhcRn)
grhss
| Bool
otherwise
= String -> CtOrigin
Shouldn'tHappenOrigin "multi-way match"
matchesCtOrigin (XMatchGroup nec :: XXMatchGroup GhcRn (LHsExpr GhcRn)
nec) = NoExtCon -> CtOrigin
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcRn (LHsExpr GhcRn)
NoExtCon
nec
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
grhssCtOrigin (XGRHSs nec :: XXGRHSs GhcRn (LHsExpr GhcRn)
nec) = NoExtCon -> CtOrigin
forall a. NoExtCon -> a
noExtCon XXGRHSs GhcRn (LHsExpr GhcRn)
NoExtCon
nec
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [L _ (GRHS _ _ (L _ e :: HsExpr GhcRn
e))] = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
lGRHSCtOrigin [L _ (XGRHS nec :: XXGRHS GhcRn (LHsExpr GhcRn)
nec)] = NoExtCon -> CtOrigin
forall a. NoExtCon -> a
noExtCon XXGRHS GhcRn (LHsExpr GhcRn)
NoExtCon
nec
lGRHSCtOrigin _ = String -> CtOrigin
Shouldn'tHappenOrigin "multi-way GRHS"
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin sk :: SkolemInfo
sk) = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfo
sk
pprCtOrigin (SpecPragOrigin ctxt :: UserTypeCtxt
ctxt)
= case UserTypeCtxt
ctxt of
FunSigCtxt n :: Name
n _ -> String -> SDoc
text "for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
SpecInstCtxt -> String -> SDoc
text "a SPECIALISE INSTANCE pragma"
_ -> String -> SDoc
text "a SPECIALISE pragma"
pprCtOrigin (FunDepOrigin1 pred1 :: TcType
pred1 orig1 :: CtOrigin
orig1 loc1 :: RealSrcSpan
loc1 pred2 :: TcType
pred2 orig2 :: CtOrigin
orig2 loc2 :: RealSrcSpan
loc2)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "a functional dependency between constraints:")
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) 2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
, SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) 2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])
pprCtOrigin (FunDepOrigin2 pred1 :: TcType
pred1 orig1 :: CtOrigin
orig1 pred2 :: TcType
pred2 loc2 :: SrcSpan
loc2)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "a functional dependency between:")
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text "constraint" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1))
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 )
, SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text "instance" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2))
2 (String -> SDoc
text "at" SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc2) ])
pprCtOrigin (KindEqOrigin t1 :: TcType
t1 (Just t2 :: TcType
t2) _ _)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "a kind equality arising from")
2 ([SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char '~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])
pprCtOrigin AssocFamPatOrigin
= String -> SDoc
text "when matching a family LHS with its class instance head"
pprCtOrigin (KindEqOrigin t1 :: TcType
t1 Nothing _ _)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "a kind equality when matching")
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1)
pprCtOrigin (UnboundOccurrenceOf name :: OccName
name)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "an undeclared identifier" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name)
pprCtOrigin (DerivOriginDC dc :: DataCon
dc n :: Int
n _)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "the" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
n
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "field of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc))
2 (SDoc -> SDoc
parens (String -> SDoc
text "type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty)))
where
ty :: TcType
ty = DataCon -> [TcType]
dataConOrigArgTys DataCon
dc [TcType] -> Int -> TcType
forall a. [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
pprCtOrigin (DerivOriginCoerce meth :: Id
meth ty1 :: TcType
ty1 ty2 :: TcType
ty2 _)
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "the coercion of the method" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
meth))
2 ([SDoc] -> SDoc
sep [ String -> SDoc
text "from type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty1)
, Int -> SDoc -> SDoc
nest 2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "to type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty2) ])
pprCtOrigin (DoPatOrigin pat :: LPat GhcRn
pat)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "a do statement"
SDoc -> SDoc -> SDoc
$$
String -> SDoc
text "with the failable pattern" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Located (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat GhcRn)
LPat GhcRn
pat)
pprCtOrigin (MCompPatOrigin pat :: LPat GhcRn
pat)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [ String -> SDoc
text "the failable pattern"
, SDoc -> SDoc
quotes (Located (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat GhcRn)
LPat GhcRn
pat)
, String -> SDoc
text "in a statement in a monad comprehension" ]
pprCtOrigin (FailablePattern pat :: LPat GhcTcId
pat)
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "the failable pattern" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Located (Pat GhcTcId) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat GhcTcId)
LPat GhcTcId
pat)
SDoc -> SDoc -> SDoc
$$
String -> SDoc
text "(this will become an error in a future GHC release)"
pprCtOrigin (Shouldn'tHappenOrigin note :: String
note)
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
if Extension -> DynFlags -> Bool
xopt Extension
LangExt.ImpredicativeTypes DynFlags
dflags
then String -> SDoc
text "a situation created by impredicative types"
else
[SDoc] -> SDoc
vcat [ String -> SDoc
text "<< This should not appear in error messages. If you see this"
, String -> SDoc
text "in an error message, please report a bug mentioning" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
note) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "at"
, String -> SDoc
text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ]
pprCtOrigin (ProvCtxtOrigin PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id = (L _ name :: IdP GhcRn
name) })
= SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "the \"provided\" constraints claimed by")
2 (String -> SDoc
text "the signature of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
IdP GhcRn
name))
pprCtOrigin (InstProvidedOrigin mod :: Module
mod cls_inst :: ClsInst
cls_inst)
= [SDoc] -> SDoc
vcat [ String -> SDoc
text "arising when attempting to show that"
, ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClsInst
cls_inst
, String -> SDoc
text "is provided by" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)]
pprCtOrigin simple_origin :: CtOrigin
simple_origin
= SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> CtOrigin -> SDoc
pprCtO CtOrigin
simple_origin
pprCtO :: CtOrigin -> SDoc
pprCtO :: CtOrigin -> SDoc
pprCtO (OccurrenceOf name :: Name
name) = [SDoc] -> SDoc
hsep [String -> SDoc
text "a use of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)]
pprCtO (OccurrenceOfRecSel name :: RdrName
name) = [SDoc] -> SDoc
hsep [String -> SDoc
text "a use of", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]
pprCtO AppOrigin = String -> SDoc
text "an application"
pprCtO (IPOccOrigin name :: HsIPName
name) = [SDoc] -> SDoc
hsep [String -> SDoc
text "a use of implicit parameter", SDoc -> SDoc
quotes (HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
name)]
pprCtO (OverLabelOrigin l :: RuleName
l) = [SDoc] -> SDoc
hsep [String -> SDoc
text "the overloaded label"
,SDoc -> SDoc
quotes (Char -> SDoc
char '#' SDoc -> SDoc -> SDoc
<> RuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RuleName
l)]
pprCtO RecordUpdOrigin = String -> SDoc
text "a record update"
pprCtO ExprSigOrigin = String -> SDoc
text "an expression type signature"
pprCtO PatSigOrigin = String -> SDoc
text "a pattern type signature"
pprCtO PatOrigin = String -> SDoc
text "a pattern"
pprCtO ViewPatOrigin = String -> SDoc
text "a view pattern"
pprCtO IfOrigin = String -> SDoc
text "an if expression"
pprCtO (LiteralOrigin lit :: HsOverLit GhcRn
lit) = [SDoc] -> SDoc
hsep [String -> SDoc
text "the literal", SDoc -> SDoc
quotes (HsOverLit GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcRn
lit)]
pprCtO (ArithSeqOrigin seq :: ArithSeqInfo GhcRn
seq) = [SDoc] -> SDoc
hsep [String -> SDoc
text "the arithmetic sequence", SDoc -> SDoc
quotes (ArithSeqInfo GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArithSeqInfo GhcRn
seq)]
pprCtO SectionOrigin = String -> SDoc
text "an operator section"
pprCtO AssocFamPatOrigin = String -> SDoc
text "the LHS of a famly instance"
pprCtO TupleOrigin = String -> SDoc
text "a tuple"
pprCtO NegateOrigin = String -> SDoc
text "a use of syntactic negation"
pprCtO (ScOrigin n :: TypeSize
n) = String -> SDoc
text "the superclasses of an instance declaration"
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (SDoc -> SDoc
parens (TypeSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeSize
n))
pprCtO DerivClauseOrigin = String -> SDoc
text "the 'deriving' clause of a data type declaration"
pprCtO StandAloneDerivOrigin = String -> SDoc
text "a 'deriving' declaration"
pprCtO DefaultOrigin = String -> SDoc
text "a 'default' declaration"
pprCtO DoOrigin = String -> SDoc
text "a do statement"
pprCtO MCompOrigin = String -> SDoc
text "a statement in a monad comprehension"
pprCtO ProcOrigin = String -> SDoc
text "a proc expression"
pprCtO (TypeEqOrigin t1 :: TcType
t1 t2 :: TcType
t2 _ _)= String -> SDoc
text "a type equality" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char '~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2]
pprCtO AnnOrigin = String -> SDoc
text "an annotation"
pprCtO HoleOrigin = String -> SDoc
text "a use of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text "_")
pprCtO ListOrigin = String -> SDoc
text "an overloaded list"
pprCtO StaticOrigin = String -> SDoc
text "a static form"
pprCtO _ = String -> SDoc
forall a. String -> a
panic "pprCtOrigin"