module GHC.Tc.Types.BasicTypes (
TcBinderStack
, TcId
, TcBinder(..)
, TcSigFun
, TcIdSigInfo(..)
, TcSigInfo(..)
, TcPatSynInfo(..)
, TcIdSigInst(..)
, isPartialSig
, hasCompleteSig
, TcTyThing(..)
, IdBindingInfo(..)
, IsGroupClosed(..)
, RhsNames
, ClosedTypeId
, tcTyThingCategory
, tcTyThingTyCon_maybe
, pprTcTyThingCategory
) where
import GHC.Prelude
import GHC.Types.Id
import GHC.Types.Basic
import GHC.Types.Var
import GHC.Types.SrcLoc
import GHC.Types.Name
import GHC.Types.TyThing
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Tc.Types.Origin
import GHC.Tc.Utils.TcType
import GHC.Hs.Extension ( GhcRn )
import Language.Haskell.Syntax.Type ( LHsSigWcType )
import GHC.Tc.Errors.Types.PromotionErr (PromotionErr, peCategory)
import GHC.Core.TyCon ( TyCon, tyConKind )
import GHC.Utils.Outputable
import GHC.Utils.Misc
type TcBinderStack = [TcBinder]
type TcId = Id
data TcBinder
= TcIdBndr
TcId
TopLevelFlag
| TcIdBndr_ExpType
Name
ExpType
TopLevelFlag
| TcTvBndr
Name
TyVar
instance Outputable TcBinder where
ppr :: TcBinder -> SDoc
ppr (TcIdBndr TcId
id TopLevelFlag
top_lvl) = TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (TopLevelFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr TopLevelFlag
top_lvl)
ppr (TcIdBndr_ExpType Name
id ExpType
_ TopLevelFlag
top_lvl) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
id SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (TopLevelFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr TopLevelFlag
top_lvl)
ppr (TcTvBndr Name
name TcId
tv) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
tv
instance HasOccName TcBinder where
occName :: TcBinder -> OccName
occName (TcIdBndr TcId
id TopLevelFlag
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName (TcId -> Name
idName TcId
id)
occName (TcIdBndr_ExpType Name
name ExpType
_ TopLevelFlag
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name
occName (TcTvBndr Name
name TcId
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name
type TcSigFun = Name -> Maybe TcSigInfo
data TcSigInfo = TcIdSig TcIdSigInfo
| TcPatSynSig TcPatSynInfo
data TcIdSigInfo
= CompleteSig
{ TcIdSigInfo -> TcId
sig_bndr :: TcId
, TcIdSigInfo -> UserTypeCtxt
sig_ctxt :: UserTypeCtxt
, TcIdSigInfo -> SrcSpan
sig_loc :: SrcSpan
}
| PartialSig
{ TcIdSigInfo -> Name
psig_name :: Name
, TcIdSigInfo -> LHsSigWcType GhcRn
psig_hs_ty :: LHsSigWcType GhcRn
, sig_ctxt :: UserTypeCtxt
, sig_loc :: SrcSpan
}
data TcIdSigInst
= TISI { TcIdSigInst -> TcIdSigInfo
sig_inst_sig :: TcIdSigInfo
, TcIdSigInst -> [(Name, InvisTVBinder)]
sig_inst_skols :: [(Name, InvisTVBinder)]
, TcIdSigInst -> TcThetaType
sig_inst_theta :: TcThetaType
, TcIdSigInst -> TcSigmaType
sig_inst_tau :: TcSigmaType
, TcIdSigInst -> [(Name, TcId)]
sig_inst_wcs :: [(Name, TcTyVar)]
, TcIdSigInst -> Maybe TcSigmaType
sig_inst_wcx :: Maybe TcType
}
data TcPatSynInfo
= TPSI {
TcPatSynInfo -> Name
patsig_name :: Name,
TcPatSynInfo -> [InvisTVBinder]
patsig_implicit_bndrs :: [InvisTVBinder],
TcPatSynInfo -> [InvisTVBinder]
patsig_univ_bndrs :: [InvisTVBinder],
TcPatSynInfo -> TcThetaType
patsig_req :: TcThetaType,
TcPatSynInfo -> [InvisTVBinder]
patsig_ex_bndrs :: [InvisTVBinder],
TcPatSynInfo -> TcThetaType
patsig_prov :: TcThetaType,
TcPatSynInfo -> TcSigmaType
patsig_body_ty :: TcSigmaType
}
instance Outputable TcSigInfo where
ppr :: TcSigInfo -> SDoc
ppr (TcIdSig TcIdSigInfo
idsi) = TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
idsi
ppr (TcPatSynSig TcPatSynInfo
tpsi) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TcPatSynInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcPatSynInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcPatSynInfo
tpsi
instance Outputable TcIdSigInfo where
ppr :: TcIdSigInfo -> SDoc
ppr (CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
sig_bndr = TcId
bndr })
= TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
bndr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcSigmaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcId -> TcSigmaType
idType TcId
bndr)
ppr (PartialSig { psig_name :: TcIdSigInfo -> Name
psig_name = Name
name, psig_hs_ty :: TcIdSigInfo -> LHsSigWcType GhcRn
psig_hs_ty = LHsSigWcType GhcRn
hs_ty })
= String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[partial signature]" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
<+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hs_ty
instance Outputable TcIdSigInst where
ppr :: TcIdSigInst -> SDoc
ppr (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSigInfo
sig_inst_sig = TcIdSigInfo
sig, sig_inst_skols :: TcIdSigInst -> [(Name, InvisTVBinder)]
sig_inst_skols = [(Name, InvisTVBinder)]
skols
, sig_inst_theta :: TcIdSigInst -> TcThetaType
sig_inst_theta = TcThetaType
theta, sig_inst_tau :: TcIdSigInst -> TcSigmaType
sig_inst_tau = TcSigmaType
tau })
= SDoc -> Int -> SDoc -> SDoc
hang (TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
sig) Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [(Name, InvisTVBinder)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(Name, InvisTVBinder)]
skols, TcThetaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcThetaType
theta SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcSigmaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcSigmaType
tau ])
instance Outputable TcPatSynInfo where
ppr :: TcPatSynInfo -> SDoc
ppr (TPSI{ patsig_name :: TcPatSynInfo -> Name
patsig_name = Name
name}) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
isPartialSig :: TcIdSigInst -> Bool
isPartialSig :: TcIdSigInst -> Bool
isPartialSig (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSigInfo
sig_inst_sig = PartialSig {} }) = Bool
True
isPartialSig TcIdSigInst
_ = Bool
False
hasCompleteSig :: TcSigFun -> Name -> Bool
hasCompleteSig :: TcSigFun -> Name -> Bool
hasCompleteSig TcSigFun
sig_fn Name
name
= case TcSigFun
sig_fn Name
name of
Just (TcIdSig (CompleteSig {})) -> Bool
True
Maybe TcSigInfo
_ -> Bool
False
data TcTyThing
= AGlobal TyThing
| ATcId
{ TcTyThing -> TcId
tct_id :: Id
, TcTyThing -> IdBindingInfo
tct_info :: IdBindingInfo
}
| ATyVar Name TcTyVar
| ATcTyCon TyCon
| APromotionErr PromotionErr
tcTyThingTyCon_maybe :: TcTyThing -> Maybe TyCon
tcTyThingTyCon_maybe :: TcTyThing -> Maybe TyCon
tcTyThingTyCon_maybe (AGlobal (ATyCon TyCon
tc)) = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
tcTyThingTyCon_maybe (ATcTyCon TyCon
tc_tc) = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc_tc
tcTyThingTyCon_maybe TcTyThing
_ = Maybe TyCon
forall a. Maybe a
Nothing
instance Outputable TcTyThing where
ppr :: TcTyThing -> SDoc
ppr (AGlobal TyThing
g) = TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
g
ppr elt :: TcTyThing
elt@(ATcId {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcTyThing -> TcId
tct_id TcTyThing
elt) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
dcolon
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> TcSigmaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcId -> TcSigmaType
varType (TcTyThing -> TcId
tct_id TcTyThing
elt)) 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
<+> IdBindingInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcTyThing -> IdBindingInfo
tct_info TcTyThing
elt))
ppr (ATyVar Name
n TcId
tv) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"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) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
tv
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcSigmaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcId -> TcSigmaType
varType TcId
tv)
ppr (ATcTyCon TyCon
tc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ATcTyCon" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcSigmaType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> TcSigmaType
tyConKind TyCon
tc)
ppr (APromotionErr PromotionErr
err) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"APromotionErr" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PromotionErr -> SDoc
forall a. Outputable a => a -> SDoc
ppr PromotionErr
err
data IdBindingInfo
= NotLetBound
| ClosedLet
| NonClosedLet
RhsNames
ClosedTypeId
data IsGroupClosed
= IsGroupClosed
(NameEnv RhsNames)
ClosedTypeId
type RhsNames = NameSet
type ClosedTypeId = Bool
instance Outputable IdBindingInfo where
ppr :: IdBindingInfo -> SDoc
ppr IdBindingInfo
NotLetBound = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NotLetBound"
ppr IdBindingInfo
ClosedLet = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TopLevelLet"
ppr (NonClosedLet RhsNames
fvs Bool
closed_type) =
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TopLevelLet" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RhsNames -> SDoc
forall a. Outputable a => a -> SDoc
ppr RhsNames
fvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
closed_type
pprTcTyThingCategory :: TcTyThing -> SDoc
pprTcTyThingCategory :: TcTyThing -> SDoc
pprTcTyThingCategory = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (TcTyThing -> String) -> TcTyThing -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
capitalise (String -> String) -> (TcTyThing -> String) -> TcTyThing -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcTyThing -> String
tcTyThingCategory
tcTyThingCategory :: TcTyThing -> String
tcTyThingCategory :: TcTyThing -> String
tcTyThingCategory (AGlobal TyThing
thing) = TyThing -> String
tyThingCategory TyThing
thing
tcTyThingCategory (ATyVar {}) = String
"type variable"
tcTyThingCategory (ATcId {}) = String
"local identifier"
tcTyThingCategory (ATcTyCon {}) = String
"local tycon"
tcTyThingCategory (APromotionErr PromotionErr
pe) = PromotionErr -> String
peCategory PromotionErr
pe