{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
module GHC.Tc.Types(
TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG,
TcRef,
Env(..),
TcGblEnv(..), TcLclEnv(..),
setLclEnvTcLevel, getLclEnvTcLevel,
setLclEnvLoc, getLclEnvLoc, lclEnvInGeneratedCode,
IfGblEnv(..), IfLclEnv(..),
tcVisibleOrphanMods,
RewriteEnv(..),
FrontendResult(..),
ErrCtxt, RecFieldEnv, pushErrCtxt, pushErrCtxtSameOrigin,
ImportAvails(..), emptyImportAvails, plusImportAvails,
WhereFrom(..), mkModDeps,
TcTypeEnv, TcBinderStack, TcBinder(..),
TcTyThing(..), tcTyThingTyCon_maybe,
PromotionErr(..),
IdBindingInfo(..), ClosedTypeId, RhsNames,
IsGroupClosed(..),
SelfBootInfo(..), bootExports,
tcTyThingCategory, pprTcTyThingCategory,
peCategory, pprPECategory,
CompleteMatch, CompleteMatches,
ThStage(..), SpliceType(..), PendingStuff(..),
topStage, topAnnStage, topSpliceStage,
ThLevel, impLevel, outerLevel, thLevel,
ForeignSrcLang(..), THDocs, DocLoc(..),
ThBindEnv,
ArrowCtxt(..),
TcSigFun, TcSigInfo(..), TcIdSigInfo(..),
TcIdSigInst(..), TcPatSynInfo(..),
isPartialSig, hasCompleteSig,
TcId, TcIdSet,
NameShape(..),
removeBindingShadowing,
getPlatform,
TcPlugin(..),
TcPluginSolveResult(TcPluginContradiction, TcPluginOk, ..),
TcPluginRewriteResult(..),
TcPluginSolver, TcPluginRewriter,
TcPluginM(runTcPluginM), unsafeTcPluginTcM,
DefaultingPlugin(..), DefaultingProposal(..),
FillDefaulting, DefaultingPluginResult,
RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,
lookupRoleAnnot, getRoleAnnots,
lintGblEnv,
TcRnMessage
) where
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Env
import GHC.Driver.Config.Core.Lint
import GHC.Driver.Session
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Hs
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
import GHC.Tc.Types.Evidence
import {-# SOURCE #-} GHC.Tc.Errors.Hole.FitTypes ( HoleFitPlugin )
import GHC.Tc.Errors.Types
import GHC.Core.Reduction ( Reduction(..) )
import GHC.Core.Type
import GHC.Core.TyCon ( TyCon, tyConKind )
import GHC.Core.PatSyn ( PatSyn )
import GHC.Core.Lint ( lintAxioms )
import GHC.Core.UsageEnv
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Predicate
import GHC.Types.Id ( idType, idName )
import GHC.Types.FieldLabel ( FieldLabel )
import GHC.Types.Fixity.Env
import GHC.Types.Annotations
import GHC.Types.CompleteMatch
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Avail
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.TypeEnv
import GHC.Types.TyThing
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
import GHC.Types.Var.Set
import GHC.Types.Unique.FM
import GHC.Types.Basic
import GHC.Types.CostCentre.State
import GHC.Types.HpcInfo
import GHC.Data.IOEnv
import GHC.Data.Bag
import GHC.Data.List.SetOps
import GHC.Unit
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.Deps
import GHC.Unit.Module.ModDetails
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Fingerprint
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Logger
import GHC.Builtin.Names ( isUnboundName )
import Data.Set ( Set )
import qualified Data.Set as S
import Data.Map ( Map )
import Data.Dynamic ( Dynamic )
import Data.Typeable ( TypeRep )
import Data.Maybe ( mapMaybe )
import GHCi.Message
import GHCi.RemoteTypes
import qualified Language.Haskell.TH as TH
import GHC.Driver.Env.KnotVars
import GHC.Linker.Types
data NameShape = NameShape {
NameShape -> ModuleName
ns_mod_name :: ModuleName,
NameShape -> [AvailInfo]
ns_exports :: [AvailInfo],
NameShape -> OccEnv Name
ns_map :: OccEnv Name
}
type TcRnIf a b = IOEnv (Env a b)
type TcRn = TcRnIf TcGblEnv TcLclEnv
type IfM lcl = TcRnIf IfGblEnv lcl
type IfG = IfM ()
type IfL = IfM IfLclEnv
type RnM = TcRn
type TcM = TcRn
data Env gbl lcl
= Env {
forall gbl lcl. Env gbl lcl -> HscEnv
env_top :: !HscEnv,
forall gbl lcl. Env gbl lcl -> Char
env_um :: {-# UNPACK #-} !Char,
forall gbl lcl. Env gbl lcl -> gbl
env_gbl :: gbl,
forall gbl lcl. Env gbl lcl -> lcl
env_lcl :: lcl
}
instance ContainsDynFlags (Env gbl lcl) where
extractDynFlags :: Env gbl lcl -> DynFlags
extractDynFlags Env gbl lcl
env = HscEnv -> DynFlags
hsc_dflags (Env gbl lcl -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top Env gbl lcl
env)
instance ContainsHooks (Env gbl lcl) where
extractHooks :: Env gbl lcl -> Hooks
extractHooks Env gbl lcl
env = HscEnv -> Hooks
hsc_hooks (Env gbl lcl -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top Env gbl lcl
env)
instance ContainsLogger (Env gbl lcl) where
extractLogger :: Env gbl lcl -> Logger
extractLogger Env gbl lcl
env = HscEnv -> Logger
hsc_logger (Env gbl lcl -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top Env gbl lcl
env)
instance ContainsModule gbl => ContainsModule (Env gbl lcl) where
extractModule :: Env gbl lcl -> Module
extractModule Env gbl lcl
env = gbl -> Module
forall t. ContainsModule t => t -> Module
extractModule (Env gbl lcl -> gbl
forall gbl lcl. Env gbl lcl -> gbl
env_gbl Env gbl lcl
env)
data RewriteEnv
= RE { RewriteEnv -> CtLoc
re_loc :: !CtLoc
, RewriteEnv -> CtFlavour
re_flavour :: !CtFlavour
, RewriteEnv -> EqRel
re_eq_rel :: !EqRel
, RewriteEnv -> TcRef RewriterSet
re_rewriters :: !(TcRef RewriterSet)
}
data IfGblEnv
= IfGblEnv {
IfGblEnv -> SDoc
if_doc :: SDoc,
IfGblEnv -> KnotVars (IfG TypeEnv)
if_rec_types :: (KnotVars (IfG TypeEnv))
}
data IfLclEnv
= IfLclEnv {
IfLclEnv -> Module
if_mod :: !Module,
IfLclEnv -> IsBootInterface
if_boot :: IsBootInterface,
IfLclEnv -> SDoc
if_loc :: SDoc,
IfLclEnv -> Maybe NameShape
if_nsubst :: Maybe NameShape,
IfLclEnv -> Maybe TypeEnv
if_implicits_env :: Maybe TypeEnv,
IfLclEnv -> FastStringEnv TyVar
if_tv_env :: FastStringEnv TyVar,
IfLclEnv -> FastStringEnv TyVar
if_id_env :: FastStringEnv Id
}
data FrontendResult
= FrontendTypecheck TcGblEnv
data TcGblEnv
= TcGblEnv {
TcGblEnv -> Module
tcg_mod :: Module,
TcGblEnv -> Module
tcg_semantic_mod :: Module,
TcGblEnv -> HscSource
tcg_src :: HscSource,
TcGblEnv -> GlobalRdrEnv
tcg_rdr_env :: GlobalRdrEnv,
TcGblEnv -> Maybe [Type]
tcg_default :: Maybe [Type],
TcGblEnv -> FixityEnv
tcg_fix_env :: FixityEnv,
TcGblEnv -> RecFieldEnv
tcg_field_env :: RecFieldEnv,
TcGblEnv -> TypeEnv
tcg_type_env :: TypeEnv,
TcGblEnv -> KnotVars (IORef TypeEnv)
tcg_type_env_var :: KnotVars (IORef TypeEnv),
TcGblEnv -> InstEnv
tcg_inst_env :: !InstEnv,
TcGblEnv -> FamInstEnv
tcg_fam_inst_env :: !FamInstEnv,
TcGblEnv -> AnnEnv
tcg_ann_env :: AnnEnv,
TcGblEnv -> [AvailInfo]
tcg_exports :: [AvailInfo],
TcGblEnv -> ImportAvails
tcg_imports :: ImportAvails,
TcGblEnv -> DefUses
tcg_dus :: DefUses,
TcGblEnv -> TcRef [GlobalRdrElt]
tcg_used_gres :: TcRef [GlobalRdrElt],
TcGblEnv -> TcRef NameSet
tcg_keep :: TcRef NameSet,
TcGblEnv -> TcRef Bool
tcg_th_used :: TcRef Bool,
TcGblEnv -> TcRef Bool
tcg_th_splice_used :: TcRef Bool,
TcGblEnv -> TcRef ([Linkable], PkgsLoaded)
tcg_th_needed_deps :: TcRef ([Linkable], PkgsLoaded),
TcGblEnv -> TcRef OccSet
tcg_dfun_n :: TcRef OccSet,
TcGblEnv -> [(Module, Fingerprint)]
tcg_merged :: [(Module, Fingerprint)],
TcGblEnv -> Maybe [(LIE GhcRn, [AvailInfo])]
tcg_rn_exports :: Maybe [(LIE GhcRn, Avails)],
TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports :: [LImportDecl GhcRn],
TcGblEnv -> Maybe (HsGroup GhcRn)
tcg_rn_decls :: Maybe (HsGroup GhcRn),
TcGblEnv -> TcRef [FilePath]
tcg_dependent_files :: TcRef [FilePath],
TcGblEnv -> TcRef [LHsDecl GhcPs]
tcg_th_topdecls :: TcRef [LHsDecl GhcPs],
TcGblEnv -> TcRef [(ForeignSrcLang, FilePath)]
tcg_th_foreign_files :: TcRef [(ForeignSrcLang, FilePath)],
TcGblEnv -> TcRef NameSet
tcg_th_topnames :: TcRef NameSet,
TcGblEnv -> TcRef [(TcLclEnv, ThModFinalizers)]
tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],
TcGblEnv -> TcRef [FilePath]
tcg_th_coreplugins :: TcRef [String],
TcGblEnv -> TcRef (Map TypeRep Dynamic)
tcg_th_state :: TcRef (Map TypeRep Dynamic),
TcGblEnv -> TcRef (Maybe (ForeignRef (IORef QState)))
tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),
TcGblEnv -> TcRef THDocs
tcg_th_docs :: TcRef THDocs,
TcGblEnv -> Bag EvBind
tcg_ev_binds :: Bag EvBind,
TcGblEnv -> Maybe TyVar
tcg_tr_module :: Maybe Id,
TcGblEnv -> LHsBinds GhcTc
tcg_binds :: LHsBinds GhcTc,
TcGblEnv -> NameSet
tcg_sigs :: NameSet,
TcGblEnv -> [LTcSpecPrag]
tcg_imp_specs :: [LTcSpecPrag],
TcGblEnv -> Warnings GhcRn
tcg_warns :: (Warnings GhcRn),
TcGblEnv -> [Annotation]
tcg_anns :: [Annotation],
TcGblEnv -> [TyCon]
tcg_tcs :: [TyCon],
TcGblEnv -> NameSet
tcg_ksigs :: NameSet,
TcGblEnv -> [ClsInst]
tcg_insts :: [ClsInst],
TcGblEnv -> [FamInst]
tcg_fam_insts :: [FamInst],
TcGblEnv -> [LRuleDecl GhcTc]
tcg_rules :: [LRuleDecl GhcTc],
TcGblEnv -> [LForeignDecl GhcTc]
tcg_fords :: [LForeignDecl GhcTc],
TcGblEnv -> [PatSyn]
tcg_patsyns :: [PatSyn],
TcGblEnv -> Maybe (LHsDoc GhcRn)
tcg_doc_hdr :: Maybe (LHsDoc GhcRn),
TcGblEnv -> Bool
tcg_hpc :: !AnyHpcUsage,
TcGblEnv -> SelfBootInfo
tcg_self_boot :: SelfBootInfo,
TcGblEnv -> Maybe Name
tcg_main :: Maybe Name,
TcGblEnv -> TcRef Bool
tcg_safe_infer :: TcRef Bool,
TcGblEnv -> TcRef (Messages TcRnMessage)
tcg_safe_infer_reasons :: TcRef (Messages TcRnMessage),
TcGblEnv -> [TcPluginSolver]
tcg_tc_plugin_solvers :: [TcPluginSolver],
TcGblEnv -> UniqFM TyCon [TcPluginRewriter]
tcg_tc_plugin_rewriters :: UniqFM TyCon [TcPluginRewriter],
TcGblEnv -> [FillDefaulting]
tcg_defaulting_plugins :: [FillDefaulting],
TcGblEnv -> [HoleFitPlugin]
tcg_hf_plugins :: [HoleFitPlugin],
TcGblEnv -> RealSrcSpan
tcg_top_loc :: RealSrcSpan,
TcGblEnv -> TcRef WantedConstraints
tcg_static_wc :: TcRef WantedConstraints,
TcGblEnv -> CompleteMatches
tcg_complete_matches :: !CompleteMatches,
TcGblEnv -> TcRef CostCentreState
tcg_cc_st :: TcRef CostCentreState,
TcGblEnv -> TcRef (ModuleEnv ThLevel)
tcg_next_wrapper_num :: TcRef (ModuleEnv Int)
}
tcVisibleOrphanMods :: TcGblEnv -> ModuleSet
tcVisibleOrphanMods :: TcGblEnv -> ModuleSet
tcVisibleOrphanMods TcGblEnv
tcg_env
= [Module] -> ModuleSet
mkModuleSet (TcGblEnv -> Module
tcg_mod TcGblEnv
tcg_env Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: ImportAvails -> [Module]
imp_orphs (TcGblEnv -> ImportAvails
tcg_imports TcGblEnv
tcg_env))
instance ContainsModule TcGblEnv where
extractModule :: TcGblEnv -> Module
extractModule TcGblEnv
env = TcGblEnv -> Module
tcg_semantic_mod TcGblEnv
env
type RecFieldEnv = NameEnv [FieldLabel]
data SelfBootInfo
= NoSelfBoot
| SelfBoot
{ SelfBootInfo -> ModDetails
sb_mds :: ModDetails
, SelfBootInfo -> NameSet
sb_tcs :: NameSet }
bootExports :: SelfBootInfo -> NameSet
bootExports :: SelfBootInfo -> NameSet
bootExports SelfBootInfo
boot =
case SelfBootInfo
boot of
SelfBootInfo
NoSelfBoot -> NameSet
emptyNameSet
SelfBoot { sb_mds :: SelfBootInfo -> ModDetails
sb_mds = ModDetails
mds} ->
let exports :: [AvailInfo]
exports = ModDetails -> [AvailInfo]
md_exports ModDetails
mds
in [AvailInfo] -> NameSet
availsToNameSet [AvailInfo]
exports
data TcLclEnv
= TcLclEnv {
TcLclEnv -> RealSrcSpan
tcl_loc :: RealSrcSpan,
TcLclEnv -> [ErrCtxt]
tcl_ctxt :: [ErrCtxt],
TcLclEnv -> Bool
tcl_in_gen_code :: Bool,
TcLclEnv -> TcLevel
tcl_tclvl :: TcLevel,
TcLclEnv -> ThStage
tcl_th_ctxt :: ThStage,
TcLclEnv -> ThBindEnv
tcl_th_bndrs :: ThBindEnv,
TcLclEnv -> ArrowCtxt
tcl_arrow_ctxt :: ArrowCtxt,
TcLclEnv -> LocalRdrEnv
tcl_rdr :: LocalRdrEnv,
TcLclEnv -> TcTypeEnv
tcl_env :: TcTypeEnv,
TcLclEnv -> TcRef UsageEnv
tcl_usage :: TcRef UsageEnv,
TcLclEnv -> TcBinderStack
tcl_bndrs :: TcBinderStack,
TcLclEnv -> TcRef WantedConstraints
tcl_lie :: TcRef WantedConstraints,
TcLclEnv -> TcRef (Messages TcRnMessage)
tcl_errs :: TcRef (Messages TcRnMessage)
}
setLclEnvTcLevel :: TcLclEnv -> TcLevel -> TcLclEnv
setLclEnvTcLevel :: TcLclEnv -> TcLevel -> TcLclEnv
setLclEnvTcLevel TcLclEnv
env TcLevel
lvl = TcLclEnv
env { tcl_tclvl = lvl }
getLclEnvTcLevel :: TcLclEnv -> TcLevel
getLclEnvTcLevel :: TcLclEnv -> TcLevel
getLclEnvTcLevel = TcLclEnv -> TcLevel
tcl_tclvl
setLclEnvLoc :: TcLclEnv -> RealSrcSpan -> TcLclEnv
setLclEnvLoc :: TcLclEnv -> RealSrcSpan -> TcLclEnv
setLclEnvLoc TcLclEnv
env RealSrcSpan
loc = TcLclEnv
env { tcl_loc = loc }
getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc = TcLclEnv -> RealSrcSpan
tcl_loc
lclEnvInGeneratedCode :: TcLclEnv -> Bool
lclEnvInGeneratedCode :: TcLclEnv -> Bool
lclEnvInGeneratedCode = TcLclEnv -> Bool
tcl_in_gen_code
type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, SDoc))
pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc
pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc
pushErrCtxt CtOrigin
o ErrCtxt
err loc :: CtLoc
loc@(CtLoc { ctl_env :: CtLoc -> TcLclEnv
ctl_env = TcLclEnv
lcl })
= CtLoc
loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }
pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc
pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc
pushErrCtxtSameOrigin ErrCtxt
err loc :: CtLoc
loc@(CtLoc { ctl_env :: CtLoc -> TcLclEnv
ctl_env = TcLclEnv
lcl })
= CtLoc
loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }
type TcTypeEnv = NameEnv TcTyThing
type ThBindEnv = NameEnv (TopLevelFlag, ThLevel)
type TcRef a = IORef a
type TcId = Id
type TcIdSet = IdSet
type TcBinderStack = [TcBinder]
data TcBinder
= TcIdBndr
TcId
TopLevelFlag
| TcIdBndr_ExpType
Name
ExpType
TopLevelFlag
| TcTvBndr
Name
TyVar
instance Outputable TcBinder where
ppr :: TcBinder -> SDoc
ppr (TcIdBndr TyVar
id TopLevelFlag
top_lvl) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
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 TyVar
tv) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv
instance HasOccName TcBinder where
occName :: TcBinder -> OccName
occName (TcIdBndr TyVar
id TopLevelFlag
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName (TyVar -> Name
idName TyVar
id)
occName (TcIdBndr_ExpType Name
name ExpType
_ TopLevelFlag
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name
occName (TcTvBndr Name
name TyVar
_) = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name
removeBindingShadowing :: HasOccName a => [a] -> [a]
removeBindingShadowing :: forall a. HasOccName a => [a] -> [a]
removeBindingShadowing [a]
bindings = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ([a], OccSet) -> [a]
forall a b. (a, b) -> a
fst (([a], OccSet) -> [a]) -> ([a], OccSet) -> [a]
forall a b. (a -> b) -> a -> b
$ (([a], OccSet) -> a -> ([a], OccSet))
-> ([a], OccSet) -> [a] -> ([a], OccSet)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\([a]
bindingAcc, OccSet
seenNames) a
binding ->
if a -> OccName
forall name. HasOccName name => name -> OccName
occName a
binding OccName -> OccSet -> Bool
`elemOccSet` OccSet
seenNames
then ([a]
bindingAcc, OccSet
seenNames)
else (a
bindinga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bindingAcc, OccSet -> OccName -> OccSet
extendOccSet OccSet
seenNames (a -> OccName
forall name. HasOccName name => name -> OccName
occName a
binding)))
([], OccSet
emptyOccSet) [a]
bindings
getPlatform :: TcRnIf a b Platform
getPlatform :: forall a b. TcRnIf a b Platform
getPlatform = DynFlags -> Platform
targetPlatform (DynFlags -> Platform)
-> IOEnv (Env a b) DynFlags -> IOEnv (Env a b) Platform
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env a b) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
data SpliceType = Typed | Untyped
data ThStage
= Splice SpliceType
| RunSplice (TcRef [ForeignRef (TH.Q ())])
| Comp
| Brack
ThStage
PendingStuff
data PendingStuff
= RnPendingUntyped
(TcRef [PendingRnSplice])
| RnPendingTyped
| TcPending
(TcRef [PendingTcSplice])
(TcRef WantedConstraints)
QuoteWrapper
topStage, topAnnStage, topSpliceStage :: ThStage
topStage :: ThStage
topStage = ThStage
Comp
topAnnStage :: ThStage
topAnnStage = SpliceType -> ThStage
Splice SpliceType
Untyped
topSpliceStage :: ThStage
topSpliceStage = SpliceType -> ThStage
Splice SpliceType
Untyped
instance Outputable ThStage where
ppr :: ThStage -> SDoc
ppr (Splice SpliceType
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Splice"
ppr (RunSplice TcRef [ForeignRef (Q ())]
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"RunSplice"
ppr ThStage
Comp = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Comp"
ppr (Brack ThStage
s PendingStuff
_) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Brack" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (ThStage -> SDoc
forall a. Outputable a => a -> SDoc
ppr ThStage
s)
type ThLevel = Int
impLevel, outerLevel :: ThLevel
impLevel :: ThLevel
impLevel = ThLevel
0
outerLevel :: ThLevel
outerLevel = ThLevel
1
thLevel :: ThStage -> ThLevel
thLevel :: ThStage -> ThLevel
thLevel (Splice SpliceType
_) = ThLevel
0
thLevel ThStage
Comp = ThLevel
1
thLevel (Brack ThStage
s PendingStuff
_) = ThStage -> ThLevel
thLevel ThStage
s ThLevel -> ThLevel -> ThLevel
forall a. Num a => a -> a -> a
+ ThLevel
1
thLevel (RunSplice TcRef [ForeignRef (Q ())]
_) = FilePath -> ThLevel
forall a. HasCallStack => FilePath -> a
panic FilePath
"thLevel: called when running a splice"
data ArrowCtxt
= NoArrowCtxt
| ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)
data TcTyThing
= AGlobal TyThing
| ATcId
{ TcTyThing -> TyVar
tct_id :: TcId
, 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 {}) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"Identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcTyThing -> TyVar
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
<> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
varType (TcTyThing -> TyVar
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 TyVar
tv) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"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
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
varType TyVar
tv)
ppr (ATcTyCon TyCon
tc) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"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
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> Type
tyConKind TyCon
tc)
ppr (APromotionErr PromotionErr
err) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"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 = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"NotLetBound"
ppr IdBindingInfo
ClosedLet = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"TopLevelLet"
ppr (NonClosedLet NameSet
fvs Bool
closed_type) =
FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"TopLevelLet" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
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 = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text (FilePath -> SDoc) -> (TcTyThing -> FilePath) -> TcTyThing -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
capitalise (FilePath -> FilePath)
-> (TcTyThing -> FilePath) -> TcTyThing -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcTyThing -> FilePath
tcTyThingCategory
tcTyThingCategory :: TcTyThing -> String
tcTyThingCategory :: TcTyThing -> FilePath
tcTyThingCategory (AGlobal TyThing
thing) = TyThing -> FilePath
tyThingCategory TyThing
thing
tcTyThingCategory (ATyVar {}) = FilePath
"type variable"
tcTyThingCategory (ATcId {}) = FilePath
"local identifier"
tcTyThingCategory (ATcTyCon {}) = FilePath
"local tycon"
tcTyThingCategory (APromotionErr PromotionErr
pe) = PromotionErr -> FilePath
peCategory PromotionErr
pe
mkModDeps :: Set (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
mkModDeps :: Set (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
mkModDeps Set (UnitId, ModuleNameWithIsBoot)
deps = (InstalledModuleEnv ModuleNameWithIsBoot
-> (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
-> Set (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' InstalledModuleEnv ModuleNameWithIsBoot
-> (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
add InstalledModuleEnv ModuleNameWithIsBoot
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv Set (UnitId, ModuleNameWithIsBoot)
deps
where
add :: InstalledModuleEnv ModuleNameWithIsBoot
-> (UnitId, ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
add InstalledModuleEnv ModuleNameWithIsBoot
env (UnitId
uid, ModuleNameWithIsBoot
elt) = InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModule
-> ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv InstalledModuleEnv ModuleNameWithIsBoot
env (UnitId -> ModuleName -> InstalledModule
forall u. u -> ModuleName -> GenModule u
mkModule UnitId
uid (ModuleNameWithIsBoot -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod ModuleNameWithIsBoot
elt)) ModuleNameWithIsBoot
elt
plusModDeps :: InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
plusModDeps :: InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
plusModDeps = (ModuleNameWithIsBoot
-> ModuleNameWithIsBoot -> ModuleNameWithIsBoot)
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
forall elt.
(elt -> elt -> elt)
-> InstalledModuleEnv elt
-> InstalledModuleEnv elt
-> InstalledModuleEnv elt
plusInstalledModuleEnv ModuleNameWithIsBoot
-> ModuleNameWithIsBoot -> ModuleNameWithIsBoot
forall {a}.
(Eq a, Outputable a) =>
GenWithIsBoot a -> GenWithIsBoot a -> GenWithIsBoot a
plus_mod_dep
where
plus_mod_dep :: GenWithIsBoot a -> GenWithIsBoot a -> GenWithIsBoot a
plus_mod_dep r1 :: GenWithIsBoot a
r1@(GWIB { gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod = a
m1, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
boot1 })
r2 :: GenWithIsBoot a
r2@(GWIB {gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod = a
m2, gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
boot2})
| Bool -> SDoc -> IsBootInterface -> IsBootInterface
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (a
m1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m2) ((a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
m1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
m2) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IsBootInterface
boot1 IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IsBootInterface
boot2 IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot)))
IsBootInterface
boot1 IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot = GenWithIsBoot a
r2
| Bool
otherwise = GenWithIsBoot a
r1
emptyImportAvails :: ImportAvails
emptyImportAvails :: ImportAvails
emptyImportAvails = ImportAvails { imp_mods :: ImportedMods
imp_mods = ImportedMods
forall a. ModuleEnv a
emptyModuleEnv,
imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot
imp_direct_dep_mods = InstalledModuleEnv ModuleNameWithIsBoot
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv,
imp_dep_direct_pkgs :: Set UnitId
imp_dep_direct_pkgs = Set UnitId
forall a. Set a
S.empty,
imp_sig_mods :: [ModuleName]
imp_sig_mods = [],
imp_trust_pkgs :: Set UnitId
imp_trust_pkgs = Set UnitId
forall a. Set a
S.empty,
imp_trust_own_pkg :: Bool
imp_trust_own_pkg = Bool
False,
imp_boot_mods :: InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
forall a. InstalledModuleEnv a
emptyInstalledModuleEnv,
imp_orphs :: [Module]
imp_orphs = [],
imp_finsts :: [Module]
imp_finsts = [] }
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
plusImportAvails
(ImportAvails { imp_mods :: ImportAvails -> ImportedMods
imp_mods = ImportedMods
mods1,
imp_direct_dep_mods :: ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_direct_dep_mods = InstalledModuleEnv ModuleNameWithIsBoot
ddmods1,
imp_dep_direct_pkgs :: ImportAvails -> Set UnitId
imp_dep_direct_pkgs = Set UnitId
ddpkgs1,
imp_boot_mods :: ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
srs1,
imp_sig_mods :: ImportAvails -> [ModuleName]
imp_sig_mods = [ModuleName]
sig_mods1,
imp_trust_pkgs :: ImportAvails -> Set UnitId
imp_trust_pkgs = Set UnitId
tpkgs1, imp_trust_own_pkg :: ImportAvails -> Bool
imp_trust_own_pkg = Bool
tself1,
imp_orphs :: ImportAvails -> [Module]
imp_orphs = [Module]
orphs1, imp_finsts :: ImportAvails -> [Module]
imp_finsts = [Module]
finsts1 })
(ImportAvails { imp_mods :: ImportAvails -> ImportedMods
imp_mods = ImportedMods
mods2,
imp_direct_dep_mods :: ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_direct_dep_mods = InstalledModuleEnv ModuleNameWithIsBoot
ddmods2,
imp_dep_direct_pkgs :: ImportAvails -> Set UnitId
imp_dep_direct_pkgs = Set UnitId
ddpkgs2,
imp_boot_mods :: ImportAvails -> InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
srcs2,
imp_sig_mods :: ImportAvails -> [ModuleName]
imp_sig_mods = [ModuleName]
sig_mods2,
imp_trust_pkgs :: ImportAvails -> Set UnitId
imp_trust_pkgs = Set UnitId
tpkgs2, imp_trust_own_pkg :: ImportAvails -> Bool
imp_trust_own_pkg = Bool
tself2,
imp_orphs :: ImportAvails -> [Module]
imp_orphs = [Module]
orphs2, imp_finsts :: ImportAvails -> [Module]
imp_finsts = [Module]
finsts2 })
= ImportAvails { imp_mods :: ImportedMods
imp_mods = ([ImportedBy] -> [ImportedBy] -> [ImportedBy])
-> ImportedMods -> ImportedMods -> ImportedMods
forall a.
(a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C [ImportedBy] -> [ImportedBy] -> [ImportedBy]
forall a. [a] -> [a] -> [a]
(++) ImportedMods
mods1 ImportedMods
mods2,
imp_direct_dep_mods :: InstalledModuleEnv ModuleNameWithIsBoot
imp_direct_dep_mods = InstalledModuleEnv ModuleNameWithIsBoot
ddmods1 InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
`plusModDeps` InstalledModuleEnv ModuleNameWithIsBoot
ddmods2,
imp_dep_direct_pkgs :: Set UnitId
imp_dep_direct_pkgs = Set UnitId
ddpkgs1 Set UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set UnitId
ddpkgs2,
imp_trust_pkgs :: Set UnitId
imp_trust_pkgs = Set UnitId
tpkgs1 Set UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set UnitId
tpkgs2,
imp_trust_own_pkg :: Bool
imp_trust_own_pkg = Bool
tself1 Bool -> Bool -> Bool
|| Bool
tself2,
imp_boot_mods :: InstalledModuleEnv ModuleNameWithIsBoot
imp_boot_mods = InstalledModuleEnv ModuleNameWithIsBoot
srs1 InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
-> InstalledModuleEnv ModuleNameWithIsBoot
`plusModDeps` InstalledModuleEnv ModuleNameWithIsBoot
srcs2,
imp_sig_mods :: [ModuleName]
imp_sig_mods = [ModuleName] -> [ModuleName] -> [ModuleName]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [ModuleName]
sig_mods1 [ModuleName]
sig_mods2,
imp_orphs :: [Module]
imp_orphs = [Module] -> [Module] -> [Module]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [Module]
orphs1 [Module]
orphs2,
imp_finsts :: [Module]
imp_finsts = [Module] -> [Module] -> [Module]
forall a.
(() :: Constraint, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [Module]
finsts1 [Module]
finsts2 }
data WhereFrom
= ImportByUser IsBootInterface
| ImportBySystem
| ImportByPlugin
instance Outputable WhereFrom where
ppr :: WhereFrom -> SDoc
ppr (ImportByUser IsBootInterface
IsBoot) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"{- SOURCE -}"
ppr (ImportByUser IsBootInterface
NotBoot) = SDoc
forall doc. IsOutput doc => doc
empty
ppr WhereFrom
ImportBySystem = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"{- SYSTEM -}"
ppr WhereFrom
ImportByPlugin = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"{- PLUGIN -}"
type TcSigFun = Name -> Maybe TcSigInfo
data TcSigInfo = TcIdSig TcIdSigInfo
| TcPatSynSig TcPatSynInfo
data TcIdSigInfo
= CompleteSig
{ TcIdSigInfo -> TyVar
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 -> [Type]
sig_inst_theta :: TcThetaType
, TcIdSigInst -> Type
sig_inst_tau :: TcSigmaType
, TcIdSigInst -> [(Name, TyVar)]
sig_inst_wcs :: [(Name, TcTyVar)]
, TcIdSigInst -> Maybe Type
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 -> [Type]
patsig_req :: TcThetaType,
TcPatSynInfo -> [InvisTVBinder]
patsig_ex_bndrs :: [InvisTVBinder],
TcPatSynInfo -> [Type]
patsig_prov :: TcThetaType,
TcPatSynInfo -> Type
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) = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"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 -> TyVar
sig_bndr = TyVar
bndr })
= TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
bndr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyVar -> Type
idType TyVar
bndr)
ppr (PartialSig { psig_name :: TcIdSigInfo -> Name
psig_name = Name
name, psig_hs_ty :: TcIdSigInfo -> LHsSigWcType GhcRn
psig_hs_ty = LHsSigWcType GhcRn
hs_ty })
= FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"psig" 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 -> [Type]
sig_inst_theta = [Type]
theta, sig_inst_tau :: TcIdSigInst -> Type
sig_inst_tau = Type
tau })
= SDoc -> ThLevel -> SDoc -> SDoc
hang (TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
sig) ThLevel
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [(Name, InvisTVBinder)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(Name, InvisTVBinder)]
skols, [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Type]
theta SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
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
type TcPluginSolver = EvBindsVar
-> [Ct]
-> [Ct]
-> TcPluginM TcPluginSolveResult
type TcPluginRewriter
= RewriteEnv
-> [Ct]
-> [TcType]
-> TcPluginM TcPluginRewriteResult
newtype TcPluginM a = TcPluginM { forall a. TcPluginM a -> TcM a
runTcPluginM :: TcM a }
deriving newtype ((forall a b. (a -> b) -> TcPluginM a -> TcPluginM b)
-> (forall a b. a -> TcPluginM b -> TcPluginM a)
-> Functor TcPluginM
forall a b. a -> TcPluginM b -> TcPluginM a
forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
fmap :: forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
$c<$ :: forall a b. a -> TcPluginM b -> TcPluginM a
<$ :: forall a b. a -> TcPluginM b -> TcPluginM a
Functor, Functor TcPluginM
Functor TcPluginM =>
(forall a. a -> TcPluginM a)
-> (forall a b. TcPluginM (a -> b) -> TcPluginM a -> TcPluginM b)
-> (forall a b c.
(a -> b -> c) -> TcPluginM a -> TcPluginM b -> TcPluginM c)
-> (forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b)
-> (forall a b. TcPluginM a -> TcPluginM b -> TcPluginM a)
-> Applicative TcPluginM
forall a. a -> TcPluginM a
forall a b. TcPluginM a -> TcPluginM b -> TcPluginM a
forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
forall a b. TcPluginM (a -> b) -> TcPluginM a -> TcPluginM b
forall a b c.
(a -> b -> c) -> TcPluginM a -> TcPluginM b -> TcPluginM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> TcPluginM a
pure :: forall a. a -> TcPluginM a
$c<*> :: forall a b. TcPluginM (a -> b) -> TcPluginM a -> TcPluginM b
<*> :: forall a b. TcPluginM (a -> b) -> TcPluginM a -> TcPluginM b
$cliftA2 :: forall a b c.
(a -> b -> c) -> TcPluginM a -> TcPluginM b -> TcPluginM c
liftA2 :: forall a b c.
(a -> b -> c) -> TcPluginM a -> TcPluginM b -> TcPluginM c
$c*> :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
*> :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
$c<* :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM a
<* :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM a
Applicative, Applicative TcPluginM
Applicative TcPluginM =>
(forall a b. TcPluginM a -> (a -> TcPluginM b) -> TcPluginM b)
-> (forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b)
-> (forall a. a -> TcPluginM a)
-> Monad TcPluginM
forall a. a -> TcPluginM a
forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
forall a b. TcPluginM a -> (a -> TcPluginM b) -> TcPluginM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. TcPluginM a -> (a -> TcPluginM b) -> TcPluginM b
>>= :: forall a b. TcPluginM a -> (a -> TcPluginM b) -> TcPluginM b
$c>> :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
>> :: forall a b. TcPluginM a -> TcPluginM b -> TcPluginM b
$creturn :: forall a. a -> TcPluginM a
return :: forall a. a -> TcPluginM a
Monad, Monad TcPluginM
Monad TcPluginM =>
(forall a. FilePath -> TcPluginM a) -> MonadFail TcPluginM
forall a. FilePath -> TcPluginM a
forall (m :: * -> *).
Monad m =>
(forall a. FilePath -> m a) -> MonadFail m
$cfail :: forall a. FilePath -> TcPluginM a
fail :: forall a. FilePath -> TcPluginM a
MonadFail)
unsafeTcPluginTcM :: TcM a -> TcPluginM a
unsafeTcPluginTcM :: forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM = TcM a -> TcPluginM a
forall a. TcM a -> TcPluginM a
TcPluginM
data TcPlugin = forall s. TcPlugin
{ ()
tcPluginInit :: TcPluginM s
, ()
tcPluginSolve :: s -> TcPluginSolver
, ()
tcPluginRewrite :: s -> UniqFM TyCon TcPluginRewriter
, ()
tcPluginStop :: s -> TcPluginM ()
}
pattern TcPluginContradiction :: [Ct] -> TcPluginSolveResult
pattern $mTcPluginContradiction :: forall {r}. TcPluginSolveResult -> ([Ct] -> r) -> ((# #) -> r) -> r
$bTcPluginContradiction :: [Ct] -> TcPluginSolveResult
TcPluginContradiction insols
= TcPluginSolveResult
{ tcPluginInsolubleCts = insols
, tcPluginSolvedCts = []
, tcPluginNewCts = [] }
pattern TcPluginOk :: [(EvTerm, Ct)] -> [Ct] -> TcPluginSolveResult
pattern $mTcPluginOk :: forall {r}.
TcPluginSolveResult
-> ([(EvTerm, Ct)] -> [Ct] -> r) -> ((# #) -> r) -> r
$bTcPluginOk :: [(EvTerm, Ct)] -> [Ct] -> TcPluginSolveResult
TcPluginOk solved new
= TcPluginSolveResult
{ tcPluginInsolubleCts = []
, tcPluginSolvedCts = solved
, tcPluginNewCts = new }
data TcPluginSolveResult
= TcPluginSolveResult
{
TcPluginSolveResult -> [Ct]
tcPluginInsolubleCts :: [Ct]
, TcPluginSolveResult -> [(EvTerm, Ct)]
tcPluginSolvedCts :: [(EvTerm, Ct)]
, TcPluginSolveResult -> [Ct]
tcPluginNewCts :: [Ct]
}
data TcPluginRewriteResult
=
TcPluginNoRewrite
| TcPluginRewriteTo
{ TcPluginRewriteResult -> Reduction
tcPluginReduction :: !Reduction
, TcPluginRewriteResult -> [Ct]
tcRewriterNewWanteds :: [Ct]
}
data DefaultingProposal
= DefaultingProposal
{ DefaultingProposal -> TyVar
deProposalTyVar :: TcTyVar
, DefaultingProposal -> [Type]
deProposalCandidates :: [Type]
, DefaultingProposal -> [Ct]
deProposalCts :: [Ct]
}
instance Outputable DefaultingProposal where
ppr :: DefaultingProposal -> SDoc
ppr DefaultingProposal
p = FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"DefaultingProposal"
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DefaultingProposal -> TyVar
deProposalTyVar DefaultingProposal
p)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DefaultingProposal -> [Type]
deProposalCandidates DefaultingProposal
p)
SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Ct] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DefaultingProposal -> [Ct]
deProposalCts DefaultingProposal
p)
type DefaultingPluginResult = [DefaultingProposal]
type FillDefaulting
= WantedConstraints
-> TcPluginM [DefaultingProposal]
data DefaultingPlugin = forall s. DefaultingPlugin
{ ()
dePluginInit :: TcPluginM s
, ()
dePluginRun :: s -> FillDefaulting
, ()
dePluginStop :: s -> TcPluginM ()
}
type RoleAnnotEnv = NameEnv (LRoleAnnotDecl GhcRn)
mkRoleAnnotEnv :: [LRoleAnnotDecl GhcRn] -> RoleAnnotEnv
mkRoleAnnotEnv :: [LRoleAnnotDecl GhcRn] -> RoleAnnotEnv
mkRoleAnnotEnv [LRoleAnnotDecl GhcRn]
role_annot_decls
= [(Name, GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn))]
-> NameEnv (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn))
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (IdP GhcRn
Name
name, GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)
ra_decl)
| GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)
ra_decl <- [LRoleAnnotDecl GhcRn]
[GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)]
role_annot_decls
, let name :: IdP GhcRn
name = RoleAnnotDecl GhcRn -> IdP GhcRn
forall (p :: Pass). RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
roleAnnotDeclName (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn) -> RoleAnnotDecl GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)
ra_decl)
, Bool -> Bool
not (Name -> Bool
isUnboundName IdP GhcRn
Name
name) ]
emptyRoleAnnotEnv :: RoleAnnotEnv
emptyRoleAnnotEnv :: RoleAnnotEnv
emptyRoleAnnotEnv = RoleAnnotEnv
NameEnv (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn))
forall a. NameEnv a
emptyNameEnv
lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)
lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)
lookupRoleAnnot = RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)
NameEnv (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn))
-> Name -> Maybe (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn))
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv
getRoleAnnots :: [Name] -> RoleAnnotEnv -> [LRoleAnnotDecl GhcRn]
getRoleAnnots :: [Name] -> RoleAnnotEnv -> [LRoleAnnotDecl GhcRn]
getRoleAnnots [Name]
bndrs RoleAnnotEnv
role_env
= (Name -> Maybe (GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)))
-> [Name] -> [GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn)
lookupRoleAnnot RoleAnnotEnv
role_env) [Name]
bndrs
lintGblEnv :: Logger -> DynFlags -> TcGblEnv -> TcM ()
lintGblEnv :: Logger -> DynFlags -> TcGblEnv -> TcM ()
lintGblEnv Logger
logger DynFlags
dflags TcGblEnv
tcg_env =
IO () -> TcM ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TcM ()) -> IO () -> TcM ()
forall a b. (a -> b) -> a -> b
$ Logger -> LintConfig -> SDoc -> [CoAxiom Branched] -> IO ()
lintAxioms Logger
logger (DynFlags -> [TyVar] -> LintConfig
initLintConfig DynFlags
dflags []) (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"TcGblEnv axioms") [CoAxiom Branched]
axioms
where
axioms :: [CoAxiom Branched]
axioms = TypeEnv -> [CoAxiom Branched]
typeEnvCoAxioms (TcGblEnv -> TypeEnv
tcg_type_env TcGblEnv
tcg_env)
data DocLoc = DeclDoc Name
| ArgDoc Name Int
| InstDoc Name
| ModuleDoc
deriving (DocLoc -> DocLoc -> Bool
(DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool) -> Eq DocLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocLoc -> DocLoc -> Bool
== :: DocLoc -> DocLoc -> Bool
$c/= :: DocLoc -> DocLoc -> Bool
/= :: DocLoc -> DocLoc -> Bool
Eq, Eq DocLoc
Eq DocLoc =>
(DocLoc -> DocLoc -> Ordering)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> Bool)
-> (DocLoc -> DocLoc -> DocLoc)
-> (DocLoc -> DocLoc -> DocLoc)
-> Ord DocLoc
DocLoc -> DocLoc -> Bool
DocLoc -> DocLoc -> Ordering
DocLoc -> DocLoc -> DocLoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DocLoc -> DocLoc -> Ordering
compare :: DocLoc -> DocLoc -> Ordering
$c< :: DocLoc -> DocLoc -> Bool
< :: DocLoc -> DocLoc -> Bool
$c<= :: DocLoc -> DocLoc -> Bool
<= :: DocLoc -> DocLoc -> Bool
$c> :: DocLoc -> DocLoc -> Bool
> :: DocLoc -> DocLoc -> Bool
$c>= :: DocLoc -> DocLoc -> Bool
>= :: DocLoc -> DocLoc -> Bool
$cmax :: DocLoc -> DocLoc -> DocLoc
max :: DocLoc -> DocLoc -> DocLoc
$cmin :: DocLoc -> DocLoc -> DocLoc
min :: DocLoc -> DocLoc -> DocLoc
Ord)
type THDocs = Map DocLoc (HsDoc GhcRn)