{-# LANGUAGE CPP, ScopedTypeVariables #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
module HscTypes (
HscEnv(..), hscEPS,
FinderCache, FindResult(..), InstalledFindResult(..),
Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId,
HscStatus(..),
IServ(..),
ModuleGraph, emptyMG, mkModuleGraph, extendMG, mapMG,
mgModSummaries, mgElemModule, mgLookupModule,
needsTemplateHaskellOrQQ, mgBootModules,
Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,
ModDetails(..), emptyModDetails,
ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),
ForeignSrcLang(..),
phaseForeignLanguage,
ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, ms_home_imps,
home_imps, ms_home_allimps, ms_home_srcimps, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
SourceModified(..), isTemplateHaskellOrQQNonBoot,
HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
hptCompleteSigs,
hptInstances, hptRules, pprHPT,
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule,
PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
PackageCompleteMatchMap,
mkSOName, mkHsSOName, soExt,
MetaRequest(..),
MetaResult,
metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,
MetaHook,
prepareAnnotations,
InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
extendInteractiveContext, extendInteractiveContextWithIds,
substInteractiveContext,
setInteractivePrintName, icInteractiveModule,
InteractiveImport(..), setInteractivePackage,
mkPrintUnqualified, pprModulePrefix,
mkQualPackage, mkQualModule, pkgQual,
ModIface, PartialModIface, ModIface_(..), ModIfaceBackend(..),
mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
emptyIfaceWarnCache, mi_boot, mi_fix,
mi_semantic_module,
mi_free_holes,
renameFreeHoles,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
TyThing(..), tyThingAvailInfo,
tyThingTyCon, tyThingDataCon, tyThingConLike,
tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,
implicitTyThings, implicitTyConThings, implicitClassThings,
isImplicitTyThing,
TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
typeEnvFromEntities, mkTypeEnvWithImplicits,
extendTypeEnv, extendTypeEnvList,
extendTypeEnvWithIds, plusTypeEnv,
lookupTypeEnv,
typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
MonadThings(..),
WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
updNameCache,
IfaceExport,
Warnings(..), WarningTxt(..), plusWarns,
Linkable(..), isObjectLinkable, linkableObjs,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
ModBreaks (..), emptyModBreaks,
IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
trustInfoToNum, numToTrustInfo, IsSafeImport,
HsParsedModule(..),
SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
throwOneError, throwErrors, handleSourceError,
handleFlagWarnings, printOrThrowWarnings,
CompleteMatch(..), CompleteMatchMap,
mkCompleteMatchMap, extendCompleteMatchMap
) where
#include "HsVersions.h"
import GhcPrelude
import ByteCodeTypes
import InteractiveEvalTypes ( Resume )
import GHCi.Message ( Pipe )
import GHCi.RemoteTypes
import GHC.ForeignSrcLang
import UniqFM
import GHC.Hs
import RdrName
import Avail
import Module
import InstEnv ( InstEnv, ClsInst, identicalClsInstHead )
import FamInstEnv
import CoreSyn ( CoreProgram, RuleBase, CoreRule )
import Name
import NameEnv
import VarSet
import Var
import Id
import IdInfo ( IdDetails(..), RecSelParent(..))
import Type
import ApiAnnotation ( ApiAnns )
import Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
import Class
import TyCon
import CoAxiom
import ConLike
import DataCon
import PatSyn
import PrelNames ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
import TysWiredIn
import Packages hiding ( Version(..) )
import CmdLineParser
import DynFlags
import LinkerTypes ( DynLinker, Linkable(..), Unlinked(..), SptEntry(..) )
import DriverPhases ( Phase, HscSource(..), hscSourceString
, isHsBootOrSig, isHsigFile )
import qualified DriverPhases as Phase
import BasicTypes
import IfaceSyn
import Maybes
import Outputable
import SrcLoc
import Unique
import UniqDFM
import FastString
import StringBuffer ( StringBuffer )
import Fingerprint
import MonadUtils
import Bag
import Binary
import ErrUtils
import NameCache
import GHC.Platform
import Util
import UniqDSet
import GHC.Serialized ( Serialized )
import qualified GHC.LanguageExtensions as LangExt
import Foreign
import Control.Monad ( guard, liftM, ap )
import Data.IORef
import Data.Time
import Exception
import System.FilePath
import Control.Concurrent
import System.Process ( ProcessHandle )
import Control.DeepSeq
data HscStatus
= HscNotGeneratingCode ModIface
| HscUpToDate ModIface
| HscUpdateBoot ModIface
| HscUpdateSig ModIface
| HscRecomp
{ HscStatus -> CgGuts
hscs_guts :: CgGuts
, HscStatus -> ModLocation
hscs_mod_location :: !ModLocation
, HscStatus -> PartialModIface
hscs_partial_iface :: !PartialModIface
, HscStatus -> Maybe Fingerprint
hscs_old_iface_hash :: !(Maybe Fingerprint)
, HscStatus -> DynFlags
hscs_iface_dflags :: !DynFlags
}
newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))
deriving (a -> Hsc b -> Hsc a
(a -> b) -> Hsc a -> Hsc b
(forall a b. (a -> b) -> Hsc a -> Hsc b)
-> (forall a b. a -> Hsc b -> Hsc a) -> Functor Hsc
forall a b. a -> Hsc b -> Hsc a
forall a b. (a -> b) -> Hsc a -> Hsc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Hsc b -> Hsc a
$c<$ :: forall a b. a -> Hsc b -> Hsc a
fmap :: (a -> b) -> Hsc a -> Hsc b
$cfmap :: forall a b. (a -> b) -> Hsc a -> Hsc b
Functor)
instance Applicative Hsc where
pure :: a -> Hsc a
pure a
a = (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
Hsc ((HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a)
-> (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
forall a b. (a -> b) -> a -> b
$ \HscEnv
_ WarningMessages
w -> (a, WarningMessages) -> IO (a, WarningMessages)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WarningMessages
w)
<*> :: Hsc (a -> b) -> Hsc a -> Hsc b
(<*>) = Hsc (a -> b) -> Hsc a -> Hsc b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Hsc where
Hsc HscEnv -> WarningMessages -> IO (a, WarningMessages)
m >>= :: Hsc a -> (a -> Hsc b) -> Hsc b
>>= a -> Hsc b
k = (HscEnv -> WarningMessages -> IO (b, WarningMessages)) -> Hsc b
forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
Hsc ((HscEnv -> WarningMessages -> IO (b, WarningMessages)) -> Hsc b)
-> (HscEnv -> WarningMessages -> IO (b, WarningMessages)) -> Hsc b
forall a b. (a -> b) -> a -> b
$ \HscEnv
e WarningMessages
w -> do (a
a, WarningMessages
w1) <- HscEnv -> WarningMessages -> IO (a, WarningMessages)
m HscEnv
e WarningMessages
w
case a -> Hsc b
k a
a of
Hsc HscEnv -> WarningMessages -> IO (b, WarningMessages)
k' -> HscEnv -> WarningMessages -> IO (b, WarningMessages)
k' HscEnv
e WarningMessages
w1
instance MonadIO Hsc where
liftIO :: IO a -> Hsc a
liftIO IO a
io = (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
Hsc ((HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a)
-> (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
forall a b. (a -> b) -> a -> b
$ \HscEnv
_ WarningMessages
w -> do a
a <- IO a
io; (a, WarningMessages) -> IO (a, WarningMessages)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, WarningMessages
w)
instance HasDynFlags Hsc where
getDynFlags :: Hsc DynFlags
getDynFlags = (HscEnv -> WarningMessages -> IO (DynFlags, WarningMessages))
-> Hsc DynFlags
forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
Hsc ((HscEnv -> WarningMessages -> IO (DynFlags, WarningMessages))
-> Hsc DynFlags)
-> (HscEnv -> WarningMessages -> IO (DynFlags, WarningMessages))
-> Hsc DynFlags
forall a b. (a -> b) -> a -> b
$ \HscEnv
e WarningMessages
w -> (DynFlags, WarningMessages) -> IO (DynFlags, WarningMessages)
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv -> DynFlags
hsc_dflags HscEnv
e, WarningMessages
w)
runHsc :: HscEnv -> Hsc a -> IO a
runHsc :: HscEnv -> Hsc a -> IO a
runHsc HscEnv
hsc_env (Hsc HscEnv -> WarningMessages -> IO (a, WarningMessages)
hsc) = do
(a
a, WarningMessages
w) <- HscEnv -> WarningMessages -> IO (a, WarningMessages)
hsc HscEnv
hsc_env WarningMessages
forall a. Bag a
emptyBag
DynFlags -> WarningMessages -> IO ()
printOrThrowWarnings (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) WarningMessages
w
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
mkInteractiveHscEnv :: HscEnv -> HscEnv
mkInteractiveHscEnv :: HscEnv -> HscEnv
mkInteractiveHscEnv HscEnv
hsc_env = HscEnv
hsc_env{ hsc_dflags :: DynFlags
hsc_dflags = DynFlags
interactive_dflags }
where
interactive_dflags :: DynFlags
interactive_dflags = InteractiveContext -> DynFlags
ic_dflags (HscEnv -> InteractiveContext
hsc_IC HscEnv
hsc_env)
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
runInteractiveHsc HscEnv
hsc_env = HscEnv -> Hsc a -> IO a
forall a. HscEnv -> Hsc a -> IO a
runHsc (HscEnv -> HscEnv
mkInteractiveHscEnv HscEnv
hsc_env)
mkSrcErr :: ErrorMessages -> SourceError
mkSrcErr :: WarningMessages -> SourceError
mkSrcErr = WarningMessages -> SourceError
SourceError
srcErrorMessages :: SourceError -> ErrorMessages
srcErrorMessages :: SourceError -> WarningMessages
srcErrorMessages (SourceError WarningMessages
msgs) = WarningMessages
msgs
mkApiErr :: DynFlags -> SDoc -> GhcApiError
mkApiErr :: DynFlags -> SDoc -> GhcApiError
mkApiErr DynFlags
dflags SDoc
msg = String -> GhcApiError
GhcApiError (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags SDoc
msg)
throwErrors :: MonadIO io => ErrorMessages -> io a
throwErrors :: WarningMessages -> io a
throwErrors = IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> io a)
-> (WarningMessages -> IO a) -> WarningMessages -> io a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> IO a
forall e a. Exception e => e -> IO a
throwIO (SourceError -> IO a)
-> (WarningMessages -> SourceError) -> WarningMessages -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarningMessages -> SourceError
mkSrcErr
throwOneError :: MonadIO io => ErrMsg -> io a
throwOneError :: ErrMsg -> io a
throwOneError = WarningMessages -> io a
forall (io :: * -> *) a. MonadIO io => WarningMessages -> io a
throwErrors (WarningMessages -> io a)
-> (ErrMsg -> WarningMessages) -> ErrMsg -> io a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrMsg -> WarningMessages
forall a. a -> Bag a
unitBag
newtype SourceError = SourceError ErrorMessages
instance Show SourceError where
show :: SourceError -> String
show (SourceError WarningMessages
msgs) = [String] -> String
unlines ([String] -> String)
-> (WarningMessages -> [String]) -> WarningMessages -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ErrMsg -> String) -> [ErrMsg] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ErrMsg -> String
forall a. Show a => a -> String
show ([ErrMsg] -> [String])
-> (WarningMessages -> [ErrMsg]) -> WarningMessages -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarningMessages -> [ErrMsg]
forall a. Bag a -> [a]
bagToList (WarningMessages -> String) -> WarningMessages -> String
forall a b. (a -> b) -> a -> b
$ WarningMessages
msgs
instance Exception SourceError
handleSourceError :: (ExceptionMonad m) =>
(SourceError -> m a)
-> m a
-> m a
handleSourceError :: (SourceError -> m a) -> m a -> m a
handleSourceError SourceError -> m a
handler m a
act =
m a -> (SourceError -> m a) -> m a
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
m a -> (e -> m a) -> m a
gcatch m a
act (\(SourceError
e :: SourceError) -> SourceError -> m a
handler SourceError
e)
newtype GhcApiError = GhcApiError String
instance Show GhcApiError where
show :: GhcApiError -> String
show (GhcApiError String
msg) = String
msg
instance Exception GhcApiError
printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
printOrThrowWarnings :: DynFlags -> WarningMessages -> IO ()
printOrThrowWarnings DynFlags
dflags WarningMessages
warns = do
let (Bool
make_error, WarningMessages
warns') =
(Bool -> ErrMsg -> (Bool, ErrMsg))
-> Bool -> WarningMessages -> (Bool, WarningMessages)
forall acc x y.
(acc -> x -> (acc, y)) -> acc -> Bag x -> (acc, Bag y)
mapAccumBagL
(\Bool
make_err ErrMsg
warn ->
case DynFlags -> ErrMsg -> Maybe (Maybe WarningFlag)
isWarnMsgFatal DynFlags
dflags ErrMsg
warn of
Maybe (Maybe WarningFlag)
Nothing ->
(Bool
make_err, ErrMsg
warn)
Just Maybe WarningFlag
err_reason ->
(Bool
True, ErrMsg
warn{ errMsgSeverity :: Severity
errMsgSeverity = Severity
SevError
, errMsgReason :: WarnReason
errMsgReason = Maybe WarningFlag -> WarnReason
ErrReason Maybe WarningFlag
err_reason
}))
Bool
False WarningMessages
warns
if Bool
make_error
then SourceError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (WarningMessages -> SourceError
mkSrcErr WarningMessages
warns')
else DynFlags -> WarningMessages -> IO ()
printBagOfErrors DynFlags
dflags WarningMessages
warns
handleFlagWarnings :: DynFlags -> [Warn] -> IO ()
handleFlagWarnings :: DynFlags -> [Warn] -> IO ()
handleFlagWarnings DynFlags
dflags [Warn]
warns = do
let warns' :: [Warn]
warns' = (Warn -> Bool) -> [Warn] -> [Warn]
forall a. (a -> Bool) -> [a] -> [a]
filter (DynFlags -> WarnReason -> Bool
shouldPrintWarning DynFlags
dflags (WarnReason -> Bool) -> (Warn -> WarnReason) -> Warn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warn -> WarnReason
warnReason) [Warn]
warns
bag :: WarningMessages
bag = [ErrMsg] -> WarningMessages
forall a. [a] -> Bag a
listToBag [ DynFlags -> SrcSpan -> SDoc -> ErrMsg
mkPlainWarnMsg DynFlags
dflags SrcSpan
loc (String -> SDoc
text String
SrcSpanLess (Located String)
warn)
| Warn WarnReason
_ (Located String -> Located (SrcSpanLess (Located String))
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
dL->L SrcSpan
loc SrcSpanLess (Located String)
warn) <- [Warn]
warns' ]
DynFlags -> WarningMessages -> IO ()
printOrThrowWarnings DynFlags
dflags WarningMessages
bag
shouldPrintWarning :: DynFlags -> CmdLineParser.WarnReason -> Bool
shouldPrintWarning :: DynFlags -> WarnReason -> Bool
shouldPrintWarning DynFlags
dflags WarnReason
ReasonDeprecatedFlag
= WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnDeprecatedFlags DynFlags
dflags
shouldPrintWarning DynFlags
dflags WarnReason
ReasonUnrecognisedFlag
= WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnUnrecognisedWarningFlags DynFlags
dflags
shouldPrintWarning DynFlags
_ WarnReason
_
= Bool
True
data HscEnv
= HscEnv {
HscEnv -> DynFlags
hsc_dflags :: DynFlags,
HscEnv -> [Target]
hsc_targets :: [Target],
HscEnv -> ModuleGraph
hsc_mod_graph :: ModuleGraph,
HscEnv -> InteractiveContext
hsc_IC :: InteractiveContext,
HscEnv -> HomePackageTable
hsc_HPT :: HomePackageTable,
HscEnv -> IORef ExternalPackageState
hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
HscEnv -> IORef NameCache
hsc_NC :: {-# UNPACK #-} !(IORef NameCache),
HscEnv -> IORef FinderCache
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
HscEnv -> Maybe (Module, IORef TypeEnv)
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
, HscEnv -> MVar (Maybe IServ)
hsc_iserv :: MVar (Maybe IServ)
, HscEnv -> DynLinker
hsc_dynLinker :: DynLinker
}
data IServ = IServ
{ IServ -> Pipe
iservPipe :: Pipe
, IServ -> ProcessHandle
iservProcess :: ProcessHandle
, IServ -> IORef (UniqFM (Ptr ()))
iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
, IServ -> [HValueRef]
iservPendingFrees :: [HValueRef]
}
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS HscEnv
hsc_env = IORef ExternalPackageState -> IO ExternalPackageState
forall a. IORef a -> IO a
readIORef (HscEnv -> IORef ExternalPackageState
hsc_EPS HscEnv
hsc_env)
data Target
= Target {
Target -> TargetId
targetId :: TargetId,
Target -> Bool
targetAllowObjCode :: Bool,
Target -> Maybe (InputFileBuffer, UTCTime)
targetContents :: Maybe (InputFileBuffer, UTCTime)
}
data TargetId
= TargetModule ModuleName
| TargetFile FilePath (Maybe Phase)
deriving TargetId -> TargetId -> Bool
(TargetId -> TargetId -> Bool)
-> (TargetId -> TargetId -> Bool) -> Eq TargetId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetId -> TargetId -> Bool
$c/= :: TargetId -> TargetId -> Bool
== :: TargetId -> TargetId -> Bool
$c== :: TargetId -> TargetId -> Bool
Eq
type InputFileBuffer = StringBuffer
pprTarget :: Target -> SDoc
pprTarget :: Target -> SDoc
pprTarget (Target TargetId
id Bool
obj Maybe (InputFileBuffer, UTCTime)
_) =
(if Bool
obj then Char -> SDoc
char Char
'*' else SDoc
empty) SDoc -> SDoc -> SDoc
<> TargetId -> SDoc
pprTargetId TargetId
id
instance Outputable Target where
ppr :: Target -> SDoc
ppr = Target -> SDoc
pprTarget
pprTargetId :: TargetId -> SDoc
pprTargetId :: TargetId -> SDoc
pprTargetId (TargetModule ModuleName
m) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m
pprTargetId (TargetFile String
f Maybe Phase
_) = String -> SDoc
text String
f
instance Outputable TargetId where
ppr :: TargetId -> SDoc
ppr = TargetId -> SDoc
pprTargetId
type HomePackageTable = DModuleNameEnv HomeModInfo
type PackageIfaceTable = ModuleEnv ModIface
emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable :: HomePackageTable
emptyHomePackageTable = HomePackageTable
forall elt. UniqDFM elt
emptyUDFM
emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable = PackageIfaceTable
forall a. ModuleEnv a
emptyModuleEnv
pprHPT :: HomePackageTable -> SDoc
pprHPT :: HomePackageTable -> SDoc
pprHPT HomePackageTable
hpt = HomePackageTable -> ([HomeModInfo] -> SDoc) -> SDoc
forall a. UniqDFM a -> ([a] -> SDoc) -> SDoc
pprUDFM HomePackageTable
hpt (([HomeModInfo] -> SDoc) -> SDoc)
-> ([HomeModInfo] -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \[HomeModInfo]
hms ->
[SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hm)))
Int
2 (TypeEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModDetails -> TypeEnv
md_types (HomeModInfo -> ModDetails
hm_details HomeModInfo
hm)))
| HomeModInfo
hm <- [HomeModInfo]
hms ]
lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt = HomePackageTable -> ModuleName -> Maybe HomeModInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM
lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly = HomePackageTable -> Unique -> Maybe HomeModInfo
forall elt. UniqDFM elt -> Unique -> Maybe elt
lookupUDFM_Directly
eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt = HomePackageTable -> [HomeModInfo]
forall elt. UniqDFM elt -> [elt]
eltsUDFM
filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt = (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
forall elt. (elt -> Bool) -> UniqDFM elt -> UniqDFM elt
filterUDFM
allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt = (HomeModInfo -> Bool) -> HomePackageTable -> Bool
forall elt. (elt -> Bool) -> UniqDFM elt -> Bool
allUDFM
mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
mapHpt :: (HomeModInfo -> HomeModInfo)
-> HomePackageTable -> HomePackageTable
mapHpt = (HomeModInfo -> HomeModInfo)
-> HomePackageTable -> HomePackageTable
forall elt1 elt2. (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2
mapUDFM
delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt = HomePackageTable -> ModuleName -> HomePackageTable
forall key elt. Uniquable key => UniqDFM elt -> key -> UniqDFM elt
delFromUDFM
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt = HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
forall key elt.
Uniquable key =>
UniqDFM elt -> key -> elt -> UniqDFM elt
addToUDFM
addListToHpt
:: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt = HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
forall key elt.
Uniquable key =>
UniqDFM elt -> [(key, elt)] -> UniqDFM elt
addListToUDFM
listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt = [(ModuleName, HomeModInfo)] -> HomePackageTable
forall key elt. Uniquable key => [(key, elt)] -> UniqDFM elt
listToUDFM
lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule HomePackageTable
hpt Module
mod
= case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (Module -> ModuleName
moduleName Module
mod) of
Just HomeModInfo
hm | ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hm) Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod -> HomeModInfo -> Maybe HomeModInfo
forall a. a -> Maybe a
Just HomeModInfo
hm
Maybe HomeModInfo
_otherwise -> Maybe HomeModInfo
forall a. Maybe a
Nothing
data HomeModInfo
= HomeModInfo {
HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface :: !ModIface,
HomeModInfo -> ModDetails
hm_details :: !ModDetails,
HomeModInfo -> Maybe Linkable
hm_linkable :: !(Maybe Linkable)
}
lookupIfaceByModule
:: HomePackageTable
-> PackageIfaceTable
-> Module
-> Maybe ModIface
lookupIfaceByModule :: HomePackageTable
-> PackageIfaceTable -> Module -> Maybe (ModIface_ 'ModIfaceFinal)
lookupIfaceByModule HomePackageTable
hpt PackageIfaceTable
pit Module
mod
= case HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule HomePackageTable
hpt Module
mod of
Just HomeModInfo
hm -> ModIface_ 'ModIfaceFinal -> Maybe (ModIface_ 'ModIfaceFinal)
forall a. a -> Maybe a
Just (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
hm)
Maybe HomeModInfo
Nothing -> PackageIfaceTable -> Module -> Maybe (ModIface_ 'ModIfaceFinal)
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv PackageIfaceTable
pit Module
mod
hptCompleteSigs :: HscEnv -> [CompleteMatch]
hptCompleteSigs :: HscEnv -> [CompleteMatch]
hptCompleteSigs = (HomeModInfo -> [CompleteMatch]) -> HscEnv -> [CompleteMatch]
forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings (ModDetails -> [CompleteMatch]
md_complete_sigs (ModDetails -> [CompleteMatch])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [CompleteMatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details)
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
hptInstances HscEnv
hsc_env ModuleName -> Bool
want_this_module
= let ([[ClsInst]]
insts, [[FamInst]]
famInsts) = [([ClsInst], [FamInst])] -> ([[ClsInst]], [[FamInst]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([ClsInst], [FamInst])] -> ([[ClsInst]], [[FamInst]]))
-> [([ClsInst], [FamInst])] -> ([[ClsInst]], [[FamInst]])
forall a b. (a -> b) -> a -> b
$ ((HomeModInfo -> [([ClsInst], [FamInst])])
-> HscEnv -> [([ClsInst], [FamInst])])
-> HscEnv
-> (HomeModInfo -> [([ClsInst], [FamInst])])
-> [([ClsInst], [FamInst])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HomeModInfo -> [([ClsInst], [FamInst])])
-> HscEnv -> [([ClsInst], [FamInst])]
forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings HscEnv
hsc_env ((HomeModInfo -> [([ClsInst], [FamInst])])
-> [([ClsInst], [FamInst])])
-> (HomeModInfo -> [([ClsInst], [FamInst])])
-> [([ClsInst], [FamInst])]
forall a b. (a -> b) -> a -> b
$ \HomeModInfo
mod_info -> do
Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModuleName -> Bool
want_this_module (Module -> ModuleName
moduleName (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (HomeModInfo -> ModIface_ 'ModIfaceFinal
hm_iface HomeModInfo
mod_info))))
let details :: ModDetails
details = HomeModInfo -> ModDetails
hm_details HomeModInfo
mod_info
([ClsInst], [FamInst]) -> [([ClsInst], [FamInst])]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> [ClsInst]
md_insts ModDetails
details, ModDetails -> [FamInst]
md_fam_insts ModDetails
details)
in ([[ClsInst]] -> [ClsInst]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClsInst]]
insts, [[FamInst]] -> [FamInst]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FamInst]]
famInsts)
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
hptRules :: HscEnv -> [(ModuleName, Bool)] -> [CoreRule]
hptRules = (HomeModInfo -> [CoreRule])
-> Bool -> HscEnv -> [(ModuleName, Bool)] -> [CoreRule]
forall a.
(HomeModInfo -> [a])
-> Bool -> HscEnv -> [(ModuleName, Bool)] -> [a]
hptSomeThingsBelowUs (ModDetails -> [CoreRule]
md_rules (ModDetails -> [CoreRule])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [CoreRule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details) Bool
False
hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
hptAnns :: HscEnv -> Maybe [(ModuleName, Bool)] -> [Annotation]
hptAnns HscEnv
hsc_env (Just [(ModuleName, Bool)]
deps) = (HomeModInfo -> [Annotation])
-> Bool -> HscEnv -> [(ModuleName, Bool)] -> [Annotation]
forall a.
(HomeModInfo -> [a])
-> Bool -> HscEnv -> [(ModuleName, Bool)] -> [a]
hptSomeThingsBelowUs (ModDetails -> [Annotation]
md_anns (ModDetails -> [Annotation])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details) Bool
False HscEnv
hsc_env [(ModuleName, Bool)]
deps
hptAnns HscEnv
hsc_env Maybe [(ModuleName, Bool)]
Nothing = (HomeModInfo -> [Annotation]) -> HscEnv -> [Annotation]
forall a. (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings (ModDetails -> [Annotation]
md_anns (ModDetails -> [Annotation])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [Annotation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details) HscEnv
hsc_env
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings HomeModInfo -> [a]
extract HscEnv
hsc_env = (HomeModInfo -> [a]) -> [HomeModInfo] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HomeModInfo -> [a]
extract (HomePackageTable -> [HomeModInfo]
eltsHpt (HscEnv -> HomePackageTable
hsc_HPT HscEnv
hsc_env))
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
hptSomeThingsBelowUs :: (HomeModInfo -> [a])
-> Bool -> HscEnv -> [(ModuleName, Bool)] -> [a]
hptSomeThingsBelowUs HomeModInfo -> [a]
extract Bool
include_hi_boot HscEnv
hsc_env [(ModuleName, Bool)]
deps
| GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)) = []
| Bool
otherwise
= let hpt :: HomePackageTable
hpt = HscEnv -> HomePackageTable
hsc_HPT HscEnv
hsc_env
in
[ a
thing
|
(ModuleName
mod, Bool
is_boot_mod) <- [(ModuleName, Bool)]
deps
, Bool
include_hi_boot Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
is_boot_mod
, ModuleName
mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> ModuleName
moduleName Module
gHC_PRIM
, let things :: [a]
things = case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt ModuleName
mod of
Just HomeModInfo
info -> HomeModInfo -> [a]
extract HomeModInfo
info
Maybe HomeModInfo
Nothing -> String -> SDoc -> [a] -> [a]
forall a. String -> SDoc -> a -> a
pprTrace String
"WARNING in hptSomeThingsBelowUs" SDoc
msg []
msg :: SDoc
msg = [SDoc] -> SDoc
vcat [String -> SDoc
text String
"missing module" SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod,
String -> SDoc
text String
"Probable cause: out-of-date interface files"]
, a
thing <- [a]
things ]
data MetaRequest
= MetaE (LHsExpr GhcPs -> MetaResult)
| MetaP (LPat GhcPs -> MetaResult)
| MetaT (LHsType GhcPs -> MetaResult)
| MetaD ([LHsDecl GhcPs] -> MetaResult)
| MetaAW (Serialized -> MetaResult)
data MetaResult
= MetaResE { MetaResult -> LHsExpr GhcPs
unMetaResE :: LHsExpr GhcPs }
| MetaResP { MetaResult -> LPat GhcPs
unMetaResP :: LPat GhcPs }
| MetaResT { MetaResult -> LHsType GhcPs
unMetaResT :: LHsType GhcPs }
| MetaResD { MetaResult -> [LHsDecl GhcPs]
unMetaResD :: [LHsDecl GhcPs] }
| MetaResAW { MetaResult -> Serialized
unMetaResAW :: Serialized }
type MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult
metaRequestE :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)
metaRequestE :: MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)
metaRequestE MetaHook f
h = (MetaResult -> LHsExpr GhcPs) -> f MetaResult -> f (LHsExpr GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> LHsExpr GhcPs
unMetaResE (f MetaResult -> f (LHsExpr GhcPs))
-> (LHsExpr GhcTc -> f MetaResult)
-> LHsExpr GhcTc
-> f (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LHsExpr GhcPs -> MetaResult) -> MetaRequest
MetaE LHsExpr GhcPs -> MetaResult
MetaResE)
metaRequestP :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)
metaRequestP :: MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)
metaRequestP MetaHook f
h = (MetaResult -> Located (Pat GhcPs))
-> f MetaResult -> f (Located (Pat GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> Located (Pat GhcPs)
MetaResult -> LPat GhcPs
unMetaResP (f MetaResult -> f (Located (Pat GhcPs)))
-> (LHsExpr GhcTc -> f MetaResult)
-> LHsExpr GhcTc
-> f (Located (Pat GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LPat GhcPs -> MetaResult) -> MetaRequest
MetaP LPat GhcPs -> MetaResult
MetaResP)
metaRequestT :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)
metaRequestT :: MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)
metaRequestT MetaHook f
h = (MetaResult -> LHsType GhcPs) -> f MetaResult -> f (LHsType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> LHsType GhcPs
unMetaResT (f MetaResult -> f (LHsType GhcPs))
-> (LHsExpr GhcTc -> f MetaResult)
-> LHsExpr GhcTc
-> f (LHsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((LHsType GhcPs -> MetaResult) -> MetaRequest
MetaT LHsType GhcPs -> MetaResult
MetaResT)
metaRequestD :: Functor f => MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]
metaRequestD :: MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]
metaRequestD MetaHook f
h = (MetaResult -> [LHsDecl GhcPs])
-> f MetaResult -> f [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> [LHsDecl GhcPs]
unMetaResD (f MetaResult -> f [LHsDecl GhcPs])
-> (LHsExpr GhcTc -> f MetaResult)
-> LHsExpr GhcTc
-> f [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h (([LHsDecl GhcPs] -> MetaResult) -> MetaRequest
MetaD [LHsDecl GhcPs] -> MetaResult
MetaResD)
metaRequestAW :: Functor f => MetaHook f -> LHsExpr GhcTc -> f Serialized
metaRequestAW :: MetaHook f -> LHsExpr GhcTc -> f Serialized
metaRequestAW MetaHook f
h = (MetaResult -> Serialized) -> f MetaResult -> f Serialized
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaResult -> Serialized
unMetaResAW (f MetaResult -> f Serialized)
-> (LHsExpr GhcTc -> f MetaResult) -> LHsExpr GhcTc -> f Serialized
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaHook f
h ((Serialized -> MetaResult) -> MetaRequest
MetaAW Serialized -> MetaResult
MetaResAW)
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
prepareAnnotations HscEnv
hsc_env Maybe ModGuts
mb_guts = do
ExternalPackageState
eps <- HscEnv -> IO ExternalPackageState
hscEPS HscEnv
hsc_env
let
mb_this_module_anns :: Maybe AnnEnv
mb_this_module_anns = (ModGuts -> AnnEnv) -> Maybe ModGuts -> Maybe AnnEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Annotation] -> AnnEnv
mkAnnEnv ([Annotation] -> AnnEnv)
-> (ModGuts -> [Annotation]) -> ModGuts -> AnnEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModGuts -> [Annotation]
mg_anns) Maybe ModGuts
mb_guts
home_pkg_anns :: AnnEnv
home_pkg_anns = ([Annotation] -> AnnEnv
mkAnnEnv ([Annotation] -> AnnEnv)
-> (Maybe [(ModuleName, Bool)] -> [Annotation])
-> Maybe [(ModuleName, Bool)]
-> AnnEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> Maybe [(ModuleName, Bool)] -> [Annotation]
hptAnns HscEnv
hsc_env) (Maybe [(ModuleName, Bool)] -> AnnEnv)
-> Maybe [(ModuleName, Bool)] -> AnnEnv
forall a b. (a -> b) -> a -> b
$ (ModGuts -> [(ModuleName, Bool)])
-> Maybe ModGuts -> Maybe [(ModuleName, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dependencies -> [(ModuleName, Bool)]
dep_mods (Dependencies -> [(ModuleName, Bool)])
-> (ModGuts -> Dependencies) -> ModGuts -> [(ModuleName, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModGuts -> Dependencies
mg_deps) Maybe ModGuts
mb_guts
other_pkg_anns :: AnnEnv
other_pkg_anns = ExternalPackageState -> AnnEnv
eps_ann_env ExternalPackageState
eps
ann_env :: AnnEnv
ann_env = (AnnEnv -> AnnEnv -> AnnEnv) -> [AnnEnv] -> AnnEnv
forall a. (a -> a -> a) -> [a] -> a
foldl1' AnnEnv -> AnnEnv -> AnnEnv
plusAnnEnv ([AnnEnv] -> AnnEnv) -> [AnnEnv] -> AnnEnv
forall a b. (a -> b) -> a -> b
$ [Maybe AnnEnv] -> [AnnEnv]
forall a. [Maybe a] -> [a]
catMaybes [Maybe AnnEnv
mb_this_module_anns,
AnnEnv -> Maybe AnnEnv
forall a. a -> Maybe a
Just AnnEnv
home_pkg_anns,
AnnEnv -> Maybe AnnEnv
forall a. a -> Maybe a
Just AnnEnv
other_pkg_anns]
AnnEnv -> IO AnnEnv
forall (m :: * -> *) a. Monad m => a -> m a
return AnnEnv
ann_env
type FinderCache = InstalledModuleEnv InstalledFindResult
data InstalledFindResult
= InstalledFound ModLocation InstalledModule
| InstalledNoPackage InstalledUnitId
| InstalledNotFound [FilePath] (Maybe InstalledUnitId)
data FindResult
= Found ModLocation Module
| NoPackage UnitId
| FoundMultiple [(Module, ModuleOrigin)]
| NotFound
{ FindResult -> [String]
fr_paths :: [FilePath]
, FindResult -> Maybe UnitId
fr_pkg :: Maybe UnitId
, FindResult -> [UnitId]
fr_mods_hidden :: [UnitId]
, FindResult -> [UnitId]
fr_pkgs_hidden :: [UnitId]
, FindResult -> [(UnitId, UnusablePackageReason)]
fr_unusables :: [(UnitId, UnusablePackageReason)]
, FindResult -> [ModuleSuggestion]
fr_suggestions :: [ModuleSuggestion]
}
type PartialModIface = ModIface_ 'ModIfaceCore
type ModIface = ModIface_ 'ModIfaceFinal
data ModIfaceBackend = ModIfaceBackend
{ ModIfaceBackend -> Fingerprint
mi_iface_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_mod_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_flag_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_opt_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_hpc_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_plugin_hash :: !Fingerprint
, ModIfaceBackend -> Bool
mi_orphan :: !WhetherHasOrphans
, ModIfaceBackend -> Bool
mi_finsts :: !WhetherHasFamInst
, ModIfaceBackend -> Fingerprint
mi_exp_hash :: !Fingerprint
, ModIfaceBackend -> Fingerprint
mi_orphan_hash :: !Fingerprint
, ModIfaceBackend -> OccName -> Maybe WarningTxt
mi_warn_fn :: !(OccName -> Maybe WarningTxt)
, ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn :: !(OccName -> Maybe Fixity)
, ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))
}
data ModIfacePhase
= ModIfaceCore
| ModIfaceFinal
type family IfaceDeclExts (phase :: ModIfacePhase) where
IfaceDeclExts 'ModIfaceCore = IfaceDecl
IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl)
type family IfaceBackendExts (phase :: ModIfacePhase) where
IfaceBackendExts 'ModIfaceCore = ()
IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend
data ModIface_ (phase :: ModIfacePhase)
= ModIface {
ModIface_ phase -> Module
mi_module :: !Module,
ModIface_ phase -> Maybe Module
mi_sig_of :: !(Maybe Module),
ModIface_ phase -> HscSource
mi_hsc_src :: !HscSource,
ModIface_ phase -> Dependencies
mi_deps :: Dependencies,
ModIface_ phase -> [Usage]
mi_usages :: [Usage],
ModIface_ phase -> [IfaceExport]
mi_exports :: ![IfaceExport],
ModIface_ phase -> Bool
mi_used_th :: !Bool,
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities :: [(OccName,Fixity)],
ModIface_ phase -> Warnings
mi_warns :: Warnings,
ModIface_ phase -> [IfaceAnnotation]
mi_anns :: [IfaceAnnotation],
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls :: [IfaceDeclExts phase],
ModIface_ phase -> Maybe GlobalRdrEnv
mi_globals :: !(Maybe GlobalRdrEnv),
ModIface_ phase -> [IfaceClsInst]
mi_insts :: [IfaceClsInst],
ModIface_ phase -> [IfaceFamInst]
mi_fam_insts :: [IfaceFamInst],
ModIface_ phase -> [IfaceRule]
mi_rules :: [IfaceRule],
ModIface_ phase -> Bool
mi_hpc :: !AnyHpcUsage,
ModIface_ phase -> IfaceTrustInfo
mi_trust :: !IfaceTrustInfo,
ModIface_ phase -> Bool
mi_trust_pkg :: !Bool,
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs :: [IfaceCompleteMatch],
ModIface_ phase -> Maybe HsDocString
mi_doc_hdr :: Maybe HsDocString,
ModIface_ phase -> DeclDocMap
mi_decl_docs :: DeclDocMap,
ModIface_ phase -> ArgDocMap
mi_arg_docs :: ArgDocMap,
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts :: !(IfaceBackendExts phase)
}
mi_boot :: ModIface -> Bool
mi_boot :: ModIface_ 'ModIfaceFinal -> Bool
mi_boot ModIface_ 'ModIfaceFinal
iface = ModIface_ 'ModIfaceFinal -> HscSource
forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src ModIface_ 'ModIfaceFinal
iface HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsBootFile
mi_fix :: ModIface -> OccName -> Fixity
mi_fix :: ModIface_ 'ModIfaceFinal -> OccName -> Fixity
mi_fix ModIface_ 'ModIfaceFinal
iface OccName
name = ModIfaceBackend -> OccName -> Maybe Fixity
mi_fix_fn (ModIface_ 'ModIfaceFinal -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface_ 'ModIfaceFinal
iface) OccName
name Maybe Fixity -> Fixity -> Fixity
forall a. Maybe a -> a -> a
`orElse` Fixity
defaultFixity
mi_semantic_module :: ModIface_ a -> Module
mi_semantic_module :: ModIface_ a -> Module
mi_semantic_module ModIface_ a
iface = case ModIface_ a -> Maybe Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of ModIface_ a
iface of
Maybe Module
Nothing -> ModIface_ a -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface_ a
iface
Just Module
mod -> Module
mod
mi_free_holes :: ModIface -> UniqDSet ModuleName
mi_free_holes :: ModIface_ 'ModIfaceFinal -> UniqDSet ModuleName
mi_free_holes ModIface_ 'ModIfaceFinal
iface =
case Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts (ModIface_ 'ModIfaceFinal -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface_ 'ModIfaceFinal
iface) of
(InstalledModule
_, Just IndefModule
indef)
-> UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles ([ModuleName] -> UniqDSet ModuleName
forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet [ModuleName]
cands) (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts (IndefModule -> IndefUnitId
indefModuleUnitId IndefModule
indef))
(InstalledModule, Maybe IndefModule)
_ -> UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet
where
cands :: [ModuleName]
cands = ((ModuleName, Bool) -> ModuleName)
-> [(ModuleName, Bool)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Bool) -> ModuleName
forall a b. (a, b) -> a
fst (Dependencies -> [(ModuleName, Bool)]
dep_mods (ModIface_ 'ModIfaceFinal -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface_ 'ModIfaceFinal
iface))
renameFreeHoles :: UniqDSet ModuleName -> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles :: UniqDSet ModuleName
-> [(ModuleName, Module)] -> UniqDSet ModuleName
renameFreeHoles UniqDSet ModuleName
fhs [(ModuleName, Module)]
insts =
[UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets ((ModuleName -> UniqDSet ModuleName)
-> [ModuleName] -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> UniqDSet ModuleName
lookup_impl (UniqDSet ModuleName -> [ModuleName]
forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet ModuleName
fhs))
where
hmap :: UniqFM Module
hmap = [(ModuleName, Module)] -> UniqFM Module
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM [(ModuleName, Module)]
insts
lookup_impl :: ModuleName -> UniqDSet ModuleName
lookup_impl ModuleName
mod_name
| Just Module
mod <- UniqFM Module -> ModuleName -> Maybe Module
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM Module
hmap ModuleName
mod_name = Module -> UniqDSet ModuleName
moduleFreeHoles Module
mod
| Bool
otherwise = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet
instance Binary ModIface where
put_ :: BinHandle -> ModIface_ 'ModIfaceFinal -> IO ()
put_ BinHandle
bh (ModIface {
mi_module :: forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module = Module
mod,
mi_sig_of :: forall (phase :: ModIfacePhase). ModIface_ phase -> Maybe Module
mi_sig_of = Maybe Module
sig_of,
mi_hsc_src :: forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
mi_hsc_src = HscSource
hsc_src,
mi_deps :: forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps = Dependencies
deps,
mi_usages :: forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages = [Usage]
usages,
mi_exports :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports = [IfaceExport]
exports,
mi_used_th :: forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_used_th = Bool
used_th,
mi_fixities :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
mi_warns :: forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings
mi_warns = Warnings
warns,
mi_anns :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns = [IfaceAnnotation]
anns,
mi_decls :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls = [IfaceDeclExts 'ModIfaceFinal]
decls,
mi_insts :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts = [IfaceClsInst]
insts,
mi_fam_insts :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts = [IfaceFamInst]
fam_insts,
mi_rules :: forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules = [IfaceRule]
rules,
mi_hpc :: forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_hpc = Bool
hpc_info,
mi_trust :: forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust = IfaceTrustInfo
trust,
mi_trust_pkg :: forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
mi_trust_pkg = Bool
trust_pkg,
mi_complete_sigs :: forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs = [IfaceCompleteMatch]
complete_sigs,
mi_doc_hdr :: forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe HsDocString
mi_doc_hdr = Maybe HsDocString
doc_hdr,
mi_decl_docs :: forall (phase :: ModIfacePhase). ModIface_ phase -> DeclDocMap
mi_decl_docs = DeclDocMap
decl_docs,
mi_arg_docs :: forall (phase :: ModIfacePhase). ModIface_ phase -> ArgDocMap
mi_arg_docs = ArgDocMap
arg_docs,
mi_final_exts :: forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts = ModIfaceBackend {
mi_iface_hash = iface_hash,
mi_mod_hash = mod_hash,
mi_flag_hash = flag_hash,
mi_opt_hash = opt_hash,
mi_hpc_hash = hpc_hash,
mi_plugin_hash = plugin_hash,
mi_orphan = orphan,
mi_finsts = hasFamInsts,
mi_exp_hash = exp_hash,
mi_orphan_hash = orphan_hash
}}) = do
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
mod
BinHandle -> Maybe Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Module
sig_of
BinHandle -> HscSource -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HscSource
hsc_src
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
iface_hash
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
mod_hash
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
flag_hash
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
opt_hash
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
hpc_hash
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
plugin_hash
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
orphan
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
hasFamInsts
BinHandle -> Dependencies -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Dependencies
deps
BinHandle -> [Usage] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [Usage]
usages
BinHandle -> [IfaceExport] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExport]
exports
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
exp_hash
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
used_th
BinHandle -> [(OccName, Fixity)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, Fixity)]
fixities
BinHandle -> Warnings -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Warnings
warns
BinHandle -> [IfaceAnnotation] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceAnnotation]
anns
BinHandle -> [(Fingerprint, IfaceDecl)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(Fingerprint, IfaceDecl)]
[IfaceDeclExts 'ModIfaceFinal]
decls
BinHandle -> [IfaceClsInst] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceClsInst]
insts
BinHandle -> [IfaceFamInst] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceFamInst]
fam_insts
BinHandle -> [IfaceRule] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceRule]
rules
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Fingerprint
orphan_hash
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
hpc_info
BinHandle -> IfaceTrustInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTrustInfo
trust
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
trust_pkg
BinHandle -> [IfaceCompleteMatch] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCompleteMatch]
complete_sigs
BinHandle -> Maybe HsDocString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh Maybe HsDocString
doc_hdr
BinHandle -> DeclDocMap -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh DeclDocMap
decl_docs
BinHandle -> ArgDocMap -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh ArgDocMap
arg_docs
get :: BinHandle -> IO (ModIface_ 'ModIfaceFinal)
get BinHandle
bh = do
Module
mod <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe Module
sig_of <- BinHandle -> IO (Maybe Module)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
HscSource
hsc_src <- BinHandle -> IO HscSource
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
iface_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
flag_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
opt_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hpc_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
plugin_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
orphan <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
hasFamInsts <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Dependencies
deps <- BinHandle -> IO Dependencies
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[Usage]
usages <- {-# SCC "bin_usages" #-} BinHandle -> IO [Usage]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[IfaceExport]
exports <- {-# SCC "bin_exports" #-} BinHandle -> IO [IfaceExport]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
exp_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
used_th <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(OccName, Fixity)]
fixities <- {-# SCC "bin_fixities" #-} BinHandle -> IO [(OccName, Fixity)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings
warns <- {-# SCC "bin_warns" #-} BinHandle -> IO Warnings
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[IfaceAnnotation]
anns <- {-# SCC "bin_anns" #-} BinHandle -> IO [IfaceAnnotation]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
[(Fingerprint, IfaceDecl)]
decls <- {-# SCC "bin_tycldecls" #-} BinHandle -> IO [(Fingerprint, IfaceDecl)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceClsInst]
insts <- {-# SCC "bin_insts" #-} BinHandle -> IO [IfaceClsInst]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceFamInst]
fam_insts <- {-# SCC "bin_fam_insts" #-} BinHandle -> IO [IfaceFamInst]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceRule]
rules <- {-# SCC "bin_rules" #-} BinHandle -> IO [IfaceRule]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
Fingerprint
orphan_hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
hpc_info <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IfaceTrustInfo
trust <- BinHandle -> IO IfaceTrustInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
trust_pkg <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[IfaceCompleteMatch]
complete_sigs <- BinHandle -> IO [IfaceCompleteMatch]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe HsDocString
doc_hdr <- BinHandle -> IO (Maybe HsDocString)
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
DeclDocMap
decl_docs <- BinHandle -> IO DeclDocMap
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
ArgDocMap
arg_docs <- BinHandle -> IO ArgDocMap
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
ModIface_ 'ModIfaceFinal -> IO (ModIface_ 'ModIfaceFinal)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIface :: forall (phase :: ModIfacePhase).
Module
-> Maybe Module
-> HscSource
-> Dependencies
-> [Usage]
-> [IfaceExport]
-> Bool
-> [(OccName, Fixity)]
-> Warnings
-> [IfaceAnnotation]
-> [IfaceDeclExts phase]
-> Maybe GlobalRdrEnv
-> [IfaceClsInst]
-> [IfaceFamInst]
-> [IfaceRule]
-> Bool
-> IfaceTrustInfo
-> Bool
-> [IfaceCompleteMatch]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> IfaceBackendExts phase
-> ModIface_ phase
ModIface {
mi_module :: Module
mi_module = Module
mod,
mi_sig_of :: Maybe Module
mi_sig_of = Maybe Module
sig_of,
mi_hsc_src :: HscSource
mi_hsc_src = HscSource
hsc_src,
mi_deps :: Dependencies
mi_deps = Dependencies
deps,
mi_usages :: [Usage]
mi_usages = [Usage]
usages,
mi_exports :: [IfaceExport]
mi_exports = [IfaceExport]
exports,
mi_used_th :: Bool
mi_used_th = Bool
used_th,
mi_anns :: [IfaceAnnotation]
mi_anns = [IfaceAnnotation]
anns,
mi_fixities :: [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
mi_warns :: Warnings
mi_warns = Warnings
warns,
mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = [(Fingerprint, IfaceDecl)]
[IfaceDeclExts 'ModIfaceFinal]
decls,
mi_globals :: Maybe GlobalRdrEnv
mi_globals = Maybe GlobalRdrEnv
forall a. Maybe a
Nothing,
mi_insts :: [IfaceClsInst]
mi_insts = [IfaceClsInst]
insts,
mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = [IfaceFamInst]
fam_insts,
mi_rules :: [IfaceRule]
mi_rules = [IfaceRule]
rules,
mi_hpc :: Bool
mi_hpc = Bool
hpc_info,
mi_trust :: IfaceTrustInfo
mi_trust = IfaceTrustInfo
trust,
mi_trust_pkg :: Bool
mi_trust_pkg = Bool
trust_pkg,
mi_complete_sigs :: [IfaceCompleteMatch]
mi_complete_sigs = [IfaceCompleteMatch]
complete_sigs,
mi_doc_hdr :: Maybe HsDocString
mi_doc_hdr = Maybe HsDocString
doc_hdr,
mi_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
decl_docs,
mi_arg_docs :: ArgDocMap
mi_arg_docs = ArgDocMap
arg_docs,
mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = ModIfaceBackend :: Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Bool
-> Bool
-> Fingerprint
-> Fingerprint
-> (OccName -> Maybe WarningTxt)
-> (OccName -> Maybe Fixity)
-> (OccName -> Maybe (OccName, Fingerprint))
-> ModIfaceBackend
ModIfaceBackend {
mi_iface_hash :: Fingerprint
mi_iface_hash = Fingerprint
iface_hash,
mi_mod_hash :: Fingerprint
mi_mod_hash = Fingerprint
mod_hash,
mi_flag_hash :: Fingerprint
mi_flag_hash = Fingerprint
flag_hash,
mi_opt_hash :: Fingerprint
mi_opt_hash = Fingerprint
opt_hash,
mi_hpc_hash :: Fingerprint
mi_hpc_hash = Fingerprint
hpc_hash,
mi_plugin_hash :: Fingerprint
mi_plugin_hash = Fingerprint
plugin_hash,
mi_orphan :: Bool
mi_orphan = Bool
orphan,
mi_finsts :: Bool
mi_finsts = Bool
hasFamInsts,
mi_exp_hash :: Fingerprint
mi_exp_hash = Fingerprint
exp_hash,
mi_orphan_hash :: Fingerprint
mi_orphan_hash = Fingerprint
orphan_hash,
mi_warn_fn :: OccName -> Maybe WarningTxt
mi_warn_fn = Warnings -> OccName -> Maybe WarningTxt
mkIfaceWarnCache Warnings
warns,
mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
fixities,
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn = [(Fingerprint, IfaceDecl)]
-> OccName -> Maybe (OccName, Fingerprint)
mkIfaceHashCache [(Fingerprint, IfaceDecl)]
decls
}})
type IfaceExport = AvailInfo
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface :: Module -> PartialModIface
emptyPartialModIface Module
mod
= ModIface :: forall (phase :: ModIfacePhase).
Module
-> Maybe Module
-> HscSource
-> Dependencies
-> [Usage]
-> [IfaceExport]
-> Bool
-> [(OccName, Fixity)]
-> Warnings
-> [IfaceAnnotation]
-> [IfaceDeclExts phase]
-> Maybe GlobalRdrEnv
-> [IfaceClsInst]
-> [IfaceFamInst]
-> [IfaceRule]
-> Bool
-> IfaceTrustInfo
-> Bool
-> [IfaceCompleteMatch]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> IfaceBackendExts phase
-> ModIface_ phase
ModIface { mi_module :: Module
mi_module = Module
mod,
mi_sig_of :: Maybe Module
mi_sig_of = Maybe Module
forall a. Maybe a
Nothing,
mi_hsc_src :: HscSource
mi_hsc_src = HscSource
HsSrcFile,
mi_deps :: Dependencies
mi_deps = Dependencies
noDependencies,
mi_usages :: [Usage]
mi_usages = [],
mi_exports :: [IfaceExport]
mi_exports = [],
mi_used_th :: Bool
mi_used_th = Bool
False,
mi_fixities :: [(OccName, Fixity)]
mi_fixities = [],
mi_warns :: Warnings
mi_warns = Warnings
NoWarnings,
mi_anns :: [IfaceAnnotation]
mi_anns = [],
mi_insts :: [IfaceClsInst]
mi_insts = [],
mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = [],
mi_rules :: [IfaceRule]
mi_rules = [],
mi_decls :: [IfaceDeclExts 'ModIfaceCore]
mi_decls = [],
mi_globals :: Maybe GlobalRdrEnv
mi_globals = Maybe GlobalRdrEnv
forall a. Maybe a
Nothing,
mi_hpc :: Bool
mi_hpc = Bool
False,
mi_trust :: IfaceTrustInfo
mi_trust = IfaceTrustInfo
noIfaceTrustInfo,
mi_trust_pkg :: Bool
mi_trust_pkg = Bool
False,
mi_complete_sigs :: [IfaceCompleteMatch]
mi_complete_sigs = [],
mi_doc_hdr :: Maybe HsDocString
mi_doc_hdr = Maybe HsDocString
forall a. Maybe a
Nothing,
mi_decl_docs :: DeclDocMap
mi_decl_docs = DeclDocMap
emptyDeclDocMap,
mi_arg_docs :: ArgDocMap
mi_arg_docs = ArgDocMap
emptyArgDocMap,
mi_final_exts :: IfaceBackendExts 'ModIfaceCore
mi_final_exts = () }
emptyFullModIface :: Module -> ModIface
emptyFullModIface :: Module -> ModIface_ 'ModIfaceFinal
emptyFullModIface Module
mod =
(Module -> PartialModIface
emptyPartialModIface Module
mod)
{ mi_decls :: [IfaceDeclExts 'ModIfaceFinal]
mi_decls = []
, mi_final_exts :: IfaceBackendExts 'ModIfaceFinal
mi_final_exts = ModIfaceBackend :: Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Bool
-> Bool
-> Fingerprint
-> Fingerprint
-> (OccName -> Maybe WarningTxt)
-> (OccName -> Maybe Fixity)
-> (OccName -> Maybe (OccName, Fingerprint))
-> ModIfaceBackend
ModIfaceBackend
{ mi_iface_hash :: Fingerprint
mi_iface_hash = Fingerprint
fingerprint0,
mi_mod_hash :: Fingerprint
mi_mod_hash = Fingerprint
fingerprint0,
mi_flag_hash :: Fingerprint
mi_flag_hash = Fingerprint
fingerprint0,
mi_opt_hash :: Fingerprint
mi_opt_hash = Fingerprint
fingerprint0,
mi_hpc_hash :: Fingerprint
mi_hpc_hash = Fingerprint
fingerprint0,
mi_plugin_hash :: Fingerprint
mi_plugin_hash = Fingerprint
fingerprint0,
mi_orphan :: Bool
mi_orphan = Bool
False,
mi_finsts :: Bool
mi_finsts = Bool
False,
mi_exp_hash :: Fingerprint
mi_exp_hash = Fingerprint
fingerprint0,
mi_orphan_hash :: Fingerprint
mi_orphan_hash = Fingerprint
fingerprint0,
mi_warn_fn :: OccName -> Maybe WarningTxt
mi_warn_fn = OccName -> Maybe WarningTxt
emptyIfaceWarnCache,
mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = OccName -> Maybe Fixity
emptyIfaceFixCache,
mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn = OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache } }
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
-> (OccName -> Maybe (OccName, Fingerprint))
mkIfaceHashCache :: [(Fingerprint, IfaceDecl)]
-> OccName -> Maybe (OccName, Fingerprint)
mkIfaceHashCache [(Fingerprint, IfaceDecl)]
pairs
= \OccName
occ -> OccEnv (OccName, Fingerprint)
-> OccName -> Maybe (OccName, Fingerprint)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (OccName, Fingerprint)
env OccName
occ
where
env :: OccEnv (OccName, Fingerprint)
env = (OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint))
-> OccEnv (OccName, Fingerprint)
-> [(Fingerprint, IfaceDecl)]
-> OccEnv (OccName, Fingerprint)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint)
add_decl OccEnv (OccName, Fingerprint)
forall a. OccEnv a
emptyOccEnv [(Fingerprint, IfaceDecl)]
pairs
add_decl :: OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> OccEnv (OccName, Fingerprint)
add_decl OccEnv (OccName, Fingerprint)
env0 (Fingerprint
v,IfaceDecl
d) = (OccEnv (OccName, Fingerprint)
-> (OccName, Fingerprint) -> OccEnv (OccName, Fingerprint))
-> OccEnv (OccName, Fingerprint)
-> [(OccName, Fingerprint)]
-> OccEnv (OccName, Fingerprint)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv (OccName, Fingerprint)
-> (OccName, Fingerprint) -> OccEnv (OccName, Fingerprint)
forall b.
OccEnv (OccName, b) -> (OccName, b) -> OccEnv (OccName, b)
add OccEnv (OccName, Fingerprint)
env0 (Fingerprint -> IfaceDecl -> [(OccName, Fingerprint)]
ifaceDeclFingerprints Fingerprint
v IfaceDecl
d)
where
add :: OccEnv (OccName, b) -> (OccName, b) -> OccEnv (OccName, b)
add OccEnv (OccName, b)
env0 (OccName
occ,b
hash) = OccEnv (OccName, b)
-> OccName -> (OccName, b) -> OccEnv (OccName, b)
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv (OccName, b)
env0 OccName
occ (OccName
occ,b
hash)
emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache OccName
_occ = Maybe (OccName, Fingerprint)
forall a. Maybe a
Nothing
data ModDetails
= ModDetails {
ModDetails -> [IfaceExport]
md_exports :: [AvailInfo],
ModDetails -> TypeEnv
md_types :: !TypeEnv,
ModDetails -> [ClsInst]
md_insts :: ![ClsInst],
ModDetails -> [FamInst]
md_fam_insts :: ![FamInst],
ModDetails -> [CoreRule]
md_rules :: ![CoreRule],
ModDetails -> [Annotation]
md_anns :: ![Annotation],
ModDetails -> [CompleteMatch]
md_complete_sigs :: [CompleteMatch]
}
emptyModDetails :: ModDetails
emptyModDetails :: ModDetails
emptyModDetails
= ModDetails :: [IfaceExport]
-> TypeEnv
-> [ClsInst]
-> [FamInst]
-> [CoreRule]
-> [Annotation]
-> [CompleteMatch]
-> ModDetails
ModDetails { md_types :: TypeEnv
md_types = TypeEnv
emptyTypeEnv,
md_exports :: [IfaceExport]
md_exports = [],
md_insts :: [ClsInst]
md_insts = [],
md_rules :: [CoreRule]
md_rules = [],
md_fam_insts :: [FamInst]
md_fam_insts = [],
md_anns :: [Annotation]
md_anns = [],
md_complete_sigs :: [CompleteMatch]
md_complete_sigs = [] }
type ImportedMods = ModuleEnv [ImportedBy]
data ImportedBy
= ImportedByUser ImportedModsVal
| ImportedBySystem
importedByUser :: [ImportedBy] -> [ImportedModsVal]
importedByUser :: [ImportedBy] -> [ImportedModsVal]
importedByUser (ImportedByUser ImportedModsVal
imv : [ImportedBy]
bys) = ImportedModsVal
imv ImportedModsVal -> [ImportedModsVal] -> [ImportedModsVal]
forall a. a -> [a] -> [a]
: [ImportedBy] -> [ImportedModsVal]
importedByUser [ImportedBy]
bys
importedByUser (ImportedBy
ImportedBySystem : [ImportedBy]
bys) = [ImportedBy] -> [ImportedModsVal]
importedByUser [ImportedBy]
bys
importedByUser [] = []
data ImportedModsVal
= ImportedModsVal {
ImportedModsVal -> ModuleName
imv_name :: ModuleName,
ImportedModsVal -> SrcSpan
imv_span :: SrcSpan,
ImportedModsVal -> Bool
imv_is_safe :: IsSafeImport,
ImportedModsVal -> Bool
imv_is_hiding :: Bool,
ImportedModsVal -> GlobalRdrEnv
imv_all_exports :: !GlobalRdrEnv,
ImportedModsVal -> Bool
imv_qualified :: Bool
}
data ModGuts
= ModGuts {
ModGuts -> Module
mg_module :: !Module,
ModGuts -> HscSource
mg_hsc_src :: HscSource,
ModGuts -> SrcSpan
mg_loc :: SrcSpan,
ModGuts -> [IfaceExport]
mg_exports :: ![AvailInfo],
ModGuts -> Dependencies
mg_deps :: !Dependencies,
ModGuts -> [Usage]
mg_usages :: ![Usage],
ModGuts -> Bool
mg_used_th :: !Bool,
ModGuts -> GlobalRdrEnv
mg_rdr_env :: !GlobalRdrEnv,
ModGuts -> FixityEnv
mg_fix_env :: !FixityEnv,
ModGuts -> [TyCon]
mg_tcs :: ![TyCon],
ModGuts -> [ClsInst]
mg_insts :: ![ClsInst],
ModGuts -> [FamInst]
mg_fam_insts :: ![FamInst],
ModGuts -> [PatSyn]
mg_patsyns :: ![PatSyn],
ModGuts -> [CoreRule]
mg_rules :: ![CoreRule],
ModGuts -> CoreProgram
mg_binds :: !CoreProgram,
ModGuts -> ForeignStubs
mg_foreign :: !ForeignStubs,
ModGuts -> [(ForeignSrcLang, String)]
mg_foreign_files :: ![(ForeignSrcLang, FilePath)],
ModGuts -> Warnings
mg_warns :: !Warnings,
ModGuts -> [Annotation]
mg_anns :: [Annotation],
ModGuts -> [CompleteMatch]
mg_complete_sigs :: [CompleteMatch],
ModGuts -> HpcInfo
mg_hpc_info :: !HpcInfo,
ModGuts -> Maybe ModBreaks
mg_modBreaks :: !(Maybe ModBreaks),
ModGuts -> InstEnv
mg_inst_env :: InstEnv,
ModGuts -> FamInstEnv
mg_fam_inst_env :: FamInstEnv,
ModGuts -> SafeHaskellMode
mg_safe_haskell :: SafeHaskellMode,
ModGuts -> Bool
mg_trust_pkg :: Bool,
ModGuts -> Maybe HsDocString
mg_doc_hdr :: !(Maybe HsDocString),
ModGuts -> DeclDocMap
mg_decl_docs :: !DeclDocMap,
ModGuts -> ArgDocMap
mg_arg_docs :: !ArgDocMap
}
data CgGuts
= CgGuts {
CgGuts -> Module
cg_module :: !Module,
CgGuts -> [TyCon]
cg_tycons :: [TyCon],
CgGuts -> CoreProgram
cg_binds :: CoreProgram,
CgGuts -> ForeignStubs
cg_foreign :: !ForeignStubs,
CgGuts -> [(ForeignSrcLang, String)]
cg_foreign_files :: ![(ForeignSrcLang, FilePath)],
CgGuts -> [InstalledUnitId]
cg_dep_pkgs :: ![InstalledUnitId],
CgGuts -> HpcInfo
cg_hpc_info :: !HpcInfo,
CgGuts -> Maybe ModBreaks
cg_modBreaks :: !(Maybe ModBreaks),
CgGuts -> [SptEntry]
cg_spt_entries :: [SptEntry]
}
data ForeignStubs
= NoStubs
| ForeignStubs SDoc SDoc
appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
appendStubC ForeignStubs
NoStubs SDoc
c_code = SDoc -> SDoc -> ForeignStubs
ForeignStubs SDoc
empty SDoc
c_code
appendStubC (ForeignStubs SDoc
h SDoc
c) SDoc
c_code = SDoc -> SDoc -> ForeignStubs
ForeignStubs SDoc
h (SDoc
c SDoc -> SDoc -> SDoc
$$ SDoc
c_code)
data InteractiveContext
= InteractiveContext {
InteractiveContext -> DynFlags
ic_dflags :: DynFlags,
InteractiveContext -> Int
ic_mod_index :: Int,
InteractiveContext -> [InteractiveImport]
ic_imports :: [InteractiveImport],
InteractiveContext -> [TyThing]
ic_tythings :: [TyThing],
InteractiveContext -> GlobalRdrEnv
ic_rn_gbl_env :: GlobalRdrEnv,
InteractiveContext -> ([ClsInst], [FamInst])
ic_instances :: ([ClsInst], [FamInst]),
InteractiveContext -> FixityEnv
ic_fix_env :: FixityEnv,
InteractiveContext -> Maybe [Type]
ic_default :: Maybe [Type],
InteractiveContext -> [Resume]
ic_resume :: [Resume],
InteractiveContext -> Name
ic_monad :: Name,
InteractiveContext -> Name
ic_int_print :: Name,
InteractiveContext -> Maybe String
ic_cwd :: Maybe FilePath
}
data InteractiveImport
= IIDecl (ImportDecl GhcPs)
| IIModule ModuleName
emptyInteractiveContext :: DynFlags -> InteractiveContext
emptyInteractiveContext :: DynFlags -> InteractiveContext
emptyInteractiveContext DynFlags
dflags
= InteractiveContext :: DynFlags
-> Int
-> [InteractiveImport]
-> [TyThing]
-> GlobalRdrEnv
-> ([ClsInst], [FamInst])
-> FixityEnv
-> Maybe [Type]
-> [Resume]
-> Name
-> Name
-> Maybe String
-> InteractiveContext
InteractiveContext {
ic_dflags :: DynFlags
ic_dflags = DynFlags
dflags,
ic_imports :: [InteractiveImport]
ic_imports = [],
ic_rn_gbl_env :: GlobalRdrEnv
ic_rn_gbl_env = GlobalRdrEnv
emptyGlobalRdrEnv,
ic_mod_index :: Int
ic_mod_index = Int
1,
ic_tythings :: [TyThing]
ic_tythings = [],
ic_instances :: ([ClsInst], [FamInst])
ic_instances = ([],[]),
ic_fix_env :: FixityEnv
ic_fix_env = FixityEnv
forall a. NameEnv a
emptyNameEnv,
ic_monad :: Name
ic_monad = Name
ioTyConName,
ic_int_print :: Name
ic_int_print = Name
printName,
ic_default :: Maybe [Type]
ic_default = Maybe [Type]
forall a. Maybe a
Nothing,
ic_resume :: [Resume]
ic_resume = [],
ic_cwd :: Maybe String
ic_cwd = Maybe String
forall a. Maybe a
Nothing }
icInteractiveModule :: InteractiveContext -> Module
icInteractiveModule :: InteractiveContext -> Module
icInteractiveModule (InteractiveContext { ic_mod_index :: InteractiveContext -> Int
ic_mod_index = Int
index })
= Int -> Module
mkInteractiveModule Int
index
icInScopeTTs :: InteractiveContext -> [TyThing]
icInScopeTTs :: InteractiveContext -> [TyThing]
icInScopeTTs = InteractiveContext -> [TyThing]
ic_tythings
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
icPrintUnqual DynFlags
dflags InteractiveContext{ ic_rn_gbl_env :: InteractiveContext -> GlobalRdrEnv
ic_rn_gbl_env = GlobalRdrEnv
grenv } =
DynFlags -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualified DynFlags
dflags GlobalRdrEnv
grenv
extendInteractiveContext :: InteractiveContext
-> [TyThing]
-> [ClsInst] -> [FamInst]
-> Maybe [Type]
-> FixityEnv
-> InteractiveContext
extendInteractiveContext :: InteractiveContext
-> [TyThing]
-> [ClsInst]
-> [FamInst]
-> Maybe [Type]
-> FixityEnv
-> InteractiveContext
extendInteractiveContext InteractiveContext
ictxt [TyThing]
new_tythings [ClsInst]
new_cls_insts [FamInst]
new_fam_insts Maybe [Type]
defaults FixityEnv
fix_env
= InteractiveContext
ictxt { ic_mod_index :: Int
ic_mod_index = InteractiveContext -> Int
ic_mod_index InteractiveContext
ictxt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, ic_tythings :: [TyThing]
ic_tythings = [TyThing]
new_tythings [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ [TyThing]
old_tythings
, ic_rn_gbl_env :: GlobalRdrEnv
ic_rn_gbl_env = InteractiveContext -> GlobalRdrEnv
ic_rn_gbl_env InteractiveContext
ictxt GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
`icExtendGblRdrEnv` [TyThing]
new_tythings
, ic_instances :: ([ClsInst], [FamInst])
ic_instances = ( [ClsInst]
new_cls_insts [ClsInst] -> [ClsInst] -> [ClsInst]
forall a. [a] -> [a] -> [a]
++ [ClsInst]
old_cls_insts
, [FamInst]
new_fam_insts [FamInst] -> [FamInst] -> [FamInst]
forall a. [a] -> [a] -> [a]
++ [FamInst]
fam_insts )
, ic_default :: Maybe [Type]
ic_default = Maybe [Type]
defaults
, ic_fix_env :: FixityEnv
ic_fix_env = FixityEnv
fix_env
}
where
new_ids :: [Id]
new_ids = [Id
id | AnId Id
id <- [TyThing]
new_tythings]
old_tythings :: [TyThing]
old_tythings = (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filterOut ([Id] -> TyThing -> Bool
shadowed_by [Id]
new_ids) (InteractiveContext -> [TyThing]
ic_tythings InteractiveContext
ictxt)
([ClsInst]
cls_insts, [FamInst]
fam_insts) = InteractiveContext -> ([ClsInst], [FamInst])
ic_instances InteractiveContext
ictxt
old_cls_insts :: [ClsInst]
old_cls_insts = (ClsInst -> Bool) -> [ClsInst] -> [ClsInst]
forall a. (a -> Bool) -> [a] -> [a]
filterOut (\ClsInst
i -> (ClsInst -> Bool) -> [ClsInst] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ClsInst -> ClsInst -> Bool
identicalClsInstHead ClsInst
i) [ClsInst]
new_cls_insts) [ClsInst]
cls_insts
extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
extendInteractiveContextWithIds InteractiveContext
ictxt [Id]
new_ids
| [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
new_ids = InteractiveContext
ictxt
| Bool
otherwise = InteractiveContext
ictxt { ic_mod_index :: Int
ic_mod_index = InteractiveContext -> Int
ic_mod_index InteractiveContext
ictxt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, ic_tythings :: [TyThing]
ic_tythings = [TyThing]
new_tythings [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ [TyThing]
old_tythings
, ic_rn_gbl_env :: GlobalRdrEnv
ic_rn_gbl_env = InteractiveContext -> GlobalRdrEnv
ic_rn_gbl_env InteractiveContext
ictxt GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
`icExtendGblRdrEnv` [TyThing]
new_tythings }
where
new_tythings :: [TyThing]
new_tythings = (Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId [Id]
new_ids
old_tythings :: [TyThing]
old_tythings = (TyThing -> Bool) -> [TyThing] -> [TyThing]
forall a. (a -> Bool) -> [a] -> [a]
filterOut ([Id] -> TyThing -> Bool
shadowed_by [Id]
new_ids) (InteractiveContext -> [TyThing]
ic_tythings InteractiveContext
ictxt)
shadowed_by :: [Id] -> TyThing -> Bool
shadowed_by :: [Id] -> TyThing -> Bool
shadowed_by [Id]
ids = TyThing -> Bool
shadowed
where
shadowed :: TyThing -> Bool
shadowed TyThing
id = TyThing -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyThing
id OccName -> OccSet -> Bool
`elemOccSet` OccSet
new_occs
new_occs :: OccSet
new_occs = [OccName] -> OccSet
mkOccSet ((Id -> OccName) -> [Id] -> [OccName]
forall a b. (a -> b) -> [a] -> [b]
map Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName [Id]
ids)
setInteractivePackage :: HscEnv -> HscEnv
setInteractivePackage :: HscEnv -> HscEnv
setInteractivePackage HscEnv
hsc_env
= HscEnv
hsc_env { hsc_dflags :: DynFlags
hsc_dflags = (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
{ thisInstalledUnitId :: InstalledUnitId
thisInstalledUnitId = UnitId -> InstalledUnitId
toInstalledUnitId UnitId
interactiveUnitId } }
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
setInteractivePrintName InteractiveContext
ic Name
n = InteractiveContext
ic{ic_int_print :: Name
ic_int_print = Name
n}
icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv :: GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
icExtendGblRdrEnv GlobalRdrEnv
env [TyThing]
tythings
= (TyThing -> GlobalRdrEnv -> GlobalRdrEnv)
-> GlobalRdrEnv -> [TyThing] -> GlobalRdrEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyThing -> GlobalRdrEnv -> GlobalRdrEnv
add GlobalRdrEnv
env [TyThing]
tythings
where
add :: TyThing -> GlobalRdrEnv -> GlobalRdrEnv
add TyThing
thing GlobalRdrEnv
env
| TyThing -> Bool
is_sub_bndr TyThing
thing
= GlobalRdrEnv
env
| Bool
otherwise
= (GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv)
-> GlobalRdrEnv -> [GlobalRdrElt] -> GlobalRdrEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env1 ((IfaceExport -> [GlobalRdrElt]) -> [IfaceExport] -> [GlobalRdrElt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IfaceExport -> [GlobalRdrElt]
localGREsFromAvail [IfaceExport]
avail)
where
env1 :: GlobalRdrEnv
env1 = GlobalRdrEnv -> [Name] -> GlobalRdrEnv
shadowNames GlobalRdrEnv
env ((IfaceExport -> [Name]) -> [IfaceExport] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IfaceExport -> [Name]
availNames [IfaceExport]
avail)
avail :: [IfaceExport]
avail = TyThing -> [IfaceExport]
tyThingAvailInfo TyThing
thing
is_sub_bndr :: TyThing -> Bool
is_sub_bndr (AnId Id
f) = case Id -> IdDetails
idDetails Id
f of
RecSelId {} -> Bool
True
ClassOpId {} -> Bool
True
IdDetails
_ -> Bool
False
is_sub_bndr TyThing
_ = Bool
False
substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
substInteractiveContext :: InteractiveContext -> TCvSubst -> InteractiveContext
substInteractiveContext ictxt :: InteractiveContext
ictxt@InteractiveContext{ ic_tythings :: InteractiveContext -> [TyThing]
ic_tythings = [TyThing]
tts } TCvSubst
subst
| TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
subst = InteractiveContext
ictxt
| Bool
otherwise = InteractiveContext
ictxt { ic_tythings :: [TyThing]
ic_tythings = (TyThing -> TyThing) -> [TyThing] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> TyThing
subst_ty [TyThing]
tts }
where
subst_ty :: TyThing -> TyThing
subst_ty (AnId Id
id)
= Id -> TyThing
AnId (Id -> TyThing) -> Id -> TyThing
forall a b. (a -> b) -> a -> b
$ Id
id Id -> Type -> Id
`setIdType` TCvSubst -> Type -> Type
substTyAddInScope TCvSubst
subst (Id -> Type
idType Id
id)
subst_ty TyThing
tt
= TyThing
tt
instance Outputable InteractiveImport where
ppr :: InteractiveImport -> SDoc
ppr (IIModule ModuleName
m) = Char -> SDoc
char Char
'*' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m
ppr (IIDecl ImportDecl GhcPs
d) = ImportDecl GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr ImportDecl GhcPs
d
mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualified :: DynFlags -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualified DynFlags
dflags GlobalRdrEnv
env = QueryQualifyName
-> (Module -> Bool) -> QueryQualifyPackage -> PrintUnqualified
QueryQualify QueryQualifyName
qual_name
(DynFlags -> Module -> Bool
mkQualModule DynFlags
dflags)
(DynFlags -> QueryQualifyPackage
mkQualPackage DynFlags
dflags)
where
qual_name :: QueryQualifyName
qual_name Module
mod OccName
occ
| [GlobalRdrElt
gre] <- [GlobalRdrElt]
unqual_gres
, GlobalRdrElt -> Bool
right_name GlobalRdrElt
gre
= QualifyName
NameUnqual
| [] <- [GlobalRdrElt]
unqual_gres
, (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
is_name [Name]
forceUnqualNames
, Bool -> Bool
not (OccName -> Bool
isDerivedOccName OccName
occ)
= QualifyName
NameUnqual
| [GlobalRdrElt
gre] <- [GlobalRdrElt]
qual_gres
= ModuleName -> QualifyName
NameQual (GlobalRdrElt -> ModuleName
greQualModName GlobalRdrElt
gre)
| [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
qual_gres
= if [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (ModuleName -> OccName -> RdrName
mkRdrQual (Module -> ModuleName
moduleName Module
mod) OccName
occ) GlobalRdrEnv
env)
then QualifyName
NameNotInScope1
else QualifyName
NameNotInScope2
| Bool
otherwise
= QualifyName
NameNotInScope1
where
is_name :: Name -> Bool
is_name :: Name -> Bool
is_name Name
name = ASSERT2( isExternalName name, ppr name )
HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod Bool -> Bool -> Bool
&& Name -> OccName
nameOccName Name
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ
forceUnqualNames :: [Name]
forceUnqualNames :: [Name]
forceUnqualNames =
(TyCon -> Name) -> [TyCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> Name
tyConName [ TyCon
constraintKindTyCon, TyCon
heqTyCon, TyCon
coercibleTyCon ]
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [ Name
eqTyConName ]
right_name :: GlobalRdrElt -> Bool
right_name GlobalRdrElt
gre = Name -> Maybe Module
nameModule_maybe (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre) Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod
unqual_gres :: [GlobalRdrElt]
unqual_gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (OccName -> RdrName
mkRdrUnqual OccName
occ) GlobalRdrEnv
env
qual_gres :: [GlobalRdrElt]
qual_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
right_name (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ)
mkQualModule :: DynFlags -> QueryQualifyModule
mkQualModule :: DynFlags -> Module -> Bool
mkQualModule DynFlags
dflags Module
mod
| Module -> UnitId
moduleUnitId Module
mod UnitId -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== DynFlags -> UnitId
thisPackage DynFlags
dflags = Bool
False
| [(Module
_, PackageConfig
pkgconfig)] <- [(Module, PackageConfig)]
lookup,
PackageConfig -> UnitId
packageConfigId PackageConfig
pkgconfig UnitId -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== Module -> UnitId
moduleUnitId Module
mod
= Bool
False
| Bool
otherwise = Bool
True
where lookup :: [(Module, PackageConfig)]
lookup = DynFlags -> ModuleName -> [(Module, PackageConfig)]
lookupModuleInAllPackages DynFlags
dflags (Module -> ModuleName
moduleName Module
mod)
mkQualPackage :: DynFlags -> QueryQualifyPackage
mkQualPackage :: DynFlags -> QueryQualifyPackage
mkQualPackage DynFlags
dflags UnitId
pkg_key
| UnitId
pkg_key UnitId -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== UnitId
mainUnitId Bool -> Bool -> Bool
|| UnitId
pkg_key UnitId -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== UnitId
interactiveUnitId
= Bool
False
| Just SourcePackageId
pkgid <- Maybe SourcePackageId
mb_pkgid
, DynFlags -> SourcePackageId -> [PackageConfig]
searchPackageId DynFlags
dflags SourcePackageId
pkgid [PackageConfig] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
1
= Bool
False
| Bool
otherwise
= Bool
True
where mb_pkgid :: Maybe SourcePackageId
mb_pkgid = (PackageConfig -> SourcePackageId)
-> Maybe PackageConfig -> Maybe SourcePackageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageConfig -> SourcePackageId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgid
sourcePackageId (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
pkg_key)
pkgQual :: DynFlags -> PrintUnqualified
pkgQual :: DynFlags -> PrintUnqualified
pkgQual DynFlags
dflags = PrintUnqualified
alwaysQualify {
queryQualifyPackage :: QueryQualifyPackage
queryQualifyPackage = DynFlags -> QueryQualifyPackage
mkQualPackage DynFlags
dflags
}
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings (AnId Id
_) = []
implicitTyThings (ACoAxiom CoAxiom Branched
_cc) = []
implicitTyThings (ATyCon TyCon
tc) = TyCon -> [TyThing]
implicitTyConThings TyCon
tc
implicitTyThings (AConLike ConLike
cl) = ConLike -> [TyThing]
implicitConLikeThings ConLike
cl
implicitConLikeThings :: ConLike -> [TyThing]
implicitConLikeThings :: ConLike -> [TyThing]
implicitConLikeThings (RealDataCon DataCon
dc)
= DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc
implicitConLikeThings (PatSynCon {})
= []
implicitClassThings :: Class -> [TyThing]
implicitClassThings :: Class -> [TyThing]
implicitClassThings Class
cl
=
(TyCon -> TyThing) -> [TyCon] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> TyThing
ATyCon (Class -> [TyCon]
classATs Class
cl) [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
(Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId (Class -> [Id]
classAllSelIds Class
cl)
implicitTyConThings :: TyCon -> [TyThing]
implicitTyConThings :: TyCon -> [TyThing]
implicitTyConThings TyCon
tc
= [TyThing]
class_stuff [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
TyCon -> [TyThing]
implicitCoTyCon TyCon
tc [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
[ TyThing
thing | DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tc
, TyThing
thing <- ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
dc) TyThing -> [TyThing] -> [TyThing]
forall a. a -> [a] -> [a]
: DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc ]
where
class_stuff :: [TyThing]
class_stuff = case TyCon -> Maybe Class
tyConClass_maybe TyCon
tc of
Maybe Class
Nothing -> []
Just Class
cl -> Class -> [TyThing]
implicitClassThings Class
cl
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon TyCon
tc
| Just CoAxiom Unbranched
co <- TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe TyCon
tc = [CoAxiom Branched -> TyThing
ACoAxiom (CoAxiom Branched -> TyThing) -> CoAxiom Branched -> TyThing
forall a b. (a -> b) -> a -> b
$ CoAxiom Unbranched -> CoAxiom Branched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched
toBranchedAxiom CoAxiom Unbranched
co]
| Just CoAxiom Branched
co <- TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe TyCon
tc
= [CoAxiom Branched -> TyThing
ACoAxiom CoAxiom Branched
co]
| Bool
otherwise = []
isImplicitTyThing :: TyThing -> Bool
isImplicitTyThing :: TyThing -> Bool
isImplicitTyThing (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon {} -> Bool
True
PatSynCon {} -> Bool
False
isImplicitTyThing (AnId Id
id) = Id -> Bool
isImplicitId Id
id
isImplicitTyThing (ATyCon TyCon
tc) = TyCon -> Bool
isImplicitTyCon TyCon
tc
isImplicitTyThing (ACoAxiom CoAxiom Branched
ax) = CoAxiom Branched -> Bool
forall (br :: BranchFlag). CoAxiom br -> Bool
isImplicitCoAxiom CoAxiom Branched
ax
tyThingParent_maybe :: TyThing -> Maybe TyThing
tyThingParent_maybe :: TyThing -> Maybe TyThing
tyThingParent_maybe (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon DataCon
dc -> TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (DataCon -> TyCon
dataConTyCon DataCon
dc))
PatSynCon{} -> Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe (ATyCon TyCon
tc) = case TyCon -> Maybe TyCon
tyConAssoc_maybe TyCon
tc of
Just TyCon
tc -> TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
Maybe TyCon
Nothing -> Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe (AnId Id
id) = case Id -> IdDetails
idDetails Id
id of
RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelData TyCon
tc } ->
TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
ClassOpId Class
cls ->
TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls))
IdDetails
_other -> Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe TyThing
_other = Maybe TyThing
forall a. Maybe a
Nothing
tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars [TyThing]
tts =
[TyCoVarSet] -> TyCoVarSet
unionVarSets ([TyCoVarSet] -> TyCoVarSet) -> [TyCoVarSet] -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ (TyThing -> TyCoVarSet) -> [TyThing] -> [TyCoVarSet]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> TyCoVarSet
ttToVarSet [TyThing]
tts
where
ttToVarSet :: TyThing -> TyCoVarSet
ttToVarSet (AnId Id
id) = Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ Id -> Type
idType Id
id
ttToVarSet (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon DataCon
dc -> Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ DataCon -> Type
dataConRepType DataCon
dc
PatSynCon{} -> TyCoVarSet
emptyVarSet
ttToVarSet (ATyCon TyCon
tc)
= case TyCon -> Maybe Class
tyConClass_maybe TyCon
tc of
Just Class
cls -> ([Id] -> TyCoVarSet
mkVarSet ([Id] -> TyCoVarSet) -> (Class -> [Id]) -> Class -> TyCoVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Id], [FunDep Id]) -> [Id]
forall a b. (a, b) -> a
fst (([Id], [FunDep Id]) -> [Id])
-> (Class -> ([Id], [FunDep Id])) -> Class -> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> ([Id], [FunDep Id])
classTvsFds) Class
cls
Maybe Class
Nothing -> Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ TyCon -> Type
tyConKind TyCon
tc
ttToVarSet (ACoAxiom CoAxiom Branched
_) = TyCoVarSet
emptyVarSet
tyThingAvailInfo :: TyThing -> [AvailInfo]
tyThingAvailInfo :: TyThing -> [IfaceExport]
tyThingAvailInfo (ATyCon TyCon
t)
= case TyCon -> Maybe Class
tyConClass_maybe TyCon
t of
Just Class
c -> [Name -> [Name] -> [FieldLabel] -> IfaceExport
AvailTC Name
n (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (Id -> Name) -> [Id] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
forall a. NamedThing a => a -> Name
getName (Class -> [Id]
classMethods Class
c)
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (TyCon -> Name) -> [TyCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> Name
forall a. NamedThing a => a -> Name
getName (Class -> [TyCon]
classATs Class
c))
[] ]
where n :: Name
n = Class -> Name
forall a. NamedThing a => a -> Name
getName Class
c
Maybe Class
Nothing -> [Name -> [Name] -> [FieldLabel] -> IfaceExport
AvailTC Name
n (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (DataCon -> Name) -> [DataCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Name
forall a. NamedThing a => a -> Name
getName [DataCon]
dcs) [FieldLabel]
flds]
where n :: Name
n = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
t
dcs :: [DataCon]
dcs = TyCon -> [DataCon]
tyConDataCons TyCon
t
flds :: [FieldLabel]
flds = TyCon -> [FieldLabel]
tyConFieldLabels TyCon
t
tyThingAvailInfo (AConLike (PatSynCon PatSyn
p))
= (Name -> IfaceExport) -> [Name] -> [IfaceExport]
forall a b. (a -> b) -> [a] -> [b]
map Name -> IfaceExport
avail ((PatSyn -> Name
forall a. NamedThing a => a -> Name
getName PatSyn
p) Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector (PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
p))
tyThingAvailInfo TyThing
t
= [Name -> IfaceExport
avail (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
t)]
type TypeEnv = NameEnv TyThing
emptyTypeEnv :: TypeEnv
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvTyCons :: TypeEnv -> [TyCon]
typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
typeEnvIds :: TypeEnv -> [Id]
typeEnvPatSyns :: TypeEnv -> [PatSyn]
typeEnvDataCons :: TypeEnv -> [DataCon]
typeEnvClasses :: TypeEnv -> [Class]
lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
emptyTypeEnv :: TypeEnv
emptyTypeEnv = TypeEnv
forall a. NameEnv a
emptyNameEnv
typeEnvElts :: TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env = TypeEnv -> [TyThing]
forall a. NameEnv a -> [a]
nameEnvElts TypeEnv
env
typeEnvTyCons :: TypeEnv -> [TyCon]
typeEnvTyCons TypeEnv
env = [TyCon
tc | ATyCon TyCon
tc <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvCoAxioms :: TypeEnv -> [CoAxiom Branched]
typeEnvCoAxioms TypeEnv
env = [CoAxiom Branched
ax | ACoAxiom CoAxiom Branched
ax <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvIds :: TypeEnv -> [Id]
typeEnvIds TypeEnv
env = [Id
id | AnId Id
id <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvPatSyns :: TypeEnv -> [PatSyn]
typeEnvPatSyns TypeEnv
env = [PatSyn
ps | AConLike (PatSynCon PatSyn
ps) <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvDataCons :: TypeEnv -> [DataCon]
typeEnvDataCons TypeEnv
env = [DataCon
dc | AConLike (RealDataCon DataCon
dc) <- TypeEnv -> [TyThing]
typeEnvElts TypeEnv
env]
typeEnvClasses :: TypeEnv -> [Class]
typeEnvClasses TypeEnv
env = [Class
cl | TyCon
tc <- TypeEnv -> [TyCon]
typeEnvTyCons TypeEnv
env,
Just Class
cl <- [TyCon -> Maybe Class
tyConClass_maybe TyCon
tc]]
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv [TyThing]
things = TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList TypeEnv
emptyTypeEnv [TyThing]
things
mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
mkTypeEnvWithImplicits [TyThing]
things =
[TyThing] -> TypeEnv
mkTypeEnv [TyThing]
things
TypeEnv -> TypeEnv -> TypeEnv
forall a. NameEnv a -> NameEnv a -> NameEnv a
`plusNameEnv`
[TyThing] -> TypeEnv
mkTypeEnv ((TyThing -> [TyThing]) -> [TyThing] -> [TyThing]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyThing -> [TyThing]
implicitTyThings [TyThing]
things)
typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv
typeEnvFromEntities :: [Id] -> [TyCon] -> [FamInst] -> TypeEnv
typeEnvFromEntities [Id]
ids [TyCon]
tcs [FamInst]
famInsts =
[TyThing] -> TypeEnv
mkTypeEnv ( (Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId [Id]
ids
[TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (TyCon -> TyThing) -> [TyCon] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> TyThing
ATyCon [TyCon]
all_tcs
[TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (TyCon -> [TyThing]) -> [TyCon] -> [TyThing]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [TyThing]
implicitTyConThings [TyCon]
all_tcs
[TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++ (FamInst -> TyThing) -> [FamInst] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map (CoAxiom Branched -> TyThing
ACoAxiom (CoAxiom Branched -> TyThing)
-> (FamInst -> CoAxiom Branched) -> FamInst -> TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxiom Unbranched -> CoAxiom Branched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched
toBranchedAxiom (CoAxiom Unbranched -> CoAxiom Branched)
-> (FamInst -> CoAxiom Unbranched) -> FamInst -> CoAxiom Branched
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> CoAxiom Unbranched
famInstAxiom) [FamInst]
famInsts
)
where
all_tcs :: [TyCon]
all_tcs = [TyCon]
tcs [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [FamInst] -> [TyCon]
famInstsRepTyCons [FamInst]
famInsts
lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
lookupTypeEnv = TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
extendTypeEnv TypeEnv
env TyThing
thing = TypeEnv -> Name -> TyThing -> TypeEnv
forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv TypeEnv
env (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing) TyThing
thing
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList TypeEnv
env [TyThing]
things = (TypeEnv -> TyThing -> TypeEnv) -> TypeEnv -> [TyThing] -> TypeEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' TypeEnv -> TyThing -> TypeEnv
extendTypeEnv TypeEnv
env [TyThing]
things
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds TypeEnv
env [Id]
ids
= TypeEnv -> [(Name, TyThing)] -> TypeEnv
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList TypeEnv
env [(Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id, Id -> TyThing
AnId Id
id) | Id
id <- [Id]
ids]
plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv
plusTypeEnv TypeEnv
env1 TypeEnv
env2 = TypeEnv -> TypeEnv -> TypeEnv
forall a. NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv TypeEnv
env1 TypeEnv
env2
lookupType :: DynFlags
-> HomePackageTable
-> PackageTypeEnv
-> Name
-> Maybe TyThing
lookupType :: DynFlags -> HomePackageTable -> TypeEnv -> Name -> Maybe TyThing
lookupType DynFlags
dflags HomePackageTable
hpt TypeEnv
pte Name
name
| GhcMode -> Bool
isOneShot (DynFlags -> GhcMode
ghcMode DynFlags
dflags)
= TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TypeEnv
pte Name
name
| Bool
otherwise
= case HomePackageTable -> Module -> Maybe HomeModInfo
lookupHptByModule HomePackageTable
hpt Module
mod of
Just HomeModInfo
hm -> TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (ModDetails -> TypeEnv
md_types (HomeModInfo -> ModDetails
hm_details HomeModInfo
hm)) Name
name
Maybe HomeModInfo
Nothing -> TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TypeEnv
pte Name
name
where
mod :: Module
mod = ASSERT2( isExternalName name, ppr name )
if Name -> Bool
isHoleName Name
name
then UnitId -> ModuleName -> Module
mkModule (DynFlags -> UnitId
thisPackage DynFlags
dflags) (Module -> ModuleName
moduleName (HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name))
else HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
lookupTypeHscEnv HscEnv
hsc_env Name
name = do
ExternalPackageState
eps <- IORef ExternalPackageState -> IO ExternalPackageState
forall a. IORef a -> IO a
readIORef (HscEnv -> IORef ExternalPackageState
hsc_EPS HscEnv
hsc_env)
Maybe TyThing -> IO (Maybe TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TyThing -> IO (Maybe TyThing))
-> Maybe TyThing -> IO (Maybe TyThing)
forall a b. (a -> b) -> a -> b
$! DynFlags -> HomePackageTable -> TypeEnv -> Name -> Maybe TyThing
lookupType DynFlags
dflags HomePackageTable
hpt (ExternalPackageState -> TypeEnv
eps_PTE ExternalPackageState
eps) Name
name
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
hpt :: HomePackageTable
hpt = HscEnv -> HomePackageTable
hsc_HPT HscEnv
hsc_env
tyThingTyCon :: TyThing -> TyCon
tyThingTyCon :: TyThing -> TyCon
tyThingTyCon (ATyCon TyCon
tc) = TyCon
tc
tyThingTyCon TyThing
other = String -> SDoc -> TyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingTyCon" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingCoAxiom :: TyThing -> CoAxiom Branched
tyThingCoAxiom :: TyThing -> CoAxiom Branched
tyThingCoAxiom (ACoAxiom CoAxiom Branched
ax) = CoAxiom Branched
ax
tyThingCoAxiom TyThing
other = String -> SDoc -> CoAxiom Branched
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingCoAxiom" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingDataCon :: TyThing -> DataCon
tyThingDataCon :: TyThing -> DataCon
tyThingDataCon (AConLike (RealDataCon DataCon
dc)) = DataCon
dc
tyThingDataCon TyThing
other = String -> SDoc -> DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingDataCon" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingConLike :: TyThing -> ConLike
tyThingConLike :: TyThing -> ConLike
tyThingConLike (AConLike ConLike
dc) = ConLike
dc
tyThingConLike TyThing
other = String -> SDoc -> ConLike
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingConLike" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingId :: TyThing -> Id
tyThingId :: TyThing -> Id
tyThingId (AnId Id
id) = Id
id
tyThingId (AConLike (RealDataCon DataCon
dc)) = DataCon -> Id
dataConWrapId DataCon
dc
tyThingId TyThing
other = String -> SDoc -> Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingId" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
class Monad m => MonadThings m where
lookupThing :: Name -> m TyThing
lookupId :: Name -> m Id
lookupId = (TyThing -> Id) -> m TyThing -> m Id
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM TyThing -> Id
tyThingId (m TyThing -> m Id) -> (Name -> m TyThing) -> Name -> m Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
lookupDataCon :: Name -> m DataCon
lookupDataCon = (TyThing -> DataCon) -> m TyThing -> m DataCon
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM TyThing -> DataCon
tyThingDataCon (m TyThing -> m DataCon)
-> (Name -> m TyThing) -> Name -> m DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
lookupTyCon :: Name -> m TyCon
lookupTyCon = (TyThing -> TyCon) -> m TyThing -> m TyCon
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM TyThing -> TyCon
tyThingTyCon (m TyThing -> m TyCon) -> (Name -> m TyThing) -> Name -> m TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
data Warnings
= NoWarnings
| WarnAll WarningTxt
| WarnSome [(OccName,WarningTxt)]
deriving( Warnings -> Warnings -> Bool
(Warnings -> Warnings -> Bool)
-> (Warnings -> Warnings -> Bool) -> Eq Warnings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Warnings -> Warnings -> Bool
$c/= :: Warnings -> Warnings -> Bool
== :: Warnings -> Warnings -> Bool
$c== :: Warnings -> Warnings -> Bool
Eq )
instance Binary Warnings where
put_ :: BinHandle -> Warnings -> IO ()
put_ BinHandle
bh Warnings
NoWarnings = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (WarnAll WarningTxt
t) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> WarningTxt -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh WarningTxt
t
put_ BinHandle
bh (WarnSome [(OccName, WarningTxt)]
ts) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> [(OccName, WarningTxt)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(OccName, WarningTxt)]
ts
get :: BinHandle -> IO Warnings
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> Warnings -> IO Warnings
forall (m :: * -> *) a. Monad m => a -> m a
return Warnings
NoWarnings
Word8
1 -> do WarningTxt
aa <- BinHandle -> IO WarningTxt
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings -> IO Warnings
forall (m :: * -> *) a. Monad m => a -> m a
return (WarningTxt -> Warnings
WarnAll WarningTxt
aa)
Word8
_ -> do [(OccName, WarningTxt)]
aa <- BinHandle -> IO [(OccName, WarningTxt)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Warnings -> IO Warnings
forall (m :: * -> *) a. Monad m => a -> m a
return ([(OccName, WarningTxt)] -> Warnings
WarnSome [(OccName, WarningTxt)]
aa)
mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt
mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt
mkIfaceWarnCache Warnings
NoWarnings = \OccName
_ -> Maybe WarningTxt
forall a. Maybe a
Nothing
mkIfaceWarnCache (WarnAll WarningTxt
t) = \OccName
_ -> WarningTxt -> Maybe WarningTxt
forall a. a -> Maybe a
Just WarningTxt
t
mkIfaceWarnCache (WarnSome [(OccName, WarningTxt)]
pairs) = OccEnv WarningTxt -> OccName -> Maybe WarningTxt
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv ([(OccName, WarningTxt)] -> OccEnv WarningTxt
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(OccName, WarningTxt)]
pairs)
emptyIfaceWarnCache :: OccName -> Maybe WarningTxt
emptyIfaceWarnCache :: OccName -> Maybe WarningTxt
emptyIfaceWarnCache OccName
_ = Maybe WarningTxt
forall a. Maybe a
Nothing
plusWarns :: Warnings -> Warnings -> Warnings
plusWarns :: Warnings -> Warnings -> Warnings
plusWarns Warnings
d Warnings
NoWarnings = Warnings
d
plusWarns Warnings
NoWarnings Warnings
d = Warnings
d
plusWarns Warnings
_ (WarnAll WarningTxt
t) = WarningTxt -> Warnings
WarnAll WarningTxt
t
plusWarns (WarnAll WarningTxt
t) Warnings
_ = WarningTxt -> Warnings
WarnAll WarningTxt
t
plusWarns (WarnSome [(OccName, WarningTxt)]
v1) (WarnSome [(OccName, WarningTxt)]
v2) = [(OccName, WarningTxt)] -> Warnings
WarnSome ([(OccName, WarningTxt)]
v1 [(OccName, WarningTxt)]
-> [(OccName, WarningTxt)] -> [(OccName, WarningTxt)]
forall a. [a] -> [a] -> [a]
++ [(OccName, WarningTxt)]
v2)
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache [(OccName, Fixity)]
pairs
= \OccName
n -> OccEnv Fixity -> OccName -> Maybe Fixity
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv Fixity
env OccName
n
where
env :: OccEnv Fixity
env = [(OccName, Fixity)] -> OccEnv Fixity
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(OccName, Fixity)]
pairs
emptyIfaceFixCache :: OccName -> Maybe Fixity
emptyIfaceFixCache :: OccName -> Maybe Fixity
emptyIfaceFixCache OccName
_ = Maybe Fixity
forall a. Maybe a
Nothing
type FixityEnv = NameEnv FixItem
data FixItem = FixItem OccName Fixity
instance Outputable FixItem where
ppr :: FixItem -> SDoc
ppr (FixItem OccName
occ Fixity
fix) = Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fix SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ
emptyFixityEnv :: FixityEnv
emptyFixityEnv :: FixityEnv
emptyFixityEnv = FixityEnv
forall a. NameEnv a
emptyNameEnv
lookupFixity :: FixityEnv -> Name -> Fixity
lookupFixity :: FixityEnv -> Name -> Fixity
lookupFixity FixityEnv
env Name
n = case FixityEnv -> Name -> Maybe FixItem
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv FixityEnv
env Name
n of
Just (FixItem OccName
_ Fixity
fix) -> Fixity
fix
Maybe FixItem
Nothing -> Fixity
defaultFixity
type WhetherHasOrphans = Bool
type WhetherHasFamInst = Bool
type IsBootInterface = Bool
data Dependencies
= Deps { Dependencies -> [(ModuleName, Bool)]
dep_mods :: [(ModuleName, IsBootInterface)]
, Dependencies -> [(InstalledUnitId, Bool)]
dep_pkgs :: [(InstalledUnitId, Bool)]
, Dependencies -> [Module]
dep_orphs :: [Module]
, Dependencies -> [Module]
dep_finsts :: [Module]
, Dependencies -> [ModuleName]
dep_plgins :: [ModuleName]
}
deriving( Dependencies -> Dependencies -> Bool
(Dependencies -> Dependencies -> Bool)
-> (Dependencies -> Dependencies -> Bool) -> Eq Dependencies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependencies -> Dependencies -> Bool
$c/= :: Dependencies -> Dependencies -> Bool
== :: Dependencies -> Dependencies -> Bool
$c== :: Dependencies -> Dependencies -> Bool
Eq )
instance Binary Dependencies where
put_ :: BinHandle -> Dependencies -> IO ()
put_ BinHandle
bh Dependencies
deps = do BinHandle -> [(ModuleName, Bool)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [(ModuleName, Bool)]
dep_mods Dependencies
deps)
BinHandle -> [(InstalledUnitId, Bool)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [(InstalledUnitId, Bool)]
dep_pkgs Dependencies
deps)
BinHandle -> [Module] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [Module]
dep_orphs Dependencies
deps)
BinHandle -> [Module] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [Module]
dep_finsts Dependencies
deps)
BinHandle -> [ModuleName] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Dependencies -> [ModuleName]
dep_plgins Dependencies
deps)
get :: BinHandle -> IO Dependencies
get BinHandle
bh = do [(ModuleName, Bool)]
ms <- BinHandle -> IO [(ModuleName, Bool)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(InstalledUnitId, Bool)]
ps <- BinHandle -> IO [(InstalledUnitId, Bool)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Module]
os <- BinHandle -> IO [Module]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[Module]
fis <- BinHandle -> IO [Module]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[ModuleName]
pl <- BinHandle -> IO [ModuleName]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Dependencies -> IO Dependencies
forall (m :: * -> *) a. Monad m => a -> m a
return (Deps :: [(ModuleName, Bool)]
-> [(InstalledUnitId, Bool)]
-> [Module]
-> [Module]
-> [ModuleName]
-> Dependencies
Deps { dep_mods :: [(ModuleName, Bool)]
dep_mods = [(ModuleName, Bool)]
ms, dep_pkgs :: [(InstalledUnitId, Bool)]
dep_pkgs = [(InstalledUnitId, Bool)]
ps, dep_orphs :: [Module]
dep_orphs = [Module]
os,
dep_finsts :: [Module]
dep_finsts = [Module]
fis, dep_plgins :: [ModuleName]
dep_plgins = [ModuleName]
pl })
noDependencies :: Dependencies
noDependencies :: Dependencies
noDependencies = [(ModuleName, Bool)]
-> [(InstalledUnitId, Bool)]
-> [Module]
-> [Module]
-> [ModuleName]
-> Dependencies
Deps [] [] [] [] []
data Usage
= UsagePackageModule {
Usage -> Module
usg_mod :: Module,
Usage -> Fingerprint
usg_mod_hash :: Fingerprint,
Usage -> Bool
usg_safe :: IsSafeImport
}
| UsageHomeModule {
Usage -> ModuleName
usg_mod_name :: ModuleName,
usg_mod_hash :: Fingerprint,
Usage -> [(OccName, Fingerprint)]
usg_entities :: [(OccName,Fingerprint)],
Usage -> Maybe Fingerprint
usg_exports :: Maybe Fingerprint,
usg_safe :: IsSafeImport
}
| UsageFile {
Usage -> String
usg_file_path :: FilePath,
Usage -> Fingerprint
usg_file_hash :: Fingerprint
}
| UsageMergedRequirement {
usg_mod :: Module,
usg_mod_hash :: Fingerprint
}
deriving( Usage -> Usage -> Bool
(Usage -> Usage -> Bool) -> (Usage -> Usage -> Bool) -> Eq Usage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c== :: Usage -> Usage -> Bool
Eq )
instance Binary Usage where
put_ :: BinHandle -> Usage -> IO ()
put_ BinHandle
bh usg :: Usage
usg@UsagePackageModule{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Module
usg_mod Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Bool
usg_safe Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageHomeModule{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> ModuleName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> ModuleName
usg_mod_name Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
BinHandle -> Maybe Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Maybe Fingerprint
usg_exports Usage
usg)
BinHandle -> [(OccName, Fingerprint)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> [(OccName, Fingerprint)]
usg_entities Usage
usg)
BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Bool
usg_safe Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageFile{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> String
usg_file_path Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_file_hash Usage
usg)
put_ BinHandle
bh usg :: Usage
usg@UsageMergedRequirement{} = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Module
usg_mod Usage
usg)
BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (Usage -> Fingerprint
usg_mod_hash Usage
usg)
get :: BinHandle -> IO Usage
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do
Module
nm <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
safe <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsagePackageModule :: Module -> Fingerprint -> Bool -> Usage
UsagePackageModule { usg_mod :: Module
usg_mod = Module
nm, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod, usg_safe :: Bool
usg_safe = Bool
safe }
Word8
1 -> do
ModuleName
nm <- BinHandle -> IO ModuleName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
mod <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Maybe Fingerprint
exps <- BinHandle -> IO (Maybe Fingerprint)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
[(OccName, Fingerprint)]
ents <- BinHandle -> IO [(OccName, Fingerprint)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Bool
safe <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageHomeModule :: ModuleName
-> Fingerprint
-> [(OccName, Fingerprint)]
-> Maybe Fingerprint
-> Bool
-> Usage
UsageHomeModule { usg_mod_name :: ModuleName
usg_mod_name = ModuleName
nm, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod,
usg_exports :: Maybe Fingerprint
usg_exports = Maybe Fingerprint
exps, usg_entities :: [(OccName, Fingerprint)]
usg_entities = [(OccName, Fingerprint)]
ents, usg_safe :: Bool
usg_safe = Bool
safe }
Word8
2 -> do
String
fp <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageFile :: String -> Fingerprint -> Usage
UsageFile { usg_file_path :: String
usg_file_path = String
fp, usg_file_hash :: Fingerprint
usg_file_hash = Fingerprint
hash }
Word8
3 -> do
Module
mod <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Fingerprint
hash <- BinHandle -> IO Fingerprint
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return UsageMergedRequirement :: Module -> Fingerprint -> Usage
UsageMergedRequirement { usg_mod :: Module
usg_mod = Module
mod, usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
hash }
Word8
i -> String -> IO Usage
forall a. HasCallStack => String -> a
error (String
"Binary.get(Usage): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i)
type PackageTypeEnv = TypeEnv
type PackageRuleBase = RuleBase
type PackageInstEnv = InstEnv
type PackageFamInstEnv = FamInstEnv
type PackageAnnEnv = AnnEnv
type PackageCompleteMatchMap = CompleteMatchMap
data ExternalPackageState
= EPS {
ExternalPackageState -> ModuleNameEnv (ModuleName, Bool)
eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
ExternalPackageState -> PackageIfaceTable
eps_PIT :: !PackageIfaceTable,
ExternalPackageState -> InstalledModuleEnv (UniqDSet ModuleName)
eps_free_holes :: InstalledModuleEnv (UniqDSet ModuleName),
ExternalPackageState -> TypeEnv
eps_PTE :: !PackageTypeEnv,
ExternalPackageState -> InstEnv
eps_inst_env :: !PackageInstEnv,
ExternalPackageState -> FamInstEnv
eps_fam_inst_env :: !PackageFamInstEnv,
ExternalPackageState -> PackageRuleBase
eps_rule_base :: !PackageRuleBase,
ExternalPackageState -> AnnEnv
eps_ann_env :: !PackageAnnEnv,
ExternalPackageState -> PackageCompleteMatchMap
eps_complete_matches :: !PackageCompleteMatchMap,
ExternalPackageState -> ModuleEnv FamInstEnv
eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv),
ExternalPackageState -> EpsStats
eps_stats :: !EpsStats
}
data EpsStats = EpsStats { EpsStats -> Int
n_ifaces_in
, EpsStats -> Int
n_decls_in, EpsStats -> Int
n_decls_out
, EpsStats -> Int
n_rules_in, EpsStats -> Int
n_rules_out
, EpsStats -> Int
n_insts_in, EpsStats -> Int
n_insts_out :: !Int }
addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
addEpsInStats EpsStats
stats Int
n_decls Int
n_insts Int
n_rules
= EpsStats
stats { n_ifaces_in :: Int
n_ifaces_in = EpsStats -> Int
n_ifaces_in EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, n_decls_in :: Int
n_decls_in = EpsStats -> Int
n_decls_in EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n_decls
, n_insts_in :: Int
n_insts_in = EpsStats -> Int
n_insts_in EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n_insts
, n_rules_in :: Int
n_rules_in = EpsStats -> Int
n_rules_in EpsStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n_rules }
updNameCache :: IORef NameCache
-> (NameCache -> (NameCache, c))
-> IO c
updNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache IORef NameCache
ncRef NameCache -> (NameCache, c)
upd_fn
= IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef NameCache
ncRef NameCache -> (NameCache, c)
upd_fn
mkSOName :: Platform -> FilePath -> FilePath
mkSOName :: Platform -> ShowS
mkSOName Platform
platform String
root
= case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> String
root String -> ShowS
<.> Platform -> String
soExt Platform
platform
OS
_ -> (String
"lib" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
soExt Platform
platform
mkHsSOName :: Platform -> FilePath -> FilePath
mkHsSOName :: Platform -> ShowS
mkHsSOName Platform
platform String
root = (String
"lib" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
soExt Platform
platform
soExt :: Platform -> FilePath
soExt :: Platform -> String
soExt Platform
platform
= case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin -> String
"dylib"
OS
OSMinGW32 -> String
"dll"
OS
_ -> String
"so"
data ModuleGraph = ModuleGraph
{ ModuleGraph -> [ModSummary]
mg_mss :: [ModSummary]
, ModuleGraph -> ModuleEnv ModSummary
mg_non_boot :: ModuleEnv ModSummary
, ModuleGraph -> ModuleSet
mg_boot :: ModuleSet
, ModuleGraph -> Bool
mg_needs_th_or_qq :: !Bool
}
needsTemplateHaskellOrQQ :: ModuleGraph -> Bool
needsTemplateHaskellOrQQ :: ModuleGraph -> Bool
needsTemplateHaskellOrQQ ModuleGraph
mg = ModuleGraph -> Bool
mg_needs_th_or_qq ModuleGraph
mg
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
mapMG ModSummary -> ModSummary
f mg :: ModuleGraph
mg@ModuleGraph{Bool
[ModSummary]
ModuleSet
ModuleEnv ModSummary
mg_needs_th_or_qq :: Bool
mg_boot :: ModuleSet
mg_non_boot :: ModuleEnv ModSummary
mg_mss :: [ModSummary]
mg_needs_th_or_qq :: ModuleGraph -> Bool
mg_boot :: ModuleGraph -> ModuleSet
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_mss :: ModuleGraph -> [ModSummary]
..} = ModuleGraph
mg
{ mg_mss :: [ModSummary]
mg_mss = (ModSummary -> ModSummary) -> [ModSummary] -> [ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> ModSummary
f [ModSummary]
mg_mss
, mg_non_boot :: ModuleEnv ModSummary
mg_non_boot = (ModSummary -> ModSummary)
-> ModuleEnv ModSummary -> ModuleEnv ModSummary
forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv ModSummary -> ModSummary
f ModuleEnv ModSummary
mg_non_boot
}
mgBootModules :: ModuleGraph -> ModuleSet
mgBootModules :: ModuleGraph -> ModuleSet
mgBootModules ModuleGraph{Bool
[ModSummary]
ModuleSet
ModuleEnv ModSummary
mg_needs_th_or_qq :: Bool
mg_boot :: ModuleSet
mg_non_boot :: ModuleEnv ModSummary
mg_mss :: [ModSummary]
mg_needs_th_or_qq :: ModuleGraph -> Bool
mg_boot :: ModuleGraph -> ModuleSet
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_mss :: ModuleGraph -> [ModSummary]
..} = ModuleSet
mg_boot
mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries :: ModuleGraph -> [ModSummary]
mgModSummaries = ModuleGraph -> [ModSummary]
mg_mss
mgElemModule :: ModuleGraph -> Module -> Bool
mgElemModule :: ModuleGraph -> Module -> Bool
mgElemModule ModuleGraph{Bool
[ModSummary]
ModuleSet
ModuleEnv ModSummary
mg_needs_th_or_qq :: Bool
mg_boot :: ModuleSet
mg_non_boot :: ModuleEnv ModSummary
mg_mss :: [ModSummary]
mg_needs_th_or_qq :: ModuleGraph -> Bool
mg_boot :: ModuleGraph -> ModuleSet
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_mss :: ModuleGraph -> [ModSummary]
..} Module
m = Module -> ModuleEnv ModSummary -> Bool
forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
m ModuleEnv ModSummary
mg_non_boot
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
mgLookupModule ModuleGraph{Bool
[ModSummary]
ModuleSet
ModuleEnv ModSummary
mg_needs_th_or_qq :: Bool
mg_boot :: ModuleSet
mg_non_boot :: ModuleEnv ModSummary
mg_mss :: [ModSummary]
mg_needs_th_or_qq :: ModuleGraph -> Bool
mg_boot :: ModuleGraph -> ModuleSet
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_mss :: ModuleGraph -> [ModSummary]
..} Module
m = ModuleEnv ModSummary -> Module -> Maybe ModSummary
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv ModSummary
mg_non_boot Module
m
emptyMG :: ModuleGraph
emptyMG :: ModuleGraph
emptyMG = [ModSummary]
-> ModuleEnv ModSummary -> ModuleSet -> Bool -> ModuleGraph
ModuleGraph [] ModuleEnv ModSummary
forall a. ModuleEnv a
emptyModuleEnv ModuleSet
emptyModuleSet Bool
False
isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
isTemplateHaskellOrQQNonBoot ModSummary
ms =
(Extension -> DynFlags -> Bool
xopt Extension
LangExt.TemplateHaskell (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms)
Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.QuasiQuotes (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms)) Bool -> Bool -> Bool
&&
Bool -> Bool
not (ModSummary -> Bool
isBootSummary ModSummary
ms)
extendMG :: ModuleGraph -> ModSummary -> ModuleGraph
extendMG :: ModuleGraph -> ModSummary -> ModuleGraph
extendMG ModuleGraph{Bool
[ModSummary]
ModuleSet
ModuleEnv ModSummary
mg_needs_th_or_qq :: Bool
mg_boot :: ModuleSet
mg_non_boot :: ModuleEnv ModSummary
mg_mss :: [ModSummary]
mg_needs_th_or_qq :: ModuleGraph -> Bool
mg_boot :: ModuleGraph -> ModuleSet
mg_non_boot :: ModuleGraph -> ModuleEnv ModSummary
mg_mss :: ModuleGraph -> [ModSummary]
..} ModSummary
ms = ModuleGraph :: [ModSummary]
-> ModuleEnv ModSummary -> ModuleSet -> Bool -> ModuleGraph
ModuleGraph
{ mg_mss :: [ModSummary]
mg_mss = ModSummary
msModSummary -> [ModSummary] -> [ModSummary]
forall a. a -> [a] -> [a]
:[ModSummary]
mg_mss
, mg_non_boot :: ModuleEnv ModSummary
mg_non_boot = if ModSummary -> Bool
isBootSummary ModSummary
ms
then ModuleEnv ModSummary
mg_non_boot
else ModuleEnv ModSummary
-> Module -> ModSummary -> ModuleEnv ModSummary
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv ModSummary
mg_non_boot (ModSummary -> Module
ms_mod ModSummary
ms) ModSummary
ms
, mg_boot :: ModuleSet
mg_boot = if ModSummary -> Bool
isBootSumma