{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
module GHC.Tc.Types(
TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG,
TcRef,
Env(..),
TcGblEnv(..), TcLclEnv(..), modifyLclCtxt, TcLclCtxt(..),
setLclEnvTcLevel, getLclEnvTcLevel,
setLclEnvLoc, getLclEnvLoc, lclEnvInGeneratedCode,
IfGblEnv(..), IfLclEnv(..),
tcVisibleOrphanMods,
RewriteEnv(..),
FrontendResult(..),
ErrCtxt,
ImportAvails(..), emptyImportAvails, plusImportAvails,
mkModDeps,
TcTypeEnv, TcBinderStack, TcBinder(..),
TcTyThing(..), tcTyThingTyCon_maybe,
PromotionErr(..),
IdBindingInfo(..), ClosedTypeId, RhsNames,
IsGroupClosed(..),
SelfBootInfo(..), bootExports,
tcTyThingCategory, pprTcTyThingCategory,
peCategory, pprPECategory,
CompleteMatch, CompleteMatches,
ThStage(..), SpliceType(..), SpliceOrBracket(..), PendingStuff(..),
topStage, topAnnStage, topSpliceStage,
ThLevel, impLevel, outerLevel, thLevel,
ForeignSrcLang(..), THDocs, DocLoc(..),
ThBindEnv,
ArrowCtxt(..),
TcSigFun,
TcSigInfo(..), TcIdSig(..),
TcCompleteSig(..), TcPartialSig(..), TcPatSynSig(..),
TcIdSigInst(..),
isPartialSig, hasCompleteSig, tcSigInfoName, tcIdSigLoc,
completeSigPolyId_maybe,
TcId,
NameShape(..),
removeBindingShadowing,
getPlatform,
TcPlugin(..),
TcPluginSolveResult(TcPluginContradiction, TcPluginOk, ..),
TcPluginRewriteResult(..),
TcPluginSolver, TcPluginRewriter,
TcPluginM(runTcPluginM), unsafeTcPluginTcM,
DefaultingPlugin(..), DefaultingProposal(..),
FillDefaulting,
RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,
lookupRoleAnnot, getRoleAnnots,
lintGblEnv,
TcRnMessage
) where
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Env
import GHC.Driver.Env.KnotVars
import GHC.Driver.Config.Core.Lint
import GHC.Driver.DynFlags
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Linker.Types
import GHC.Hs
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.TH
import GHC.Tc.Types.TcRef
import GHC.Tc.Types.LclEnv
import GHC.Tc.Types.BasicTypes
import GHC.Tc.Types.ErrCtxt
import {-# SOURCE #-} GHC.Tc.Errors.Hole.Plugin ( HoleFitPlugin )
import GHC.Tc.Errors.Types
import GHC.Core.Reduction ( Reduction(..) )
import GHC.Core.Type
import GHC.Core.TyCon ( TyCon )
import GHC.Core.PatSyn ( PatSyn )
import GHC.Core.Lint ( lintAxioms )
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Predicate
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.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
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.Panic
import GHC.Utils.Logger
import GHC.Builtin.Names ( isUnboundName )
import GHCi.Message
import GHCi.RemoteTypes
import Data.Set ( Set )
import qualified Data.Set as S
import Data.Dynamic ( Dynamic )
import Data.Map ( Map )
import Data.Typeable ( TypeRep )
import Data.Maybe ( mapMaybe )
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_ut :: {-# 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 -> 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), Maybe (XRec GhcRn ModuleName))
tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName)),
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 Int)
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
data SelfBootInfo
= NoSelfBoot
| SelfBoot
{ SelfBootInfo -> ModDetails
sb_mds :: ModDetails }
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
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
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.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [ModuleName]
sig_mods1 [ModuleName]
sig_mods2,
imp_orphs :: [Module]
imp_orphs = [Module] -> [Module] -> [Module]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [Module]
orphs1 [Module]
orphs2,
imp_finsts :: [Module]
imp_finsts = [Module] -> [Module] -> [Module]
forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
unionListsOrd [Module]
finsts1 [Module]
finsts2 }
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, Type)]]
deProposals :: [[(TcTyVar, 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, Type)]] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (DefaultingProposal -> [[(TyVar, Type)]]
deProposals 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 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)