{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Iface.Recomp
( checkOldIface
, RecompileRequired(..)
, needsRecompileBecause
, recompThen
, MaybeValidated(..)
, outOfDateItemBecause
, RecompReason (..)
, CompileReason(..)
, recompileRequired
, addFingerprints
)
where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Driver.Backend
import GHC.Driver.Config.Finder
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Plugins
import GHC.Iface.Syntax
import GHC.Iface.Recomp.Binary
import GHC.Iface.Load
import GHC.Iface.Recomp.Flags
import GHC.Iface.Env
import GHC.Core
import GHC.Tc.Utils.Monad
import GHC.Hs
import GHC.Data.Graph.Directed
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Misc as Utils
import GHC.Utils.Binary
import GHC.Utils.Fingerprint
import GHC.Utils.Exception
import GHC.Utils.Logger
import GHC.Utils.Constants (debugIsOn)
import GHC.Types.Annotations
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.Set
import GHC.Types.Fixity.Env
import GHC.Unit.External
import GHC.Unit.Finder
import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.Deps
import Control.Monad
import Data.List (sortBy, sort, sortOn)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Word (Word64)
import Data.Either
import qualified Data.Semigroup
import GHC.List (uncons)
import Data.Ord
import Data.Containers.ListUtils
import Data.Bifunctor
data RecompileRequired
= UpToDate
| NeedsRecompile !CompileReason
deriving (RecompileRequired -> RecompileRequired -> AnyHpcUsage
(RecompileRequired -> RecompileRequired -> AnyHpcUsage)
-> (RecompileRequired -> RecompileRequired -> AnyHpcUsage)
-> Eq RecompileRequired
forall a.
(a -> a -> AnyHpcUsage) -> (a -> a -> AnyHpcUsage) -> Eq a
$c== :: RecompileRequired -> RecompileRequired -> AnyHpcUsage
== :: RecompileRequired -> RecompileRequired -> AnyHpcUsage
$c/= :: RecompileRequired -> RecompileRequired -> AnyHpcUsage
/= :: RecompileRequired -> RecompileRequired -> AnyHpcUsage
Eq)
needsRecompileBecause :: RecompReason -> RecompileRequired
needsRecompileBecause :: RecompReason -> RecompileRequired
needsRecompileBecause = CompileReason -> RecompileRequired
NeedsRecompile (CompileReason -> RecompileRequired)
-> (RecompReason -> CompileReason)
-> RecompReason
-> RecompileRequired
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecompReason -> CompileReason
RecompBecause
data MaybeValidated a
= UpToDateItem a
| OutOfDateItem
!CompileReason
(Maybe a)
deriving ((forall a b. (a -> b) -> MaybeValidated a -> MaybeValidated b)
-> (forall a b. a -> MaybeValidated b -> MaybeValidated a)
-> Functor MaybeValidated
forall a b. a -> MaybeValidated b -> MaybeValidated a
forall a b. (a -> b) -> MaybeValidated a -> MaybeValidated b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MaybeValidated a -> MaybeValidated b
fmap :: forall a b. (a -> b) -> MaybeValidated a -> MaybeValidated b
$c<$ :: forall a b. a -> MaybeValidated b -> MaybeValidated a
<$ :: forall a b. a -> MaybeValidated b -> MaybeValidated a
Functor)
instance Outputable a => Outputable (MaybeValidated a) where
ppr :: MaybeValidated a -> SDoc
ppr (UpToDateItem a
a) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UpToDate" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a
ppr (OutOfDateItem CompileReason
r Maybe a
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OutOfDate: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CompileReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr CompileReason
r
outOfDateItemBecause :: RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause :: forall a. RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause RecompReason
reason Maybe a
item = CompileReason -> Maybe a -> MaybeValidated a
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem (RecompReason -> CompileReason
RecompBecause RecompReason
reason) Maybe a
item
data CompileReason
= MustCompile
| RecompBecause !RecompReason
deriving (CompileReason -> CompileReason -> AnyHpcUsage
(CompileReason -> CompileReason -> AnyHpcUsage)
-> (CompileReason -> CompileReason -> AnyHpcUsage)
-> Eq CompileReason
forall a.
(a -> a -> AnyHpcUsage) -> (a -> a -> AnyHpcUsage) -> Eq a
$c== :: CompileReason -> CompileReason -> AnyHpcUsage
== :: CompileReason -> CompileReason -> AnyHpcUsage
$c/= :: CompileReason -> CompileReason -> AnyHpcUsage
/= :: CompileReason -> CompileReason -> AnyHpcUsage
Eq)
instance Outputable RecompileRequired where
ppr :: RecompileRequired -> SDoc
ppr RecompileRequired
UpToDate = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UpToDate"
ppr (NeedsRecompile CompileReason
reason) = CompileReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr CompileReason
reason
instance Outputable CompileReason where
ppr :: CompileReason -> SDoc
ppr CompileReason
MustCompile = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MustCompile"
ppr (RecompBecause RecompReason
r) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecompBecause" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecompReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr RecompReason
r
instance Semigroup RecompileRequired where
RecompileRequired
UpToDate <> :: RecompileRequired -> RecompileRequired -> RecompileRequired
<> RecompileRequired
r = RecompileRequired
r
RecompileRequired
mc <> RecompileRequired
_ = RecompileRequired
mc
instance Monoid RecompileRequired where
mempty :: RecompileRequired
mempty = RecompileRequired
UpToDate
data RecompReason
= UnitDepRemoved UnitId
| ModulePackageChanged FastString
| SourceFileChanged
| ThisUnitIdChanged
| ImpurePlugin
| PluginsChanged
| PluginFingerprintChanged
| ModuleInstChanged
| HieMissing
| HieOutdated
| SigsMergeChanged
| ModuleChanged ModuleName
| ModuleRemoved (UnitId, ModuleName)
| ModuleAdded (UnitId, ModuleName)
| ModuleChangedRaw ModuleName
| ModuleChangedIface ModuleName
| FileChanged FilePath
| CustomReason String
| FlagsChanged
| OptimFlagsChanged
| HpcFlagsChanged
| MissingBytecode
| MissingObjectFile
| MissingDynObjectFile
| MissingDynHiFile
| MismatchedDynHiFile
| ObjectsChanged
| LibraryChanged
deriving (RecompReason -> RecompReason -> AnyHpcUsage
(RecompReason -> RecompReason -> AnyHpcUsage)
-> (RecompReason -> RecompReason -> AnyHpcUsage) -> Eq RecompReason
forall a.
(a -> a -> AnyHpcUsage) -> (a -> a -> AnyHpcUsage) -> Eq a
$c== :: RecompReason -> RecompReason -> AnyHpcUsage
== :: RecompReason -> RecompReason -> AnyHpcUsage
$c/= :: RecompReason -> RecompReason -> AnyHpcUsage
/= :: RecompReason -> RecompReason -> AnyHpcUsage
Eq)
instance Outputable RecompReason where
ppr :: RecompReason -> SDoc
ppr = \case
UnitDepRemoved UnitId
uid -> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"removed"
ModulePackageChanged FastString
s -> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package changed"
RecompReason
SourceFileChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Source file changed"
RecompReason
ThisUnitIdChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"-this-unit-id changed"
RecompReason
ImpurePlugin -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Impure plugin forced recompilation"
RecompReason
PluginsChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Plugins changed"
RecompReason
PluginFingerprintChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Plugin fingerprint changed"
RecompReason
ModuleInstChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Implementing module changed"
RecompReason
HieMissing -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HIE file is missing"
RecompReason
HieOutdated -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HIE file is out of date"
RecompReason
SigsMergeChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Signatures to merge in changed"
ModuleChanged ModuleName
m -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"changed"
ModuleChangedRaw ModuleName
m -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"changed (raw)"
ModuleChangedIface ModuleName
m -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"changed (interface)"
ModuleRemoved (UnitId
_uid, ModuleName
m) -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"removed"
ModuleAdded (UnitId
_uid, ModuleName
m) -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"added"
FileChanged String
fp -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
fp SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"changed"
CustomReason String
s -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s
RecompReason
FlagsChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Flags changed"
RecompReason
OptimFlagsChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Optimisation flags changed"
RecompReason
HpcFlagsChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HPC flags changed"
RecompReason
MissingBytecode -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Missing bytecode"
RecompReason
MissingObjectFile -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Missing object file"
RecompReason
MissingDynObjectFile -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Missing dynamic object file"
RecompReason
MissingDynHiFile -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Missing dynamic interface file"
RecompReason
MismatchedDynHiFile -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Mismatched dynamic interface file"
RecompReason
ObjectsChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Objects changed"
RecompReason
LibraryChanged -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Library changed"
recompileRequired :: RecompileRequired -> Bool
recompileRequired :: RecompileRequired -> AnyHpcUsage
recompileRequired RecompileRequired
UpToDate = AnyHpcUsage
False
recompileRequired RecompileRequired
_ = AnyHpcUsage
True
recompThen :: Monad m => m RecompileRequired -> m RecompileRequired -> m RecompileRequired
recompThen :: forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
recompThen m RecompileRequired
ma m RecompileRequired
mb = m RecompileRequired
ma m RecompileRequired
-> (RecompileRequired -> m RecompileRequired)
-> m RecompileRequired
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
RecompileRequired
UpToDate -> m RecompileRequired
mb
rr :: RecompileRequired
rr@(NeedsRecompile CompileReason
_) -> RecompileRequired -> m RecompileRequired
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecompileRequired
rr
checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired
checkList :: forall (m :: * -> *).
Monad m =>
[m RecompileRequired] -> m RecompileRequired
checkList = \case
[] -> RecompileRequired -> m RecompileRequired
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
(m RecompileRequired
check : [m RecompileRequired]
checks) -> m RecompileRequired
check m RecompileRequired -> m RecompileRequired -> m RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` [m RecompileRequired] -> m RecompileRequired
forall (m :: * -> *).
Monad m =>
[m RecompileRequired] -> m RecompileRequired
checkList [m RecompileRequired]
checks
checkOldIface
:: HscEnv
-> ModSummary
-> Maybe ModIface
-> IO (MaybeValidated ModIface)
checkOldIface :: HscEnv
-> ModSummary -> Maybe ModIface -> IO (MaybeValidated ModIface)
checkOldIface HscEnv
hsc_env ModSummary
mod_summary Maybe ModIface
maybe_iface
= do let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
Logger -> String -> IO ()
showPass Logger
logger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Checking old interface for " String -> String -> String
forall a. [a] -> [a] -> [a]
++
(DynFlags -> Module -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags (Module -> String) -> Module -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> Module
ms_mod ModSummary
mod_summary) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" (use -ddump-hi-diffs for more details)"
SDoc
-> HscEnv
-> IfG (MaybeValidated ModIface)
-> IO (MaybeValidated ModIface)
forall a. SDoc -> HscEnv -> IfG a -> IO a
initIfaceCheck (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"checkOldIface") HscEnv
hsc_env (IfG (MaybeValidated ModIface) -> IO (MaybeValidated ModIface))
-> IfG (MaybeValidated ModIface) -> IO (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$
HscEnv
-> ModSummary -> Maybe ModIface -> IfG (MaybeValidated ModIface)
check_old_iface HscEnv
hsc_env ModSummary
mod_summary Maybe ModIface
maybe_iface
check_old_iface
:: HscEnv
-> ModSummary
-> Maybe ModIface
-> IfG (MaybeValidated ModIface)
check_old_iface :: HscEnv
-> ModSummary -> Maybe ModIface -> IfG (MaybeValidated ModIface)
check_old_iface HscEnv
hsc_env ModSummary
mod_summary Maybe ModIface
maybe_iface
= let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
getIface :: IO (Maybe ModIface)
getIface =
case Maybe ModIface
maybe_iface of
Just ModIface
_ -> do
Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"We already have the old interface for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModSummary -> Module
ms_mod ModSummary
mod_summary))
Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModIface
maybe_iface
Maybe ModIface
Nothing -> DynFlags -> String -> IO (Maybe ModIface)
loadIface DynFlags
dflags (ModSummary -> String
msHiFilePath ModSummary
mod_summary)
loadIface :: DynFlags -> String -> IO (Maybe ModIface)
loadIface DynFlags
read_dflags String
iface_path = do
let ncu :: NameCache
ncu = HscEnv -> NameCache
hsc_NC HscEnv
hsc_env
MaybeErr SDoc ModIface
read_result <- DynFlags
-> NameCache -> Module -> String -> IO (MaybeErr SDoc ModIface)
readIface DynFlags
read_dflags NameCache
ncu (ModSummary -> Module
ms_mod ModSummary
mod_summary) String
iface_path
case MaybeErr SDoc ModIface
read_result of
Failed SDoc
err -> do
Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"FYI: cannot read old interface file:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
err)
Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Old interface file was invalid:" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
4 SDoc
err)
Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModIface
forall a. Maybe a
Nothing
Succeeded ModIface
iface -> do
Logger -> SDoc -> IO ()
trace_if Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Read the interface file" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
iface_path)
Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ModIface -> IO (Maybe ModIface))
-> Maybe ModIface -> IO (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just ModIface
iface
check_dyn_hi :: ModIface
-> IfG (MaybeValidated ModIface)
-> IfG (MaybeValidated ModIface)
check_dyn_hi :: ModIface
-> IfG (MaybeValidated ModIface) -> IfG (MaybeValidated ModIface)
check_dyn_hi ModIface
normal_iface IfG (MaybeValidated ModIface)
recomp_check | GeneralFlag -> DynFlags -> AnyHpcUsage
gopt GeneralFlag
Opt_BuildDynamicToo DynFlags
dflags = do
MaybeValidated ModIface
res <- IfG (MaybeValidated ModIface)
recomp_check
case MaybeValidated ModIface
res of
UpToDateItem ModIface
_ -> do
Maybe ModIface
maybe_dyn_iface <- IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface))
-> IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ DynFlags -> String -> IO (Maybe ModIface)
loadIface (DynFlags -> DynFlags
setDynamicNow DynFlags
dflags) (ModSummary -> String
msDynHiFilePath ModSummary
mod_summary)
case Maybe ModIface
maybe_dyn_iface of
Maybe ModIface
Nothing -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ RecompReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause RecompReason
MissingDynHiFile Maybe ModIface
forall a. Maybe a
Nothing
Just ModIface
dyn_iface | ModIfaceBackend -> Fingerprint
mi_iface_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
dyn_iface)
Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= ModIfaceBackend -> Fingerprint
mi_iface_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
normal_iface)
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ RecompReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause RecompReason
MismatchedDynHiFile Maybe ModIface
forall a. Maybe a
Nothing
Just {} -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeValidated ModIface
res
MaybeValidated ModIface
_ -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return MaybeValidated ModIface
res
check_dyn_hi ModIface
_ IfG (MaybeValidated ModIface)
recomp_check = IfG (MaybeValidated ModIface)
recomp_check
src_changed :: AnyHpcUsage
src_changed
| GeneralFlag -> DynFlags -> AnyHpcUsage
gopt GeneralFlag
Opt_ForceRecomp DynFlags
dflags = AnyHpcUsage
True
| AnyHpcUsage
otherwise = AnyHpcUsage
False
in do
AnyHpcUsage
-> IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when AnyHpcUsage
src_changed (IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ())
-> IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$
IO () -> IOEnv (Env IfGblEnv ()) ()
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv ()) ())
-> IO () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Recompilation check turned off")
case AnyHpcUsage
src_changed of
AnyHpcUsage
True | AnyHpcUsage -> AnyHpcUsage
not (Backend -> AnyHpcUsage
backendWritesFiles (Backend -> AnyHpcUsage) -> Backend -> AnyHpcUsage
forall a b. (a -> b) -> a -> b
$ DynFlags -> Backend
backend DynFlags
dflags) ->
MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
MustCompile Maybe ModIface
maybe_iface
AnyHpcUsage
True -> do
Maybe ModIface
maybe_iface' <- IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface))
-> IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ModIface)
getIface
MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
MustCompile Maybe ModIface
maybe_iface'
AnyHpcUsage
False -> do
Maybe ModIface
maybe_iface' <- IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface))
-> IO (Maybe ModIface) -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ModIface)
getIface
case Maybe ModIface
maybe_iface' of
Maybe ModIface
Nothing -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
MustCompile Maybe ModIface
forall a. Maybe a
Nothing
Just ModIface
iface ->
ModIface
-> IfG (MaybeValidated ModIface) -> IfG (MaybeValidated ModIface)
check_dyn_hi ModIface
iface (IfG (MaybeValidated ModIface) -> IfG (MaybeValidated ModIface))
-> IfG (MaybeValidated ModIface) -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModSummary -> ModIface -> IfG (MaybeValidated ModIface)
checkVersions HscEnv
hsc_env ModSummary
mod_summary ModIface
iface
checkVersions :: HscEnv
-> ModSummary
-> ModIface
-> IfG (MaybeValidated ModIface)
checkVersions :: HscEnv -> ModSummary -> ModIface -> IfG (MaybeValidated ModIface)
checkVersions HscEnv
hsc_env ModSummary
mod_summary ModIface
iface
= do { IO () -> IOEnv (Env IfGblEnv ()) ()
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv ()) ())
-> IO () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Considering whether compilation is required for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
; HscEnv
hsc_env <- TcRnIf IfGblEnv () HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; if ModIface -> Fingerprint
forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash ModIface
iface Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= ModSummary -> Fingerprint
ms_hs_hash ModSummary
mod_summary
then MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ RecompReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause RecompReason
SourceFileChanged Maybe ModIface
forall a. Maybe a
Nothing else do {
; if AnyHpcUsage -> AnyHpcUsage
not (HomeUnit -> Module -> AnyHpcUsage
isHomeModule HomeUnit
home_unit (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface))
then MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ RecompReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. RecompReason -> Maybe a -> MaybeValidated a
outOfDateItemBecause RecompReason
ThisUnitIdChanged Maybe ModIface
forall a. Maybe a
Nothing else do {
; RecompileRequired
recomp <- IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> IO RecompileRequired
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModIface -> IO RecompileRequired
checkFlagHash HscEnv
hsc_env ModIface
iface
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` HscEnv -> ModIface -> IO RecompileRequired
checkOptimHash HscEnv
hsc_env ModIface
iface
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` HscEnv -> ModIface -> IO RecompileRequired
checkHpcHash HscEnv
hsc_env ModIface
iface
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
checkMergedSignatures HscEnv
hsc_env ModSummary
mod_summary ModIface
iface
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` Logger
-> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired
checkHsig Logger
logger HomeUnit
home_unit ModSummary
mod_summary ModIface
iface
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen` RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynFlags -> ModSummary -> RecompileRequired
checkHie DynFlags
dflags ModSummary
mod_summary)
; case RecompileRequired
recomp of (NeedsRecompile CompileReason
reason) -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
reason Maybe ModIface
forall a. Maybe a
Nothing ; RecompileRequired
_ -> do {
; RecompileRequired
recomp <- HscEnv
-> ModSummary
-> ModIface
-> IOEnv (Env IfGblEnv ()) RecompileRequired
checkDependencies HscEnv
hsc_env ModSummary
mod_summary ModIface
iface
; case RecompileRequired
recomp of (NeedsRecompile CompileReason
reason) -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
reason (ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just ModIface
iface) ; RecompileRequired
_ -> do {
; RecompileRequired
recomp <- Plugins -> ModIface -> IOEnv (Env IfGblEnv ()) RecompileRequired
checkPlugins (HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env) ModIface
iface
; case RecompileRequired
recomp of (NeedsRecompile CompileReason
reason) -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
reason Maybe ModIface
forall a. Maybe a
Nothing ; RecompileRequired
_ -> do {
AnyHpcUsage
-> IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ()
forall (f :: * -> *). Applicative f => AnyHpcUsage -> f () -> f ()
when (GhcMode -> AnyHpcUsage
isOneShot (DynFlags -> GhcMode
ghcMode (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))) (IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ())
-> IOEnv (Env IfGblEnv ()) () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ do {
; (ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv ()) ()
forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ ((ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv ()) ())
-> (ExternalPackageState -> ExternalPackageState)
-> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ \ExternalPackageState
eps -> ExternalPackageState
eps { eps_is_boot = mkModDeps $ dep_boot_mods (mi_deps iface) }
}
; RecompileRequired
recomp <- [IOEnv (Env IfGblEnv ()) RecompileRequired]
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall (m :: * -> *).
Monad m =>
[m RecompileRequired] -> m RecompileRequired
checkList [FinderCache -> Usage -> IOEnv (Env IfGblEnv ()) RecompileRequired
checkModUsage (HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env) Usage
u
| Usage
u <- ModIface -> [Usage]
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages ModIface
iface]
; case RecompileRequired
recomp of (NeedsRecompile CompileReason
reason) -> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ CompileReason -> Maybe ModIface -> MaybeValidated ModIface
forall a. CompileReason -> Maybe a -> MaybeValidated a
OutOfDateItem CompileReason
reason (ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just ModIface
iface) ; RecompileRequired
_ -> do {
; MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (MaybeValidated ModIface -> IfG (MaybeValidated ModIface))
-> MaybeValidated ModIface -> IfG (MaybeValidated ModIface)
forall a b. (a -> b) -> a -> b
$ ModIface -> MaybeValidated ModIface
forall a. a -> MaybeValidated a
UpToDateItem ModIface
iface
}}}}}}}
where
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
checkPlugins :: Plugins -> ModIface -> IfG RecompileRequired
checkPlugins :: Plugins -> ModIface -> IOEnv (Env IfGblEnv ()) RecompileRequired
checkPlugins Plugins
plugins ModIface
iface = IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> IO RecompileRequired
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ do
PluginRecompile
recomp <- Plugins -> IO PluginRecompile
recompPlugins Plugins
plugins
let new_fingerprint :: Fingerprint
new_fingerprint = PluginRecompile -> Fingerprint
fingerprintPluginRecompile PluginRecompile
recomp
let old_fingerprint :: Fingerprint
old_fingerprint = ModIfaceBackend -> Fingerprint
mi_plugin_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
pluginRecompileToRecompileRequired Fingerprint
old_fingerprint Fingerprint
new_fingerprint PluginRecompile
recomp
recompPlugins :: Plugins -> IO PluginRecompile
recompPlugins :: Plugins -> IO PluginRecompile
recompPlugins Plugins
plugins = [PluginRecompile] -> PluginRecompile
forall a. Monoid a => [a] -> a
mconcat ([PluginRecompile] -> PluginRecompile)
-> IO [PluginRecompile] -> IO PluginRecompile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PluginWithArgs -> IO PluginRecompile)
-> [PluginWithArgs] -> IO [PluginRecompile]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PluginWithArgs -> IO PluginRecompile
pluginRecompile' (Plugins -> [PluginWithArgs]
pluginsWithArgs Plugins
plugins)
fingerprintPlugins :: Plugins -> IO Fingerprint
fingerprintPlugins :: Plugins -> IO Fingerprint
fingerprintPlugins Plugins
plugins = PluginRecompile -> Fingerprint
fingerprintPluginRecompile (PluginRecompile -> Fingerprint)
-> IO PluginRecompile -> IO Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Plugins -> IO PluginRecompile
recompPlugins Plugins
plugins
fingerprintPluginRecompile :: PluginRecompile -> Fingerprint
fingerprintPluginRecompile :: PluginRecompile -> Fingerprint
fingerprintPluginRecompile PluginRecompile
recomp = case PluginRecompile
recomp of
PluginRecompile
NoForceRecompile -> String -> Fingerprint
fingerprintString String
"NoForceRecompile"
PluginRecompile
ForceRecompile -> String -> Fingerprint
fingerprintString String
"ForceRecompile"
MaybeRecompile Fingerprint
fp -> Fingerprint
fp
pluginRecompileToRecompileRequired
:: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
pluginRecompileToRecompileRequired :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
pluginRecompileToRecompileRequired Fingerprint
old_fp Fingerprint
new_fp PluginRecompile
pr
| Fingerprint
old_fp Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
new_fp =
case PluginRecompile
pr of
PluginRecompile
NoForceRecompile -> RecompileRequired
UpToDate
MaybeRecompile Fingerprint
_ -> RecompileRequired
UpToDate
PluginRecompile
ForceRecompile -> RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
ImpurePlugin
| Fingerprint
old_fp Fingerprint -> [Fingerprint] -> AnyHpcUsage
forall a. Eq a => a -> [a] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Fingerprint]
magic_fingerprints AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
||
Fingerprint
new_fp Fingerprint -> [Fingerprint] -> AnyHpcUsage
forall a. Eq a => a -> [a] -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` [Fingerprint]
magic_fingerprints
= RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
PluginsChanged
| AnyHpcUsage
otherwise =
case PluginRecompile
pr of
PluginRecompile
ForceRecompile -> RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
PluginFingerprintChanged
PluginRecompile
_ -> RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
PluginFingerprintChanged
where
magic_fingerprints :: [Fingerprint]
magic_fingerprints =
[ String -> Fingerprint
fingerprintString String
"NoForceRecompile"
, String -> Fingerprint
fingerprintString String
"ForceRecompile"
]
checkHsig :: Logger -> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired
checkHsig :: Logger
-> HomeUnit -> ModSummary -> ModIface -> IO RecompileRequired
checkHsig Logger
logger HomeUnit
home_unit ModSummary
mod_summary ModIface
iface = do
let outer_mod :: Module
outer_mod = ModSummary -> Module
ms_mod ModSummary
mod_summary
inner_mod :: Module
inner_mod = HomeUnit -> ModuleName -> Module
homeModuleNameInstantiation HomeUnit
home_unit (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
outer_mod)
AnyHpcUsage -> IO ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
AnyHpcUsage -> m ()
massert (HomeUnit -> Module -> AnyHpcUsage
isHomeModule HomeUnit
home_unit Module
outer_mod)
case Module
inner_mod Module -> Module -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module ModIface
iface of
AnyHpcUsage
True -> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"implementing module unchanged")
AnyHpcUsage
False -> RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
ModuleInstChanged
checkHie :: DynFlags -> ModSummary -> RecompileRequired
checkHie :: DynFlags -> ModSummary -> RecompileRequired
checkHie DynFlags
dflags ModSummary
mod_summary =
let hie_date_opt :: Maybe UTCTime
hie_date_opt = ModSummary -> Maybe UTCTime
ms_hie_date ModSummary
mod_summary
hi_date :: Maybe UTCTime
hi_date = ModSummary -> Maybe UTCTime
ms_iface_date ModSummary
mod_summary
in if AnyHpcUsage -> AnyHpcUsage
not (GeneralFlag -> DynFlags -> AnyHpcUsage
gopt GeneralFlag
Opt_WriteHie DynFlags
dflags)
then RecompileRequired
UpToDate
else case (Maybe UTCTime
hie_date_opt, Maybe UTCTime
hi_date) of
(Maybe UTCTime
Nothing, Maybe UTCTime
_) -> RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
HieMissing
(Just UTCTime
hie_date, Just UTCTime
hi_date)
| UTCTime
hie_date UTCTime -> UTCTime -> AnyHpcUsage
forall a. Ord a => a -> a -> AnyHpcUsage
< UTCTime
hi_date
-> RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
HieOutdated
(Maybe UTCTime, Maybe UTCTime)
_ -> RecompileRequired
UpToDate
checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
checkFlagHash HscEnv
hsc_env ModIface
iface = do
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let old_hash :: Fingerprint
old_hash = ModIfaceBackend -> Fingerprint
mi_flag_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
Fingerprint
new_hash <- HscEnv -> Module -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintDynFlags HscEnv
hsc_env (ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface) BinHandle -> Name -> IO ()
putNameLiterally
case Fingerprint
old_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
new_hash of
AnyHpcUsage
True -> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module flags unchanged")
AnyHpcUsage
False -> Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
FlagsChanged
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Module flags have changed")
Fingerprint
old_hash Fingerprint
new_hash
checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
checkOptimHash HscEnv
hsc_env ModIface
iface = do
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let old_hash :: Fingerprint
old_hash = ModIfaceBackend -> Fingerprint
mi_opt_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
Fingerprint
new_hash <- DynFlags -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintOptFlags (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
BinHandle -> Name -> IO ()
putNameLiterally
if | Fingerprint
old_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
new_hash
-> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Optimisation flags unchanged")
| GeneralFlag -> DynFlags -> AnyHpcUsage
gopt GeneralFlag
Opt_IgnoreOptimChanges (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
-> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Optimisation flags changed; ignoring")
| AnyHpcUsage
otherwise
-> Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
OptimFlagsChanged
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Optimisation flags have changed")
Fingerprint
old_hash Fingerprint
new_hash
checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
checkHpcHash HscEnv
hsc_env ModIface
iface = do
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let old_hash :: Fingerprint
old_hash = ModIfaceBackend -> Fingerprint
mi_hpc_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
Fingerprint
new_hash <- DynFlags -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintHpcFlags (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
BinHandle -> Name -> IO ()
putNameLiterally
if | Fingerprint
old_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
new_hash
-> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HPC flags unchanged")
| GeneralFlag -> DynFlags -> AnyHpcUsage
gopt GeneralFlag
Opt_IgnoreHpcChanges (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
-> Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HPC flags changed; ignoring")
| AnyHpcUsage
otherwise
-> Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
HpcFlagsChanged
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" HPC flags have changed")
Fingerprint
old_hash Fingerprint
new_hash
checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
checkMergedSignatures HscEnv
hsc_env ModSummary
mod_summary ModIface
iface = do
let logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
let unit_state :: UnitState
unit_state = (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
let old_merged :: [Module]
old_merged = [Module] -> [Module]
forall a. Ord a => [a] -> [a]
sort [ Module
mod | UsageMergedRequirement{ usg_mod :: Usage -> Module
usg_mod = Module
mod } <- ModIface -> [Usage]
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages ModIface
iface ]
new_merged :: [Module]
new_merged = case ModuleName
-> Map ModuleName [InstantiatedModule]
-> Maybe [InstantiatedModule]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModSummary -> ModuleName
ms_mod_name ModSummary
mod_summary)
(UnitState -> Map ModuleName [InstantiatedModule]
requirementContext UnitState
unit_state) of
Maybe [InstantiatedModule]
Nothing -> []
Just [InstantiatedModule]
r -> [Module] -> [Module]
forall a. Ord a => [a] -> [a]
sort ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ (InstantiatedModule -> Module) -> [InstantiatedModule] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> InstantiatedModule -> Module
instModuleToModule UnitState
unit_state) [InstantiatedModule]
r
if [Module]
old_merged [Module] -> [Module] -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== [Module]
new_merged
then Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"signatures to merge in unchanged" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [Module] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Module]
new_merged)
else RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
SigsMergeChanged
checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
checkDependencies :: HscEnv
-> ModSummary
-> ModIface
-> IOEnv (Env IfGblEnv ()) RecompileRequired
checkDependencies HscEnv
hsc_env ModSummary
summary ModIface
iface
= do
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
res_normal <- (ModuleName -> PkgQual -> IO FindResult)
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall t l.
(ModuleName -> t -> IO FindResult)
-> [(t, GenLocated l ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
classify_import (HscEnv -> ModuleName -> PkgQual -> IO FindResult
findImportedModule HscEnv
hsc_env) (ModSummary -> [(PkgQual, GenLocated SrcSpan ModuleName)]
ms_textual_imps ModSummary
summary [(PkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
forall a. [a] -> [a] -> [a]
++ ModSummary -> [(PkgQual, GenLocated SrcSpan ModuleName)]
ms_srcimps ModSummary
summary)
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
res_plugin <- (ModuleName -> PkgQual -> IO FindResult)
-> [(PkgQual, GenLocated SrcSpan ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall t l.
(ModuleName -> t -> IO FindResult)
-> [(t, GenLocated l ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
classify_import (\ModuleName
mod PkgQual
_ -> FinderCache
-> FinderOpts
-> UnitState
-> Maybe HomeUnit
-> ModuleName
-> IO FindResult
findPluginModule FinderCache
fc FinderOpts
fopts UnitState
units Maybe HomeUnit
mhome_unit ModuleName
mod) (ModSummary -> [(PkgQual, GenLocated SrcSpan ModuleName)]
ms_plugin_imps ModSummary
summary)
case [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> Either
CompileReason [Either (UnitId, ModuleName) (FastString, UnitId)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
res_normal [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall a. [a] -> [a] -> [a]
++ [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
res_plugin [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> [Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall a. [a] -> [a] -> [a]
++ [Either (UnitId, ModuleName) (FastString, UnitId)
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
forall a b. b -> Either a b
Right (Either (UnitId, ModuleName) (FastString, UnitId)
fake_ghc_prim_import)| ModSummary -> AnyHpcUsage
ms_ghc_prim_import ModSummary
summary]) of
Left CompileReason
recomp -> RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ CompileReason -> RecompileRequired
NeedsRecompile CompileReason
recomp
Right [Either (UnitId, ModuleName) (FastString, UnitId)]
es -> do
let ([(UnitId, ModuleName)]
hs, [(FastString, UnitId)]
ps) = [Either (UnitId, ModuleName) (FastString, UnitId)]
-> ([(UnitId, ModuleName)], [(FastString, UnitId)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (UnitId, ModuleName) (FastString, UnitId)]
es
IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> IO RecompileRequired
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$
[(UnitId, ModuleName)]
-> [(UnitId, ModuleName)] -> IO RecompileRequired
check_mods ([(UnitId, ModuleName)] -> [(UnitId, ModuleName)]
forall a. Ord a => [a] -> [a]
sort [(UnitId, ModuleName)]
hs) [(UnitId, ModuleName)]
prev_dep_mods
IO RecompileRequired
-> IO RecompileRequired -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
m RecompileRequired -> m RecompileRequired -> m RecompileRequired
`recompThen`
let allPkgDeps :: [(FastString, UnitId)]
allPkgDeps = ((FastString, UnitId) -> (FastString, UnitId) -> Ordering)
-> [(FastString, UnitId)] -> [(FastString, UnitId)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((FastString, UnitId) -> UnitId)
-> (FastString, UnitId) -> (FastString, UnitId) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (FastString, UnitId) -> UnitId
forall a b. (a, b) -> b
snd) ([(FastString, UnitId)] -> [(FastString, UnitId)])
-> [(FastString, UnitId)] -> [(FastString, UnitId)]
forall a b. (a -> b) -> a -> b
$ ((FastString, UnitId) -> UnitId)
-> [(FastString, UnitId)] -> [(FastString, UnitId)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (FastString, UnitId) -> UnitId
forall a b. (a, b) -> b
snd ([(FastString, UnitId)]
ps [(FastString, UnitId)]
-> [(FastString, UnitId)] -> [(FastString, UnitId)]
forall a. [a] -> [a] -> [a]
++ [(FastString, UnitId)]
implicit_deps)
in [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired
check_packages [(FastString, UnitId)]
allPkgDeps [UnitId]
prev_dep_pkgs
where
classify_import :: (ModuleName -> t -> IO FindResult)
-> [(t, GenLocated l ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
classify_import :: forall t l.
(ModuleName -> t -> IO FindResult)
-> [(t, GenLocated l ModuleName)]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
classify_import ModuleName -> t -> IO FindResult
find_import [(t, GenLocated l ModuleName)]
imports =
IO
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))])
-> IO
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
-> IfG
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall a b. (a -> b) -> a -> b
$ ((t, GenLocated l ModuleName)
-> IO
(Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))))
-> [(t, GenLocated l ModuleName)]
-> IO
[Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(t
mb_pkg, L l
_ ModuleName
mod) ->
let reason :: RecompReason
reason = ModuleName -> RecompReason
ModuleChanged ModuleName
mod
in RecompReason
-> FindResult
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
classify RecompReason
reason (FindResult
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId)))
-> IO FindResult
-> IO
(Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName -> t -> IO FindResult
find_import ModuleName
mod t
mb_pkg)
[(t, GenLocated l ModuleName)]
imports
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
fopts :: FinderOpts
fopts = DynFlags -> FinderOpts
initFinderOpts DynFlags
dflags
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env
fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
mhome_unit :: Maybe HomeUnit
mhome_unit = HscEnv -> Maybe HomeUnit
hsc_home_unit_maybe HscEnv
hsc_env
all_home_units :: Set UnitId
all_home_units = HscEnv -> Set UnitId
hsc_all_home_unit_ids HscEnv
hsc_env
units :: UnitState
units = (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
prev_dep_mods :: [(UnitId, ModuleName)]
prev_dep_mods = ((UnitId, ModuleNameWithIsBoot) -> (UnitId, ModuleName))
-> [(UnitId, ModuleNameWithIsBoot)] -> [(UnitId, ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
map ((ModuleNameWithIsBoot -> ModuleName)
-> (UnitId, ModuleNameWithIsBoot) -> (UnitId, ModuleName)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ModuleNameWithIsBoot -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod) ([(UnitId, ModuleNameWithIsBoot)] -> [(UnitId, ModuleName)])
-> [(UnitId, ModuleNameWithIsBoot)] -> [(UnitId, ModuleName)]
forall a b. (a -> b) -> a -> b
$ Set (UnitId, ModuleNameWithIsBoot)
-> [(UnitId, ModuleNameWithIsBoot)]
forall a. Set a -> [a]
Set.toAscList (Set (UnitId, ModuleNameWithIsBoot)
-> [(UnitId, ModuleNameWithIsBoot)])
-> Set (UnitId, ModuleNameWithIsBoot)
-> [(UnitId, ModuleNameWithIsBoot)]
forall a b. (a -> b) -> a -> b
$ Dependencies -> Set (UnitId, ModuleNameWithIsBoot)
dep_direct_mods (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)
prev_dep_pkgs :: [UnitId]
prev_dep_pkgs = Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toAscList (Set UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Dependencies -> Set UnitId
dep_direct_pkgs (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface))
(Dependencies -> Set UnitId
dep_plugin_pkgs (ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
iface)))
implicit_deps :: [(FastString, UnitId)]
implicit_deps = (UnitId -> (FastString, UnitId))
-> [UnitId] -> [(FastString, UnitId)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> FastString
fsLit String
"Implicit",) (DynFlags -> [UnitId]
implicitPackageDeps DynFlags
dflags)
fake_ghc_prim_import :: Either (UnitId, ModuleName) (FastString, UnitId)
fake_ghc_prim_import = case Maybe HomeUnit
mhome_unit of
Just HomeUnit
home_unit
| HomeUnit -> UnitId
forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit UnitId -> UnitId -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== UnitId
primUnitId
-> (UnitId, ModuleName)
-> Either (UnitId, ModuleName) (FastString, UnitId)
forall a b. a -> Either a b
Left (UnitId
primUnitId, String -> ModuleName
mkModuleName String
"GHC.Prim")
Maybe HomeUnit
_ -> (FastString, UnitId)
-> Either (UnitId, ModuleName) (FastString, UnitId)
forall a b. b -> Either a b
Right (String -> FastString
fsLit String
"GHC.Prim", UnitId
primUnitId)
classify :: RecompReason
-> FindResult
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
classify RecompReason
_ (Found ModLocation
_ Module
mod)
| (Unit -> UnitId
toUnitId (Unit -> UnitId) -> Unit -> UnitId
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod) UnitId -> Set UnitId -> AnyHpcUsage
forall a. Eq a => a -> Set a -> AnyHpcUsage
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> AnyHpcUsage
`elem` Set UnitId
all_home_units = Either (UnitId, ModuleName) (FastString, UnitId)
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
forall a b. b -> Either a b
Right ((UnitId, ModuleName)
-> Either (UnitId, ModuleName) (FastString, UnitId)
forall a b. a -> Either a b
Left ((Unit -> UnitId
toUnitId (Unit -> UnitId) -> Unit -> UnitId
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod), Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod))
| AnyHpcUsage
otherwise = Either (UnitId, ModuleName) (FastString, UnitId)
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
forall a b. b -> Either a b
Right ((FastString, UnitId)
-> Either (UnitId, ModuleName) (FastString, UnitId)
forall a b. b -> Either a b
Right (ModuleName -> FastString
moduleNameFS (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod), Unit -> UnitId
toUnitId (Unit -> UnitId) -> Unit -> UnitId
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
classify RecompReason
reason FindResult
_ = CompileReason
-> Either
CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))
forall a b. a -> Either a b
Left (RecompReason -> CompileReason
RecompBecause RecompReason
reason)
check_mods :: [(UnitId, ModuleName)] -> [(UnitId, ModuleName)] -> IO RecompileRequired
check_mods :: [(UnitId, ModuleName)]
-> [(UnitId, ModuleName)] -> IO RecompileRequired
check_mods [] [] = RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
check_mods [] ((UnitId, ModuleName)
old:[(UnitId, ModuleName)]
_) = do
Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module no longer" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ((UnitId, ModuleName) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId, ModuleName)
old) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in dependencies"
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause (RecompReason -> RecompileRequired)
-> RecompReason -> RecompileRequired
forall a b. (a -> b) -> a -> b
$ (UnitId, ModuleName) -> RecompReason
ModuleRemoved (UnitId, ModuleName)
old
check_mods ((UnitId, ModuleName)
new:[(UnitId, ModuleName)]
news) [(UnitId, ModuleName)]
olds
| Just ((UnitId, ModuleName)
old, [(UnitId, ModuleName)]
olds') <- [(UnitId, ModuleName)]
-> Maybe ((UnitId, ModuleName), [(UnitId, ModuleName)])
forall a. [a] -> Maybe (a, [a])
uncons [(UnitId, ModuleName)]
olds
, (UnitId, ModuleName)
new (UnitId, ModuleName) -> (UnitId, ModuleName) -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== (UnitId, ModuleName)
old = [(UnitId, ModuleName)]
-> [(UnitId, ModuleName)] -> IO RecompileRequired
check_mods (((UnitId, ModuleName) -> AnyHpcUsage)
-> [(UnitId, ModuleName)] -> [(UnitId, ModuleName)]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
dropWhile ((UnitId, ModuleName) -> (UnitId, ModuleName) -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== (UnitId, ModuleName)
new) [(UnitId, ModuleName)]
news) [(UnitId, ModuleName)]
olds'
| AnyHpcUsage
otherwise = do
Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imported module " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes ((UnitId, ModuleName) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId, ModuleName)
new) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" not among previous dependencies"
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause (RecompReason -> RecompileRequired)
-> RecompReason -> RecompileRequired
forall a b. (a -> b) -> a -> b
$ (UnitId, ModuleName) -> RecompReason
ModuleAdded (UnitId, ModuleName)
new
check_packages :: [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired
check_packages :: [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired
check_packages [] [] = RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
check_packages [] (UnitId
old:[UnitId]
_) = do
Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
quotes (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
old) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"no longer in dependencies"
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause (RecompReason -> RecompileRequired)
-> RecompReason -> RecompileRequired
forall a b. (a -> b) -> a -> b
$ UnitId -> RecompReason
UnitDepRemoved UnitId
old
check_packages ((FastString
new_name, UnitId
new_unit):[(FastString, UnitId)]
news) [UnitId]
olds
| Just (UnitId
old, [UnitId]
olds') <- [UnitId] -> Maybe (UnitId, [UnitId])
forall a. [a] -> Maybe (a, [a])
uncons [UnitId]
olds
, UnitId
new_unit UnitId -> UnitId -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== UnitId
old = [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired
check_packages (((FastString, UnitId) -> AnyHpcUsage)
-> [(FastString, UnitId)] -> [(FastString, UnitId)]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
dropWhile ((UnitId -> UnitId -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== UnitId
new_unit) (UnitId -> AnyHpcUsage)
-> ((FastString, UnitId) -> UnitId)
-> (FastString, UnitId)
-> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FastString, UnitId) -> UnitId
forall a b. (a, b) -> b
snd) [(FastString, UnitId)]
news) [UnitId]
olds'
| AnyHpcUsage
otherwise = do
Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imported package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
new_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
new_unit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not among previous dependencies"
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IO RecompileRequired)
-> RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> RecompileRequired
needsRecompileBecause (RecompReason -> RecompileRequired)
-> RecompReason -> RecompileRequired
forall a b. (a -> b) -> a -> b
$ FastString -> RecompReason
ModulePackageChanged FastString
new_name
needInterface :: Module -> (ModIface -> IO RecompileRequired)
-> IfG RecompileRequired
needInterface :: Module
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
needInterface Module
mod ModIface -> IO RecompileRequired
continue
= do
Maybe ModIface
mb_recomp <- String -> Module -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
tryGetModIface
String
"need version info for"
Module
mod
case Maybe ModIface
mb_recomp of
Maybe ModIface
Nothing -> RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ CompileReason -> RecompileRequired
NeedsRecompile CompileReason
MustCompile
Just ModIface
iface -> IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> IO RecompileRequired
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ ModIface -> IO RecompileRequired
continue ModIface
iface
tryGetModIface :: String -> Module -> IfG (Maybe ModIface)
tryGetModIface :: String -> Module -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
tryGetModIface String
doc_msg Module
mod
= do
Logger
logger <- IOEnv (Env IfGblEnv ()) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
let doc_str :: SDoc
doc_str = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
doc_msg, Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod]
IO () -> IOEnv (Env IfGblEnv ()) ()
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv ()) ())
-> IO () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Checking interface for module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
MaybeErr SDoc ModIface
mb_iface <- SDoc -> Module -> WhereFrom -> IfM () (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface SDoc
doc_str Module
mod WhereFrom
ImportBySystem
case MaybeErr SDoc ModIface
mb_iface of
Failed SDoc
_ -> do
IO () -> IOEnv (Env IfGblEnv ()) ()
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env IfGblEnv ()) ())
-> IO () -> IOEnv (Env IfGblEnv ()) ()
forall a b. (a -> b) -> a -> b
$ Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't load interface for module", Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod])
Maybe ModIface -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ModIface
forall a. Maybe a
Nothing
Succeeded ModIface
iface -> Maybe ModIface -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ModIface -> IOEnv (Env IfGblEnv ()) (Maybe ModIface))
-> Maybe ModIface -> IOEnv (Env IfGblEnv ()) (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$ ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just ModIface
iface
checkModUsage :: FinderCache -> Usage -> IfG RecompileRequired
checkModUsage :: FinderCache -> Usage -> IOEnv (Env IfGblEnv ()) RecompileRequired
checkModUsage FinderCache
_ UsagePackageModule{
usg_mod :: Usage -> Module
usg_mod = Module
mod,
usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
old_mod_hash } = do
Logger
logger <- IOEnv (Env IfGblEnv ()) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
Module
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
needInterface Module
mod ((ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let reason :: RecompReason
reason = ModuleName -> RecompReason
ModuleChanged (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkModuleFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash (ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))
checkModUsage FinderCache
_ UsageMergedRequirement{ usg_mod :: Usage -> Module
usg_mod = Module
mod, usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
old_mod_hash } = do
Logger
logger <- IOEnv (Env IfGblEnv ()) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
Module
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
needInterface Module
mod ((ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let reason :: RecompReason
reason = ModuleName -> RecompReason
ModuleChangedRaw (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkModuleFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash (ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))
checkModUsage FinderCache
_ UsageHomeModuleInterface{ usg_mod_name :: Usage -> ModuleName
usg_mod_name = ModuleName
mod_name
, usg_unit_id :: Usage -> UnitId
usg_unit_id = UnitId
uid
, usg_iface_hash :: Usage -> Fingerprint
usg_iface_hash = Fingerprint
old_mod_hash } = do
let mod :: Module
mod = Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
uid)) ModuleName
mod_name
Logger
logger <- IOEnv (Env IfGblEnv ()) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
Module
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
needInterface Module
mod ((ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let reason :: RecompReason
reason = ModuleName -> RecompReason
ModuleChangedIface ModuleName
mod_name
Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkIfaceFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash (ModIfaceBackend -> Fingerprint
mi_iface_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))
checkModUsage FinderCache
_ UsageHomeModule{
usg_mod_name :: Usage -> ModuleName
usg_mod_name = ModuleName
mod_name,
usg_unit_id :: Usage -> UnitId
usg_unit_id = UnitId
uid,
usg_mod_hash :: Usage -> Fingerprint
usg_mod_hash = Fingerprint
old_mod_hash,
usg_exports :: Usage -> Maybe Fingerprint
usg_exports = Maybe Fingerprint
maybe_old_export_hash,
usg_entities :: Usage -> [(OccName, Fingerprint)]
usg_entities = [(OccName, Fingerprint)]
old_decl_hash }
= do
let mod :: Module
mod = Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
uid)) ModuleName
mod_name
Logger
logger <- IOEnv (Env IfGblEnv ()) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
Module
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
needInterface Module
mod ((ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> (ModIface -> IO RecompileRequired)
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let
new_mod_hash :: Fingerprint
new_mod_hash = ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
new_decl_hash :: OccName -> Maybe (OccName, Fingerprint)
new_decl_hash = ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
new_export_hash :: Fingerprint
new_export_hash = ModIfaceBackend -> Fingerprint
mi_exp_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
reason :: RecompReason
reason = ModuleName -> RecompReason
ModuleChanged (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
IO RecompileRequired -> IO RecompileRequired
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IO RecompileRequired)
-> IO RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ do
RecompileRequired
recompile <- Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkModuleFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash Fingerprint
new_mod_hash
if AnyHpcUsage -> AnyHpcUsage
not (RecompileRequired -> AnyHpcUsage
recompileRequired RecompileRequired
recompile)
then RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
else [IO RecompileRequired] -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
[m RecompileRequired] -> m RecompileRequired
checkList
[
Logger
-> RecompReason
-> Maybe Fingerprint
-> Fingerprint
-> SDoc
-> IO RecompileRequired
checkMaybeHash Logger
logger RecompReason
reason Maybe Fingerprint
maybe_old_export_hash Fingerprint
new_export_hash
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Export list changed")
,
[IO RecompileRequired] -> IO RecompileRequired
forall (m :: * -> *).
Monad m =>
[m RecompileRequired] -> m RecompileRequired
checkList [ Logger
-> RecompReason
-> (OccName -> Maybe (OccName, Fingerprint))
-> (OccName, Fingerprint)
-> IO RecompileRequired
checkEntityUsage Logger
logger RecompReason
reason OccName -> Maybe (OccName, Fingerprint)
new_decl_hash (OccName, Fingerprint)
u
| (OccName, Fingerprint)
u <- [(OccName, Fingerprint)]
old_decl_hash]
, Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Great! The bits I use are up to date")
]
checkModUsage FinderCache
fc UsageFile{ usg_file_path :: Usage -> String
usg_file_path = String
file,
usg_file_hash :: Usage -> Fingerprint
usg_file_hash = Fingerprint
old_hash,
usg_file_label :: Usage -> Maybe String
usg_file_label = Maybe String
mlabel } =
IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RecompileRequired -> IOEnv (Env IfGblEnv ()) RecompileRequired)
-> IO RecompileRequired
-> IOEnv (Env IfGblEnv ()) RecompileRequired
forall a b. (a -> b) -> a -> b
$
(IOException -> IO RecompileRequired)
-> IO RecompileRequired -> IO RecompileRequired
forall a. (IOException -> IO a) -> IO a -> IO a
handleIO IOException -> IO RecompileRequired
handler (IO RecompileRequired -> IO RecompileRequired)
-> IO RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ do
Fingerprint
new_hash <- FinderCache -> String -> IO Fingerprint
lookupFileCache FinderCache
fc String
file
if (Fingerprint
old_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Fingerprint
new_hash)
then RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
recomp
else RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
where
reason :: RecompReason
reason = String -> RecompReason
FileChanged String
file
recomp :: RecompileRequired
recomp = RecompReason -> RecompileRequired
needsRecompileBecause (RecompReason -> RecompileRequired)
-> RecompReason -> RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompReason -> Maybe RecompReason -> RecompReason
forall a. a -> Maybe a -> a
fromMaybe RecompReason
reason (Maybe RecompReason -> RecompReason)
-> Maybe RecompReason -> RecompReason
forall a b. (a -> b) -> a -> b
$ (String -> RecompReason) -> Maybe String -> Maybe RecompReason
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> RecompReason
CustomReason Maybe String
mlabel
handler :: IOException -> IO RecompileRequired
handler = if AnyHpcUsage
debugIsOn
then \IOException
e -> String -> SDoc -> IO RecompileRequired -> IO RecompileRequired
forall a. String -> SDoc -> a -> a
pprTrace String
"UsageFile" (String -> SDoc
forall doc. IsLine doc => String -> doc
text (IOException -> String
forall a. Show a => a -> String
show IOException
e)) (IO RecompileRequired -> IO RecompileRequired)
-> IO RecompileRequired -> IO RecompileRequired
forall a b. (a -> b) -> a -> b
$ RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
recomp
else \IOException
_ -> RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
recomp
checkModuleFingerprint
:: Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkModuleFingerprint :: Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkModuleFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash Fingerprint
new_mod_hash
| Fingerprint
new_mod_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
old_mod_hash
= Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module fingerprint unchanged")
| AnyHpcUsage
otherwise
= Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
reason (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Module fingerprint has changed")
Fingerprint
old_mod_hash Fingerprint
new_mod_hash
checkIfaceFingerprint
:: Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkIfaceFingerprint :: Logger
-> RecompReason
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
checkIfaceFingerprint Logger
logger RecompReason
reason Fingerprint
old_mod_hash Fingerprint
new_mod_hash
| Fingerprint
new_mod_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
old_mod_hash
= Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Iface fingerprint unchanged")
| AnyHpcUsage
otherwise
= Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
reason (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Iface fingerprint has changed")
Fingerprint
old_mod_hash Fingerprint
new_mod_hash
checkMaybeHash
:: Logger
-> RecompReason
-> Maybe Fingerprint
-> Fingerprint
-> SDoc
-> IO RecompileRequired
checkMaybeHash :: Logger
-> RecompReason
-> Maybe Fingerprint
-> Fingerprint
-> SDoc
-> IO RecompileRequired
checkMaybeHash Logger
logger RecompReason
reason Maybe Fingerprint
maybe_old_hash Fingerprint
new_hash SDoc
doc
| Just Fingerprint
hash <- Maybe Fingerprint
maybe_old_hash, Fingerprint
hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Fingerprint
new_hash
= Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
reason SDoc
doc Fingerprint
hash Fingerprint
new_hash
| AnyHpcUsage
otherwise
= RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
checkEntityUsage :: Logger
-> RecompReason
-> (OccName -> Maybe (OccName, Fingerprint))
-> (OccName, Fingerprint)
-> IO RecompileRequired
checkEntityUsage :: Logger
-> RecompReason
-> (OccName -> Maybe (OccName, Fingerprint))
-> (OccName, Fingerprint)
-> IO RecompileRequired
checkEntityUsage Logger
logger RecompReason
reason OccName -> Maybe (OccName, Fingerprint)
new_hash (OccName
name,Fingerprint
old_hash) = do
case OccName -> Maybe (OccName, Fingerprint)
new_hash OccName
name of
Maybe (OccName, Fingerprint)
Nothing -> Logger -> RecompReason -> SDoc -> IO RecompileRequired
out_of_date Logger
logger RecompReason
reason ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No longer exported:", OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name])
Just (OccName
_, Fingerprint
new_hash)
| Fingerprint
new_hash Fingerprint -> Fingerprint -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Fingerprint
old_hash
-> do Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Up to date" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
new_hash))
RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
| AnyHpcUsage
otherwise
-> Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
reason (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" Out of date:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name) Fingerprint
old_hash Fingerprint
new_hash
up_to_date :: Logger -> SDoc -> IO RecompileRequired
up_to_date :: Logger -> SDoc -> IO RecompileRequired
up_to_date Logger
logger SDoc
msg = Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger SDoc
msg IO () -> IO RecompileRequired -> IO RecompileRequired
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecompileRequired
UpToDate
out_of_date :: Logger -> RecompReason -> SDoc -> IO RecompileRequired
out_of_date :: Logger -> RecompReason -> SDoc -> IO RecompileRequired
out_of_date Logger
logger RecompReason
reason SDoc
msg = Logger -> SDoc -> IO ()
trace_hi_diffs Logger
logger SDoc
msg IO () -> IO RecompileRequired -> IO RecompileRequired
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RecompileRequired -> IO RecompileRequired
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecompReason -> RecompileRequired
needsRecompileBecause RecompReason
reason)
out_of_date_hash :: Logger -> RecompReason -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired
out_of_date_hash :: Logger
-> RecompReason
-> SDoc
-> Fingerprint
-> Fingerprint
-> IO RecompileRequired
out_of_date_hash Logger
logger RecompReason
reason SDoc
msg Fingerprint
old_hash Fingerprint
new_hash
= Logger -> RecompReason -> SDoc -> IO RecompileRequired
out_of_date Logger
logger RecompReason
reason ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [SDoc
msg, Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
old_hash, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->", Fingerprint -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fingerprint
new_hash])
addFingerprints
:: HscEnv
-> PartialModIface
-> IO ModIface
addFingerprints :: HscEnv -> PartialModIface -> IO ModIface
addFingerprints HscEnv
hsc_env PartialModIface
iface0
= do
ExternalPackageState
eps <- HscEnv -> IO ExternalPackageState
hscEPS HscEnv
hsc_env
let
decls :: [IfaceDeclExts 'ModIfaceCore]
decls = PartialModIface -> [IfaceDeclExts 'ModIfaceCore]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
iface0
warn_fn :: OccName -> Maybe (WarningTxt GhcRn)
warn_fn = Warnings GhcRn -> OccName -> Maybe (WarningTxt GhcRn)
forall p. Warnings p -> OccName -> Maybe (WarningTxt p)
mkIfaceWarnCache (PartialModIface -> Warnings GhcRn
forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns PartialModIface
iface0)
fix_fn :: OccName -> Maybe Fixity
fix_fn = [(OccName, Fixity)] -> OccName -> Maybe Fixity
mkIfaceFixCache (PartialModIface -> [(OccName, Fixity)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [(OccName, Fixity)]
mi_fixities PartialModIface
iface0)
declABI :: IfaceDecl -> IfaceDeclABI
declABI :: IfaceDecl -> IfaceDeclABI
declABI IfaceDecl
decl = (Module
this_mod, IfaceDecl
decl, IfaceDeclExtras
extras)
where extras :: IfaceDeclExtras
extras = (OccName -> Maybe Fixity)
-> (OccName -> [AnnPayload])
-> OccEnv [IfaceRule]
-> OccEnv [IfaceClsInst]
-> OccEnv [IfaceFamInst]
-> OccEnv Name
-> IfaceDecl
-> IfaceDeclExtras
declExtras OccName -> Maybe Fixity
fix_fn OccName -> [AnnPayload]
ann_fn OccEnv [IfaceRule]
non_orph_rules OccEnv [IfaceClsInst]
non_orph_insts
OccEnv [IfaceFamInst]
non_orph_fis OccEnv Name
top_lvl_name_env IfaceDecl
decl
top_lvl_name_env :: OccEnv Name
top_lvl_name_env =
[(OccName, Name)] -> OccEnv Name
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [ (Name -> OccName
nameOccName Name
nm, Name
nm)
| IfaceId { ifName :: IfaceDecl -> Name
ifName = Name
nm } <- [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls ]
edges :: [ Node Unique IfaceDeclABI ]
edges :: [Node Unique IfaceDeclABI]
edges = [ IfaceDeclABI -> Unique -> [Unique] -> Node Unique IfaceDeclABI
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode IfaceDeclABI
abi (OccName -> Unique
forall a. Uniquable a => a -> Unique
getUnique (IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl)) [Unique]
out
| IfaceDecl
decl <- [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls
, let abi :: IfaceDeclABI
abi = IfaceDecl -> IfaceDeclABI
declABI IfaceDecl
decl
, let out :: [Unique]
out = UniqSet Name -> [Unique]
localOccs (UniqSet Name -> [Unique]) -> UniqSet Name -> [Unique]
forall a b. (a -> b) -> a -> b
$ IfaceDeclABI -> UniqSet Name
freeNamesDeclABI IfaceDeclABI
abi
]
name_module :: Name -> Module
name_module Name
n = AnyHpcUsage -> SDoc -> Module -> Module
forall a. HasCallStack => AnyHpcUsage -> SDoc -> a -> a
assertPpr (Name -> AnyHpcUsage
isExternalName Name
n) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) ((() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
n)
localOccs :: UniqSet Name -> [Unique]
localOccs =
(Name -> Unique) -> [Name] -> [Unique]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> Unique
forall a. Uniquable a => a -> Unique
getUnique (OccName -> Unique) -> (Name -> OccName) -> Name -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> OccName
getParent (OccName -> OccName) -> (Name -> OccName) -> Name -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName)
([Name] -> [Unique])
-> (UniqSet Name -> [Name]) -> UniqSet Name -> [Unique]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> AnyHpcUsage) -> [Name] -> [Name]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter ((Module -> Module -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
== Module
semantic_mod) (Module -> AnyHpcUsage) -> (Name -> Module) -> Name -> AnyHpcUsage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Module
name_module)
([Name] -> [Name])
-> (UniqSet Name -> [Name]) -> UniqSet Name -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet
where getParent :: OccName -> OccName
getParent :: OccName -> OccName
getParent OccName
occ = OccEnv OccName -> OccName -> Maybe OccName
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv OccName
parent_map OccName
occ Maybe OccName -> OccName -> OccName
forall a. Maybe a -> a -> a
`orElse` OccName
occ
parent_map :: OccEnv OccName
parent_map :: OccEnv OccName
parent_map = (OccEnv OccName -> IfaceDecl -> OccEnv OccName)
-> OccEnv OccName -> [IfaceDecl] -> OccEnv OccName
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv OccName -> IfaceDecl -> OccEnv OccName
extend OccEnv OccName
forall a. OccEnv a
emptyOccEnv [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls
where extend :: OccEnv OccName -> IfaceDecl -> OccEnv OccName
extend OccEnv OccName
env IfaceDecl
d =
OccEnv OccName -> [(OccName, OccName)] -> OccEnv OccName
forall a. OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList OccEnv OccName
env [ (OccName
b,OccName
n) | OccName
b <- IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
d ]
where n :: OccName
n = IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
d
groups :: [SCC IfaceDeclABI]
groups :: [SCC IfaceDeclABI]
groups = [Node Unique IfaceDeclABI] -> [SCC IfaceDeclABI]
forall key payload.
Uniquable key =>
[Node key payload] -> [SCC payload]
stronglyConnCompFromEdgedVerticesUniq [Node Unique IfaceDeclABI]
edges
global_hash_fn :: Name -> IO Fingerprint
global_hash_fn = HscEnv -> ExternalPackageState -> Name -> IO Fingerprint
mkHashFun HscEnv
hsc_env ExternalPackageState
eps
mk_put_name :: OccEnv (OccName,Fingerprint)
-> BinHandle -> Name -> IO ()
mk_put_name :: OccEnv (OccName, Fingerprint) -> BinHandle -> Name -> IO ()
mk_put_name OccEnv (OccName, Fingerprint)
local_env BinHandle
bh Name
name
| Name -> AnyHpcUsage
isWiredInName Name
name = BinHandle -> Name -> IO ()
putNameLiterally BinHandle
bh Name
name
| AnyHpcUsage
otherwise
= AnyHpcUsage -> SDoc -> IO () -> IO ()
forall a. HasCallStack => AnyHpcUsage -> SDoc -> a -> a
assertPpr (Name -> AnyHpcUsage
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
let hash :: IO Fingerprint
hash | (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name Module -> Module -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Module
semantic_mod = Name -> IO Fingerprint
global_hash_fn Name
name
| Module
semantic_mod Module -> Module -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Module
this_mod
, AnyHpcUsage -> AnyHpcUsage
not (Module -> AnyHpcUsage
forall u. GenModule (GenUnit u) -> AnyHpcUsage
isHoleModule Module
semantic_mod) = Name -> IO Fingerprint
global_hash_fn Name
name
| AnyHpcUsage
otherwise = Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((OccName, Fingerprint) -> Fingerprint
forall a b. (a, b) -> b
snd (OccEnv (OccName, Fingerprint)
-> OccName -> Maybe (OccName, Fingerprint)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (OccName, Fingerprint)
local_env (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name)
Maybe (OccName, Fingerprint)
-> (OccName, Fingerprint) -> (OccName, Fingerprint)
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> (OccName, Fingerprint)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"urk! lookup local fingerprint"
(Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ OccEnv (OccName, Fingerprint) -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccEnv (OccName, Fingerprint)
local_env)))
in IO Fingerprint
hash IO Fingerprint -> (Fingerprint -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BinHandle -> Fingerprint -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh
fingerprint_group :: (OccEnv (OccName,Fingerprint),
[(Fingerprint,IfaceDecl)])
-> SCC IfaceDeclABI
-> IO (OccEnv (OccName,Fingerprint),
[(Fingerprint,IfaceDecl)])
fingerprint_group :: (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> SCC IfaceDeclABI
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
fingerprint_group (OccEnv (OccName, Fingerprint)
local_env, [(Fingerprint, IfaceDecl)]
decls_w_hashes) (AcyclicSCC IfaceDeclABI
abi)
= do let hash_fn :: BinHandle -> Name -> IO ()
hash_fn = OccEnv (OccName, Fingerprint) -> BinHandle -> Name -> IO ()
mk_put_name OccEnv (OccName, Fingerprint)
local_env
decl :: IfaceDecl
decl = IfaceDeclABI -> IfaceDecl
abiDecl IfaceDeclABI
abi
Fingerprint
hash <- (BinHandle -> Name -> IO ()) -> IfaceDeclABI -> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
hash_fn IfaceDeclABI
abi
OccEnv (OccName, Fingerprint)
env' <- OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint))
extend_hash_env OccEnv (OccName, Fingerprint)
local_env (Fingerprint
hash,IfaceDecl
decl)
(OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OccEnv (OccName, Fingerprint)
env', (Fingerprint
hash,IfaceDecl
decl) (Fingerprint, IfaceDecl)
-> [(Fingerprint, IfaceDecl)] -> [(Fingerprint, IfaceDecl)]
forall a. a -> [a] -> [a]
: [(Fingerprint, IfaceDecl)]
decls_w_hashes)
fingerprint_group (OccEnv (OccName, Fingerprint)
local_env, [(Fingerprint, IfaceDecl)]
decls_w_hashes) (CyclicSCC [IfaceDeclABI]
abis)
= do let stable_abis :: [IfaceDeclABI]
stable_abis = (IfaceDeclABI -> IfaceDeclABI -> Ordering)
-> [IfaceDeclABI] -> [IfaceDeclABI]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceDeclABI -> IfaceDeclABI -> Ordering
cmp_abiNames [IfaceDeclABI]
abis
stable_decls :: [IfaceDecl]
stable_decls = (IfaceDeclABI -> IfaceDecl) -> [IfaceDeclABI] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map IfaceDeclABI -> IfaceDecl
abiDecl [IfaceDeclABI]
stable_abis
OccEnv (OccName, Fingerprint)
local_env1 <- (OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint)))
-> OccEnv (OccName, Fingerprint)
-> [(Fingerprint, IfaceDecl)]
-> IO (OccEnv (OccName, Fingerprint))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint))
extend_hash_env OccEnv (OccName, Fingerprint)
local_env
([Fingerprint] -> [IfaceDecl] -> [(Fingerprint, IfaceDecl)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Word64 -> Fingerprint) -> [Word64] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Fingerprint
mkRecFingerprint [Word64
0..]) [IfaceDecl]
stable_decls)
let hash_fn :: BinHandle -> Name -> IO ()
hash_fn = OccEnv (OccName, Fingerprint) -> BinHandle -> Name -> IO ()
mk_put_name OccEnv (OccName, Fingerprint)
local_env1
Fingerprint
hash <- (BinHandle -> Name -> IO ()) -> [IfaceDeclABI] -> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
hash_fn [IfaceDeclABI]
stable_abis
let pairs :: [(Fingerprint, IfaceDecl)]
pairs = [Fingerprint] -> [IfaceDecl] -> [(Fingerprint, IfaceDecl)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Word64 -> Fingerprint) -> [Word64] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint -> Word64 -> Fingerprint
bumpFingerprint Fingerprint
hash) [Word64
0..]) [IfaceDecl]
stable_decls
OccEnv (OccName, Fingerprint)
local_env2 <- (OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint)))
-> OccEnv (OccName, Fingerprint)
-> [(Fingerprint, IfaceDecl)]
-> IO (OccEnv (OccName, Fingerprint))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint))
extend_hash_env OccEnv (OccName, Fingerprint)
local_env [(Fingerprint, IfaceDecl)]
pairs
(OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OccEnv (OccName, Fingerprint)
local_env2, [(Fingerprint, IfaceDecl)]
pairs [(Fingerprint, IfaceDecl)]
-> [(Fingerprint, IfaceDecl)] -> [(Fingerprint, IfaceDecl)]
forall a. [a] -> [a] -> [a]
++ [(Fingerprint, IfaceDecl)]
decls_w_hashes)
mkRecFingerprint :: Word64 -> Fingerprint
mkRecFingerprint :: Word64 -> Fingerprint
mkRecFingerprint Word64
i = Word64 -> Word64 -> Fingerprint
Fingerprint Word64
0 Word64
i
bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
bumpFingerprint Fingerprint
fp Word64
n = [Fingerprint] -> Fingerprint
fingerprintFingerprints [ Fingerprint
fp, Word64 -> Fingerprint
mkRecFingerprint Word64
n ]
extend_hash_env :: OccEnv (OccName,Fingerprint)
-> (Fingerprint,IfaceDecl)
-> IO (OccEnv (OccName,Fingerprint))
extend_hash_env :: OccEnv (OccName, Fingerprint)
-> (Fingerprint, IfaceDecl) -> IO (OccEnv (OccName, Fingerprint))
extend_hash_env OccEnv (OccName, Fingerprint)
env0 (Fingerprint
hash,IfaceDecl
d) =
OccEnv (OccName, Fingerprint) -> IO (OccEnv (OccName, Fingerprint))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (((OccName, Fingerprint)
-> OccEnv (OccName, Fingerprint) -> OccEnv (OccName, Fingerprint))
-> OccEnv (OccName, Fingerprint)
-> [(OccName, Fingerprint)]
-> OccEnv (OccName, Fingerprint)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(OccName
b,Fingerprint
fp) OccEnv (OccName, Fingerprint)
env -> OccEnv (OccName, Fingerprint)
-> OccName
-> (OccName, Fingerprint)
-> OccEnv (OccName, Fingerprint)
forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv (OccName, Fingerprint)
env OccName
b (OccName
b,Fingerprint
fp)) OccEnv (OccName, Fingerprint)
env0
(Fingerprint -> IfaceDecl -> [(OccName, Fingerprint)]
ifaceDeclFingerprints Fingerprint
hash IfaceDecl
d))
(OccEnv (OccName, Fingerprint)
local_env, [(Fingerprint, IfaceDecl)]
decls_w_hashes) <-
((OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> SCC IfaceDeclABI
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)]))
-> (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> [SCC IfaceDeclABI]
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
-> SCC IfaceDeclABI
-> IO (OccEnv (OccName, Fingerprint), [(Fingerprint, IfaceDecl)])
fingerprint_group (OccEnv (OccName, Fingerprint)
forall a. OccEnv a
emptyOccEnv, []) [SCC IfaceDeclABI]
groups
let sorted_deps :: Dependencies
sorted_deps :: Dependencies
sorted_deps = PartialModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps PartialModIface
iface0
let orph_mods :: [Module]
orph_mods
= (Module -> AnyHpcUsage) -> [Module] -> [Module]
forall a. (a -> AnyHpcUsage) -> [a] -> [a]
filter (Module -> Module -> AnyHpcUsage
forall a. Eq a => a -> a -> AnyHpcUsage
/= Module
this_mod)
([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ Dependencies -> [Module]
dep_orphs Dependencies
sorted_deps
[Fingerprint]
dep_orphan_hashes <- HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes HscEnv
hsc_env [Module]
orph_mods
Fingerprint
orphan_hash <- (BinHandle -> Name -> IO ())
-> ([Name], [IfaceRule], [IfaceFamInst]) -> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint (OccEnv (OccName, Fingerprint) -> BinHandle -> Name -> IO ()
mk_put_name OccEnv (OccName, Fingerprint)
local_env)
((IfaceClsInst -> Name) -> [IfaceClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> Name
ifDFun [IfaceClsInst]
orph_insts, [IfaceRule]
orph_rules, [IfaceFamInst]
orph_fis)
Fingerprint
dep_hash <- (BinHandle -> Name -> IO ())
-> ([ModuleName], Set (UnitId, ModuleNameWithIsBoot), Set UnitId,
[Module])
-> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
putNameLiterally
(Dependencies -> [ModuleName]
dep_sig_mods (PartialModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps PartialModIface
iface0),
Dependencies -> Set (UnitId, ModuleNameWithIsBoot)
dep_boot_mods (PartialModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps PartialModIface
iface0),
Dependencies -> Set UnitId
dep_trusted_pkgs (PartialModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps PartialModIface
iface0),
Dependencies -> [Module]
dep_finsts (PartialModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps PartialModIface
iface0) )
Fingerprint
export_hash <- (BinHandle -> Name -> IO ())
-> ([IfaceExport], Fingerprint, Fingerprint, [Fingerprint],
IfaceTrustInfo)
-> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
putNameLiterally
(PartialModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports PartialModIface
iface0,
Fingerprint
orphan_hash,
Fingerprint
dep_hash,
[Fingerprint]
dep_orphan_hashes,
PartialModIface -> IfaceTrustInfo
forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
mi_trust PartialModIface
iface0)
let sorted_decls :: [(Fingerprint, IfaceDecl)]
sorted_decls :: [(Fingerprint, IfaceDecl)]
sorted_decls = Map OccName (Fingerprint, IfaceDecl) -> [(Fingerprint, IfaceDecl)]
forall k a. Map k a -> [a]
Map.elems (Map OccName (Fingerprint, IfaceDecl)
-> [(Fingerprint, IfaceDecl)])
-> Map OccName (Fingerprint, IfaceDecl)
-> [(Fingerprint, IfaceDecl)]
forall a b. (a -> b) -> a -> b
$ [(OccName, (Fingerprint, IfaceDecl))]
-> Map OccName (Fingerprint, IfaceDecl)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(OccName, (Fingerprint, IfaceDecl))]
-> Map OccName (Fingerprint, IfaceDecl))
-> [(OccName, (Fingerprint, IfaceDecl))]
-> Map OccName (Fingerprint, IfaceDecl)
forall a b. (a -> b) -> a -> b
$
[(IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
d, (Fingerprint, IfaceDecl)
e) | e :: (Fingerprint, IfaceDecl)
e@(Fingerprint
_, IfaceDecl
d) <- [(Fingerprint, IfaceDecl)]
decls_w_hashes]
getOcc :: IfaceTopBndrInfo -> OccName
getOcc (IfGblTopBndr Name
b) = Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
b
getOcc (IfLclTopBndr FastString
fs IfaceType
_ IfaceIdInfo
_ IfaceIdDetails
_) = FastString -> OccName
mkVarOccFS FastString
fs
binding_key :: IfaceBindingX b IfaceTopBndrInfo -> IfaceBindingX () OccName
binding_key (IfaceNonRec IfaceTopBndrInfo
b b
_) = OccName -> () -> IfaceBindingX () OccName
forall r b. b -> r -> IfaceBindingX r b
IfaceNonRec (IfaceTopBndrInfo -> OccName
getOcc IfaceTopBndrInfo
b) ()
binding_key (IfaceRec [(IfaceTopBndrInfo, b)]
bs) = [(OccName, ())] -> IfaceBindingX () OccName
forall r b. [(b, r)] -> IfaceBindingX r b
IfaceRec (((IfaceTopBndrInfo, b) -> (OccName, ()))
-> [(IfaceTopBndrInfo, b)] -> [(OccName, ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(IfaceTopBndrInfo
b, b
_) -> (IfaceTopBndrInfo -> OccName
getOcc IfaceTopBndrInfo
b, ())) [(IfaceTopBndrInfo, b)]
bs)
sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
sorted_extra_decls = (IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
-> IfaceBindingX () OccName)
-> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
-> IfaceBindingX () OccName
forall {b}.
IfaceBindingX b IfaceTopBndrInfo -> IfaceBindingX () OccName
binding_key ([IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo])
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartialModIface
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall (phase :: ModIfacePhase).
ModIface_ phase
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls PartialModIface
iface0
Fingerprint
flag_hash <- HscEnv -> Module -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintDynFlags HscEnv
hsc_env Module
this_mod BinHandle -> Name -> IO ()
putNameLiterally
Fingerprint
opt_hash <- DynFlags -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintOptFlags DynFlags
dflags BinHandle -> Name -> IO ()
putNameLiterally
Fingerprint
hpc_hash <- DynFlags -> (BinHandle -> Name -> IO ()) -> IO Fingerprint
fingerprintHpcFlags DynFlags
dflags BinHandle -> Name -> IO ()
putNameLiterally
Fingerprint
plugin_hash <- Plugins -> IO Fingerprint
fingerprintPlugins (HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env)
Fingerprint
mod_hash <- (BinHandle -> Name -> IO ())
-> ([Fingerprint], Fingerprint, Warnings GhcRn) -> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
putNameLiterally
(((Fingerprint, IfaceDecl) -> Fingerprint)
-> [(Fingerprint, IfaceDecl)] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint, IfaceDecl) -> Fingerprint
forall a b. (a, b) -> a
fst [(Fingerprint, IfaceDecl)]
sorted_decls,
Fingerprint
export_hash,
PartialModIface -> Warnings GhcRn
forall (phase :: ModIfacePhase). ModIface_ phase -> Warnings GhcRn
mi_warns PartialModIface
iface0)
Fingerprint
iface_hash <- (BinHandle -> Name -> IO ())
-> (Fingerprint, Fingerprint, [AnnPayload], [Usage], Dependencies,
AnyHpcUsage)
-> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> Name -> IO ()) -> a -> IO Fingerprint
computeFingerprint BinHandle -> Name -> IO ()
putNameLiterally
(Fingerprint
mod_hash,
PartialModIface -> Fingerprint
forall (phase :: ModIfacePhase). ModIface_ phase -> Fingerprint
mi_src_hash PartialModIface
iface0,
OccName -> [AnnPayload]
ann_fn (FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"module")),
PartialModIface -> [Usage]
forall (phase :: ModIfacePhase). ModIface_ phase -> [Usage]
mi_usages PartialModIface
iface0,
Dependencies
sorted_deps,
PartialModIface -> AnyHpcUsage
forall (phase :: ModIfacePhase). ModIface_ phase -> AnyHpcUsage
mi_hpc PartialModIface
iface0)
let
final_iface_exts :: ModIfaceBackend
final_iface_exts = 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 :: AnyHpcUsage
mi_orphan = AnyHpcUsage -> AnyHpcUsage
not ( (IfaceRule -> AnyHpcUsage) -> [IfaceRule] -> AnyHpcUsage
forall (t :: * -> *) a.
Foldable t =>
(a -> AnyHpcUsage) -> t a -> AnyHpcUsage
all IfaceRule -> AnyHpcUsage
ifRuleAuto [IfaceRule]
orph_rules
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& [IfaceClsInst] -> AnyHpcUsage
forall a. [a] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [IfaceClsInst]
orph_insts
AnyHpcUsage -> AnyHpcUsage -> AnyHpcUsage
&& [IfaceFamInst] -> AnyHpcUsage
forall a. [a] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null [IfaceFamInst]
orph_fis)
, mi_finsts :: AnyHpcUsage
mi_finsts = AnyHpcUsage -> AnyHpcUsage
not ([IfaceFamInst] -> AnyHpcUsage
forall a. [a] -> AnyHpcUsage
forall (t :: * -> *) a. Foldable t => t a -> AnyHpcUsage
null (PartialModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts PartialModIface
iface0))
, mi_exp_hash :: Fingerprint
mi_exp_hash = Fingerprint
export_hash
, mi_orphan_hash :: Fingerprint
mi_orphan_hash = Fingerprint
orphan_hash
, mi_warn_fn :: OccName -> Maybe (WarningTxt GhcRn)
mi_warn_fn = OccName -> Maybe (WarningTxt GhcRn)
warn_fn
, mi_fix_fn :: OccName -> Maybe Fixity
mi_fix_fn = OccName -> Maybe Fixity
fix_fn
, mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn = OccEnv (OccName, Fingerprint)
-> OccName -> Maybe (OccName, Fingerprint)
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv (OccName, Fingerprint)
local_env
}
final_iface :: ModIface
final_iface = PartialModIface
iface0 { mi_decls = sorted_decls, mi_extra_decls = sorted_extra_decls, mi_final_exts = final_iface_exts }
ModIface -> IO ModIface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
final_iface
where
this_mod :: Module
this_mod = PartialModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module PartialModIface
iface0
semantic_mod :: Module
semantic_mod = PartialModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_semantic_module PartialModIface
iface0
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
(OccEnv [IfaceClsInst]
non_orph_insts, [IfaceClsInst]
orph_insts) = (IfaceClsInst -> IsOrphan)
-> [IfaceClsInst] -> (OccEnv [IfaceClsInst], [IfaceClsInst])
forall decl.
(decl -> IsOrphan) -> [decl] -> (OccEnv [decl], [decl])
mkOrphMap IfaceClsInst -> IsOrphan
ifInstOrph (PartialModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts PartialModIface
iface0)
(OccEnv [IfaceRule]
non_orph_rules, [IfaceRule]
orph_rules) = (IfaceRule -> IsOrphan)
-> [IfaceRule] -> (OccEnv [IfaceRule], [IfaceRule])
forall decl.
(decl -> IsOrphan) -> [decl] -> (OccEnv [decl], [decl])
mkOrphMap IfaceRule -> IsOrphan
ifRuleOrph (PartialModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules PartialModIface
iface0)
(OccEnv [IfaceFamInst]
non_orph_fis, [IfaceFamInst]
orph_fis) = (IfaceFamInst -> IsOrphan)
-> [IfaceFamInst] -> (OccEnv [IfaceFamInst], [IfaceFamInst])
forall decl.
(decl -> IsOrphan) -> [decl] -> (OccEnv [decl], [decl])
mkOrphMap IfaceFamInst -> IsOrphan
ifFamInstOrph (PartialModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts PartialModIface
iface0)
ann_fn :: OccName -> [AnnPayload]
ann_fn = [IfaceAnnotation] -> OccName -> [AnnPayload]
mkIfaceAnnCache (PartialModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns PartialModIface
iface0)
getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
getOrphanHashes HscEnv
hsc_env [Module]
mods = do
let
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
ctx :: SDocContext
ctx = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultUserStyle
get_orph_hash :: Module -> IO Fingerprint
get_orph_hash Module
mod = do
ModIface
iface <- HscEnv -> IfG ModIface -> IO ModIface
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
hsc_env (IfG ModIface -> IO ModIface)
-> (IfM () (MaybeErr SDoc ModIface) -> IfG ModIface)
-> IfM () (MaybeErr SDoc ModIface)
-> IO ModIface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> IfM () (MaybeErr SDoc ModIface) -> IfG ModIface
forall (m :: * -> *) a.
MonadIO m =>
SDocContext -> m (MaybeErr SDoc a) -> m a
withException SDocContext
ctx
(IfM () (MaybeErr SDoc ModIface) -> IO ModIface)
-> IfM () (MaybeErr SDoc ModIface) -> IO ModIface
forall a b. (a -> b) -> a -> b
$ SDoc -> Module -> WhereFrom -> IfM () (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"getOrphanHashes") Module
mod WhereFrom
ImportBySystem
Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModIfaceBackend -> Fingerprint
mi_orphan_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))
(Module -> IO Fingerprint) -> [Module] -> IO [Fingerprint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Module -> IO Fingerprint
get_orph_hash [Module]
mods
type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
data
= IfaceIdExtras
|
(Maybe Fixity)
[IfaceInstABI]
[AnnPayload]
[IfaceIdExtras]
|
(Maybe Fixity)
[IfaceInstABI]
[AnnPayload]
[IfaceIdExtras]
[IfExtName]
| (Maybe Fixity) [AnnPayload]
| (Maybe Fixity) [IfaceInstABI] [AnnPayload]
|
data
=
(Maybe Fixity)
[IfaceRule]
[AnnPayload]
type IfaceInstABI = IfExtName
abiDecl :: IfaceDeclABI -> IfaceDecl
abiDecl :: IfaceDeclABI -> IfaceDecl
abiDecl (Module
_, IfaceDecl
decl, IfaceDeclExtras
_) = IfaceDecl
decl
cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
cmp_abiNames IfaceDeclABI
abi1 IfaceDeclABI
abi2 = IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName (IfaceDeclABI -> IfaceDecl
abiDecl IfaceDeclABI
abi1) OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName (IfaceDeclABI -> IfaceDecl
abiDecl IfaceDeclABI
abi2)
freeNamesDeclABI :: IfaceDeclABI -> NameSet
freeNamesDeclABI :: IfaceDeclABI -> UniqSet Name
freeNamesDeclABI (Module
_mod, IfaceDecl
decl, IfaceDeclExtras
extras) =
IfaceDecl -> UniqSet Name
freeNamesIfDecl IfaceDecl
decl UniqSet Name -> UniqSet Name -> UniqSet Name
`unionNameSet` IfaceDeclExtras -> UniqSet Name
freeNamesDeclExtras IfaceDeclExtras
extras
freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
(IfaceIdExtras IfaceIdExtras
id_extras)
= IfaceIdExtras -> UniqSet Name
freeNamesIdExtras IfaceIdExtras
id_extras
freeNamesDeclExtras (IfaceDataExtras Maybe Fixity
_ [Name]
insts [AnnPayload]
_ [IfaceIdExtras]
subs)
= [UniqSet Name] -> UniqSet Name
unionNameSets ([Name] -> UniqSet Name
mkNameSet [Name]
insts UniqSet Name -> [UniqSet Name] -> [UniqSet Name]
forall a. a -> [a] -> [a]
: (IfaceIdExtras -> UniqSet Name)
-> [IfaceIdExtras] -> [UniqSet Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceIdExtras -> UniqSet Name
freeNamesIdExtras [IfaceIdExtras]
subs)
freeNamesDeclExtras (IfaceClassExtras Maybe Fixity
_ [Name]
insts [AnnPayload]
_ [IfaceIdExtras]
subs [Name]
defms)
= [UniqSet Name] -> UniqSet Name
unionNameSets ([UniqSet Name] -> UniqSet Name) -> [UniqSet Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$
[Name] -> UniqSet Name
mkNameSet [Name]
insts UniqSet Name -> [UniqSet Name] -> [UniqSet Name]
forall a. a -> [a] -> [a]
: [Name] -> UniqSet Name
mkNameSet [Name]
defms UniqSet Name -> [UniqSet Name] -> [UniqSet Name]
forall a. a -> [a] -> [a]
: (IfaceIdExtras -> UniqSet Name)
-> [IfaceIdExtras] -> [UniqSet Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceIdExtras -> UniqSet Name
freeNamesIdExtras [IfaceIdExtras]
subs
freeNamesDeclExtras (IfaceSynonymExtras Maybe Fixity
_ [AnnPayload]
_)
= UniqSet Name
emptyNameSet
freeNamesDeclExtras (IfaceFamilyExtras Maybe Fixity
_ [Name]
insts [AnnPayload]
_)
= [Name] -> UniqSet Name
mkNameSet [Name]
insts
freeNamesDeclExtras IfaceDeclExtras
IfaceOtherDeclExtras
= UniqSet Name
emptyNameSet
freeNamesIdExtras :: IfaceIdExtras -> NameSet
(IdExtras Maybe Fixity
_ [IfaceRule]
rules [AnnPayload]
_) = [UniqSet Name] -> UniqSet Name
unionNameSets ((IfaceRule -> UniqSet Name) -> [IfaceRule] -> [UniqSet Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceRule -> UniqSet Name
freeNamesIfRule [IfaceRule]
rules)
instance Outputable IfaceDeclExtras where
ppr :: IfaceDeclExtras -> SDoc
ppr IfaceDeclExtras
IfaceOtherDeclExtras = SDoc
forall doc. IsOutput doc => doc
Outputable.empty
ppr (IfaceIdExtras IfaceIdExtras
extras) = IfaceIdExtras -> SDoc
ppr_id_extras IfaceIdExtras
extras
ppr (IfaceSynonymExtras Maybe Fixity
fix [AnnPayload]
anns) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Maybe Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Fixity
fix, [AnnPayload] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AnnPayload]
anns]
ppr (IfaceFamilyExtras Maybe Fixity
fix [Name]
finsts [AnnPayload]
anns) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Maybe Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Fixity
fix, [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
finsts, [AnnPayload] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AnnPayload]
anns]
ppr (IfaceDataExtras Maybe Fixity
fix [Name]
insts [AnnPayload]
anns [IfaceIdExtras]
stuff) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Maybe Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Fixity
fix, [Name] -> SDoc
ppr_insts [Name]
insts, [AnnPayload] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AnnPayload]
anns,
[IfaceIdExtras] -> SDoc
ppr_id_extras_s [IfaceIdExtras]
stuff]
ppr (IfaceClassExtras Maybe Fixity
fix [Name]
insts [AnnPayload]
anns [IfaceIdExtras]
stuff [Name]
defms) =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Maybe Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Fixity
fix, [Name] -> SDoc
ppr_insts [Name]
insts, [AnnPayload] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AnnPayload]
anns,
[IfaceIdExtras] -> SDoc
ppr_id_extras_s [IfaceIdExtras]
stuff, [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
defms]
ppr_insts :: [IfaceInstABI] -> SDoc
ppr_insts :: [Name] -> SDoc
ppr_insts [Name]
_ = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<insts>"
ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
[IfaceIdExtras]
stuff = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceIdExtras -> SDoc) -> [IfaceIdExtras] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceIdExtras -> SDoc
ppr_id_extras [IfaceIdExtras]
stuff)
ppr_id_extras :: IfaceIdExtras -> SDoc
(IdExtras Maybe Fixity
fix [IfaceRule]
rules [AnnPayload]
anns) = Maybe Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe Fixity
fix SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((IfaceRule -> SDoc) -> [IfaceRule] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceRule -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceRule]
rules) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((AnnPayload -> SDoc) -> [AnnPayload] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map AnnPayload -> SDoc
forall a. Outputable a => a -> SDoc
ppr [AnnPayload]
anns)
instance Binary IfaceDeclExtras where
get :: BinHandle -> IO IfaceDeclExtras
get BinHandle
_bh = String -> IO IfaceDeclExtras
forall a. HasCallStack => String -> a
panic String
"no get for IfaceDeclExtras"
put_ :: BinHandle -> IfaceDeclExtras -> IO ()
put_ BinHandle
bh (IfaceIdExtras IfaceIdExtras
extras) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1; BinHandle -> IfaceIdExtras -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceIdExtras
extras
put_ BinHandle
bh (IfaceDataExtras Maybe Fixity
fix [Name]
insts [AnnPayload]
anns [IfaceIdExtras]
cons) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2; BinHandle -> Maybe Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Fixity
fix; BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
insts; BinHandle -> [AnnPayload] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [AnnPayload]
anns; BinHandle -> [IfaceIdExtras] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceIdExtras]
cons
put_ BinHandle
bh (IfaceClassExtras Maybe Fixity
fix [Name]
insts [AnnPayload]
anns [IfaceIdExtras]
methods [Name]
defms) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> Maybe Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Fixity
fix
BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
insts
BinHandle -> [AnnPayload] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [AnnPayload]
anns
BinHandle -> [IfaceIdExtras] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceIdExtras]
methods
BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
defms
put_ BinHandle
bh (IfaceSynonymExtras Maybe Fixity
fix [AnnPayload]
anns) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4; BinHandle -> Maybe Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Fixity
fix; BinHandle -> [AnnPayload] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [AnnPayload]
anns
put_ BinHandle
bh (IfaceFamilyExtras Maybe Fixity
fix [Name]
finsts [AnnPayload]
anns) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5; BinHandle -> Maybe Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Fixity
fix; BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
finsts; BinHandle -> [AnnPayload] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [AnnPayload]
anns
put_ BinHandle
bh IfaceDeclExtras
IfaceOtherDeclExtras = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
instance Binary IfaceIdExtras where
get :: BinHandle -> IO IfaceIdExtras
get BinHandle
_bh = String -> IO IfaceIdExtras
forall a. HasCallStack => String -> a
panic String
"no get for IfaceIdExtras"
put_ :: BinHandle -> IfaceIdExtras -> IO ()
put_ BinHandle
bh (IdExtras Maybe Fixity
fix [IfaceRule]
rules [AnnPayload]
anns)= do { BinHandle -> Maybe Fixity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Fixity
fix; BinHandle -> [IfaceRule] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceRule]
rules; BinHandle -> [AnnPayload] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [AnnPayload]
anns }
declExtras :: (OccName -> Maybe Fixity)
-> (OccName -> [AnnPayload])
-> OccEnv [IfaceRule]
-> OccEnv [IfaceClsInst]
-> OccEnv [IfaceFamInst]
-> OccEnv IfExtName
-> IfaceDecl
-> IfaceDeclExtras
OccName -> Maybe Fixity
fix_fn OccName -> [AnnPayload]
ann_fn OccEnv [IfaceRule]
rule_env OccEnv [IfaceClsInst]
inst_env OccEnv [IfaceFamInst]
fi_env OccEnv Name
dm_env IfaceDecl
decl
= case IfaceDecl
decl of
IfaceId{} -> IfaceIdExtras -> IfaceDeclExtras
IfaceIdExtras (OccName -> IfaceIdExtras
id_extras OccName
n)
IfaceData{ifCons :: IfaceDecl -> IfaceConDecls
ifCons=IfaceConDecls
cons} ->
Maybe Fixity
-> [Name] -> [AnnPayload] -> [IfaceIdExtras] -> IfaceDeclExtras
IfaceDataExtras (OccName -> Maybe Fixity
fix_fn OccName
n)
((IfaceFamInst -> Name) -> [IfaceFamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceFamInst -> Name
ifFamInstAxiom (OccEnv [IfaceFamInst] -> OccName -> [IfaceFamInst]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceFamInst]
fi_env OccName
n) [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
(IfaceClsInst -> Name) -> [IfaceClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> Name
ifDFun (OccEnv [IfaceClsInst] -> OccName -> [IfaceClsInst]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceClsInst]
inst_env OccName
n))
(OccName -> [AnnPayload]
ann_fn OccName
n)
((IfaceConDecl -> IfaceIdExtras)
-> [IfaceConDecl] -> [IfaceIdExtras]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> IfaceIdExtras
id_extras (OccName -> IfaceIdExtras)
-> (IfaceConDecl -> OccName) -> IfaceConDecl -> IfaceIdExtras
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall name. HasOccName name => name -> OccName
occName (Name -> OccName)
-> (IfaceConDecl -> Name) -> IfaceConDecl -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceConDecl -> Name
ifConName) (IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls IfaceConDecls
cons))
IfaceClass{ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass { ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs=[IfaceClassOp]
sigs, ifATs :: IfaceClassBody -> [IfaceAT]
ifATs=[IfaceAT]
ats }} ->
Maybe Fixity
-> [Name]
-> [AnnPayload]
-> [IfaceIdExtras]
-> [Name]
-> IfaceDeclExtras
IfaceClassExtras (OccName -> Maybe Fixity
fix_fn OccName
n) [Name]
insts (OccName -> [AnnPayload]
ann_fn OccName
n) [IfaceIdExtras]
meths [Name]
defms
where
insts :: [Name]
insts = ((IfaceClsInst -> Name) -> [IfaceClsInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClsInst -> Name
ifDFun ([IfaceClsInst] -> [Name]) -> [IfaceClsInst] -> [Name]
forall a b. (a -> b) -> a -> b
$ ((IfaceAT -> [IfaceClsInst]) -> [IfaceAT] -> [IfaceClsInst]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IfaceAT -> [IfaceClsInst]
at_extras [IfaceAT]
ats)
[IfaceClsInst] -> [IfaceClsInst] -> [IfaceClsInst]
forall a. [a] -> [a] -> [a]
++ OccEnv [IfaceClsInst] -> OccName -> [IfaceClsInst]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceClsInst]
inst_env OccName
n)
meths :: [IfaceIdExtras]
meths = [OccName -> IfaceIdExtras
id_extras (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
op) | IfaceClassOp Name
op IfaceType
_ Maybe (DefMethSpec IfaceType)
_ <- [IfaceClassOp]
sigs]
defms :: [Name]
defms = [ Name
dmName
| IfaceClassOp Name
bndr IfaceType
_ (Just DefMethSpec IfaceType
_) <- [IfaceClassOp]
sigs
, let dmOcc :: OccName
dmOcc = OccName -> OccName
mkDefaultMethodOcc (Name -> OccName
nameOccName Name
bndr)
, Just Name
dmName <- [OccEnv Name -> OccName -> Maybe Name
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv Name
dm_env OccName
dmOcc] ]
IfaceSynonym{} -> Maybe Fixity -> [AnnPayload] -> IfaceDeclExtras
IfaceSynonymExtras (OccName -> Maybe Fixity
fix_fn OccName
n)
(OccName -> [AnnPayload]
ann_fn OccName
n)
IfaceFamily{} -> Maybe Fixity -> [Name] -> [AnnPayload] -> IfaceDeclExtras
IfaceFamilyExtras (OccName -> Maybe Fixity
fix_fn OccName
n)
((IfaceFamInst -> Name) -> [IfaceFamInst] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceFamInst -> Name
ifFamInstAxiom (OccEnv [IfaceFamInst] -> OccName -> [IfaceFamInst]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceFamInst]
fi_env OccName
n))
(OccName -> [AnnPayload]
ann_fn OccName
n)
IfaceDecl
_other -> IfaceDeclExtras
IfaceOtherDeclExtras
where
n :: OccName
n = IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl
id_extras :: OccName -> IfaceIdExtras
id_extras OccName
occ = Maybe Fixity -> [IfaceRule] -> [AnnPayload] -> IfaceIdExtras
IdExtras (OccName -> Maybe Fixity
fix_fn OccName
occ) (OccEnv [IfaceRule] -> OccName -> [IfaceRule]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceRule]
rule_env OccName
occ) (OccName -> [AnnPayload]
ann_fn OccName
occ)
at_extras :: IfaceAT -> [IfaceClsInst]
at_extras (IfaceAT IfaceDecl
decl Maybe IfaceType
_) = OccEnv [IfaceClsInst] -> OccName -> [IfaceClsInst]
forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [IfaceClsInst]
inst_env (IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl)
lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
lookupOccEnvL :: forall v. OccEnv [v] -> OccName -> [v]
lookupOccEnvL OccEnv [v]
env OccName
k = OccEnv [v] -> OccName -> Maybe [v]
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv [v]
env OccName
k Maybe [v] -> [v] -> [v]
forall a. Maybe a -> a -> a
`orElse` []
mkOrphMap :: (decl -> IsOrphan)
-> [decl]
-> (OccEnv [decl],
[decl])
mkOrphMap :: forall decl.
(decl -> IsOrphan) -> [decl] -> (OccEnv [decl], [decl])
mkOrphMap decl -> IsOrphan
get_key [decl]
decls
= ((OccEnv [decl], [decl]) -> decl -> (OccEnv [decl], [decl]))
-> (OccEnv [decl], [decl]) -> [decl] -> (OccEnv [decl], [decl])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (OccEnv [decl], [decl]) -> decl -> (OccEnv [decl], [decl])
go (OccEnv [decl]
forall a. OccEnv a
emptyOccEnv, []) [decl]
decls
where
go :: (OccEnv [decl], [decl]) -> decl -> (OccEnv [decl], [decl])
go (OccEnv [decl]
non_orphs, [decl]
orphs) decl
d
| NotOrphan OccName
occ <- decl -> IsOrphan
get_key decl
d
= ((decl -> [decl] -> [decl])
-> (decl -> [decl])
-> OccEnv [decl]
-> OccName
-> decl
-> OccEnv [decl]
forall a b.
(a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b
extendOccEnv_Acc (:) decl -> [decl]
forall a. a -> [a]
Utils.singleton OccEnv [decl]
non_orphs OccName
occ decl
d, [decl]
orphs)
| AnyHpcUsage
otherwise = (OccEnv [decl]
non_orphs, decl
ddecl -> [decl] -> [decl]
forall a. a -> [a] -> [a]
:[decl]
orphs)
mkHashFun
:: HscEnv
-> ExternalPackageState
-> (Name -> IO Fingerprint)
mkHashFun :: HscEnv -> ExternalPackageState -> Name -> IO Fingerprint
mkHashFun HscEnv
hsc_env ExternalPackageState
eps Name
name
| Module -> AnyHpcUsage
forall u. GenModule (GenUnit u) -> AnyHpcUsage
isHoleModule Module
orig_mod
= Module -> IO Fingerprint
lookup (HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
orig_mod))
| AnyHpcUsage
otherwise
= Module -> IO Fingerprint
lookup Module
orig_mod
where
home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
hpt :: HomeUnitGraph
hpt = HscEnv -> HomeUnitGraph
hsc_HUG HscEnv
hsc_env
pit :: PackageIfaceTable
pit = ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps
ctx :: SDocContext
ctx = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultUserStyle
occ :: OccName
occ = Name -> OccName
nameOccName Name
name
orig_mod :: Module
orig_mod = (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
lookup :: Module -> IO Fingerprint
lookup Module
mod = do
AnyHpcUsage -> SDoc -> IO ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
AnyHpcUsage -> SDoc -> m ()
massertPpr (Name -> AnyHpcUsage
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
ModIface
iface <- case HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hpt PackageIfaceTable
pit Module
mod of
Just ModIface
iface -> ModIface -> IO ModIface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
iface
Maybe ModIface
Nothing ->
HscEnv -> IfG ModIface -> IO ModIface
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
hsc_env (IfG ModIface -> IO ModIface)
-> (IfM () (MaybeErr SDoc ModIface) -> IfG ModIface)
-> IfM () (MaybeErr SDoc ModIface)
-> IO ModIface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> IfM () (MaybeErr SDoc ModIface) -> IfG ModIface
forall (m :: * -> *) a.
MonadIO m =>
SDocContext -> m (MaybeErr SDoc a) -> m a
withException SDocContext
ctx
(IfM () (MaybeErr SDoc ModIface) -> IO ModIface)
-> IfM () (MaybeErr SDoc ModIface) -> IO ModIface
forall a b. (a -> b) -> a -> b
$ IfM () (MaybeErr SDoc ModIface) -> IfM () (MaybeErr SDoc ModIface)
forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
withoutDynamicNow
(IfM () (MaybeErr SDoc ModIface)
-> IfM () (MaybeErr SDoc ModIface))
-> IfM () (MaybeErr SDoc ModIface)
-> IfM () (MaybeErr SDoc ModIface)
forall a b. (a -> b) -> a -> b
$ SDoc -> Module -> WhereFrom -> IfM () (MaybeErr SDoc ModIface)
forall lcl.
SDoc -> Module -> WhereFrom -> IfM lcl (MaybeErr SDoc ModIface)
loadInterface (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookupVers2") Module
mod WhereFrom
ImportBySystem
Fingerprint -> IO Fingerprint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fingerprint -> IO Fingerprint) -> Fingerprint -> IO Fingerprint
forall a b. (a -> b) -> a -> b
$ (OccName, Fingerprint) -> Fingerprint
forall a b. (a, b) -> b
snd (ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface) OccName
occ Maybe (OccName, Fingerprint)
-> (OccName, Fingerprint) -> (OccName, Fingerprint)
forall a. Maybe a -> a -> a
`orElse`
String -> SDoc -> (OccName, Fingerprint)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupVers1" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ))
mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
mkIfaceAnnCache [IfaceAnnotation]
anns
= \OccName
n -> OccEnv [AnnPayload] -> OccName -> Maybe [AnnPayload]
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv [AnnPayload]
env OccName
n Maybe [AnnPayload] -> [AnnPayload] -> [AnnPayload]
forall a. Maybe a -> a -> a
`orElse` []
where
pair :: IfaceAnnotation -> (OccName, [AnnPayload])
pair (IfaceAnnotation IfaceAnnTarget
target AnnPayload
value) =
(case IfaceAnnTarget
target of
NamedTarget OccName
occn -> OccName
occn
ModuleTarget Module
_ -> FastString -> OccName
mkVarOccFS (String -> FastString
fsLit String
"module")
, [AnnPayload
value])
env :: OccEnv [AnnPayload]
env = ([AnnPayload] -> [AnnPayload] -> [AnnPayload])
-> [(OccName, [AnnPayload])] -> OccEnv [AnnPayload]
forall a. (a -> a -> a) -> [(OccName, a)] -> OccEnv a
mkOccEnv_C (([AnnPayload] -> [AnnPayload] -> [AnnPayload])
-> [AnnPayload] -> [AnnPayload] -> [AnnPayload]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [AnnPayload] -> [AnnPayload] -> [AnnPayload]
forall a. [a] -> [a] -> [a]
(++)) ((IfaceAnnotation -> (OccName, [AnnPayload]))
-> [IfaceAnnotation] -> [(OccName, [AnnPayload])]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAnnotation -> (OccName, [AnnPayload])
pair [IfaceAnnotation]
anns)