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