module GHC.Tc.Types.BasicTypes (
TcBinderStack
, TcId
, TcBinder(..)
, TcSigFun, TcSigInfo(..), TcIdSig(..)
, TcCompleteSig(..), TcPartialSig(..), TcPatSynSig(..)
, TcIdSigInst(..)
, isPartialSig, hasCompleteSig
, tcSigInfoName, tcIdSigLoc, completeSigPolyId_maybe
, 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 TcIdSig
| TcPatSynSig TcPatSynSig
data TcIdSig
= TcCompleteSig TcCompleteSig
| TcPartialSig TcPartialSig
data TcCompleteSig
= CSig { TcCompleteSig -> TcId
sig_bndr :: TcId
, TcCompleteSig -> UserTypeCtxt
sig_ctxt :: UserTypeCtxt
, TcCompleteSig -> SrcSpan
sig_loc :: SrcSpan
}
data TcPartialSig
= PSig { TcPartialSig -> Name
psig_name :: Name
, TcPartialSig -> LHsSigWcType GhcRn
psig_hs_ty :: LHsSigWcType GhcRn
, TcPartialSig -> UserTypeCtxt
psig_ctxt :: UserTypeCtxt
, TcPartialSig -> SrcSpan
psig_loc :: SrcSpan
}
data TcPatSynSig
= PatSig {
TcPatSynSig -> Name
patsig_name :: Name,
TcPatSynSig -> [InvisTVBinder]
patsig_implicit_bndrs :: [InvisTVBinder],
TcPatSynSig -> [InvisTVBinder]
patsig_univ_bndrs :: [InvisTVBinder],
TcPatSynSig -> TcThetaType
patsig_req :: TcThetaType,
TcPatSynSig -> [InvisTVBinder]
patsig_ex_bndrs :: [InvisTVBinder],
TcPatSynSig -> TcThetaType
patsig_prov :: TcThetaType,
TcPatSynSig -> TcSigmaType
patsig_body_ty :: TcSigmaType
}
data TcIdSigInst
= TISI { TcIdSigInst -> TcIdSig
sig_inst_sig :: TcIdSig
, 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
}
instance Outputable TcSigInfo where
ppr :: TcSigInfo -> SDoc
ppr (TcIdSig TcIdSig
sig) = TcIdSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSig
sig
ppr (TcPatSynSig TcPatSynSig
sig) = TcPatSynSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcPatSynSig
sig
instance Outputable TcIdSig where
ppr :: TcIdSig -> SDoc
ppr (TcCompleteSig TcCompleteSig
sig) = TcCompleteSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcCompleteSig
sig
ppr (TcPartialSig TcPartialSig
sig) = TcPartialSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcPartialSig
sig
instance Outputable TcCompleteSig where
ppr :: TcCompleteSig -> SDoc
ppr (CSig { sig_bndr :: TcCompleteSig -> 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)
instance Outputable TcPartialSig where
ppr :: TcPartialSig -> SDoc
ppr (PSig { psig_name :: TcPartialSig -> Name
psig_name = Name
name, psig_hs_ty :: TcPartialSig -> 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 TcPatSynSig where
ppr :: TcPatSynSig -> SDoc
ppr (PatSig { patsig_name :: TcPatSynSig -> Name
patsig_name = Name
name}) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
instance Outputable TcIdSigInst where
ppr :: TcIdSigInst -> SDoc
ppr (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSig
sig_inst_sig = TcIdSig
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 (TcIdSig -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSig
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 ])
isPartialSig :: TcIdSigInst -> Bool
isPartialSig :: TcIdSigInst -> Bool
isPartialSig (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSig
sig_inst_sig = TcPartialSig {} }) = 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 (TcCompleteSig {})) -> Bool
True
Maybe TcSigInfo
_ -> Bool
False
tcSigInfoName :: TcSigInfo -> Name
tcSigInfoName :: TcSigInfo -> Name
tcSigInfoName (TcIdSig (TcCompleteSig TcCompleteSig
sig)) = TcId -> Name
idName (TcCompleteSig -> TcId
sig_bndr TcCompleteSig
sig)
tcSigInfoName (TcIdSig (TcPartialSig TcPartialSig
sig)) = TcPartialSig -> Name
psig_name TcPartialSig
sig
tcSigInfoName (TcPatSynSig TcPatSynSig
sig) = TcPatSynSig -> Name
patsig_name TcPatSynSig
sig
tcIdSigLoc :: TcIdSig -> SrcSpan
tcIdSigLoc :: TcIdSig -> SrcSpan
tcIdSigLoc (TcCompleteSig TcCompleteSig
sig) = TcCompleteSig -> SrcSpan
sig_loc TcCompleteSig
sig
tcIdSigLoc (TcPartialSig TcPartialSig
sig) = TcPartialSig -> SrcSpan
psig_loc TcPartialSig
sig
completeSigPolyId_maybe :: TcSigInfo -> Maybe TcId
completeSigPolyId_maybe :: TcSigInfo -> Maybe TcId
completeSigPolyId_maybe (TcIdSig (TcCompleteSig TcCompleteSig
sig)) = TcId -> Maybe TcId
forall a. a -> Maybe a
Just (TcCompleteSig -> TcId
sig_bndr TcCompleteSig
sig)
completeSigPolyId_maybe TcSigInfo
_ = Maybe TcId
forall a. Maybe a
Nothing
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