{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.HsToCore.Usage (
mkUsageInfo, mkUsedNames, mkDependencies
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Platform
import GHC.Platform.Ways
import GHC.Tc.Types
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Fingerprint
import GHC.Utils.Panic
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Unit
import GHC.Unit.External
import GHC.Unit.State
import GHC.Unit.Finder
import GHC.Unit.Module.Imported
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Deps
import GHC.Data.Maybe
import Control.Monad (filterM)
import Data.List (sort, sortBy, nub)
import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Directory
import System.FilePath
mkDependencies :: UnitId -> [Module] -> TcGblEnv -> IO Dependencies
mkDependencies :: UnitId -> [Module] -> TcGblEnv -> IO Dependencies
mkDependencies UnitId
iuid [Module]
pluginModules
(TcGblEnv{ tcg_mod :: TcGblEnv -> Module
tcg_mod = Module
mod,
tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails
imports,
tcg_th_used :: TcGblEnv -> TcRef Bool
tcg_th_used = TcRef Bool
th_var
})
= do
let ([ModuleName]
dep_plgins, [Module]
ms) = [(ModuleName, Module)] -> ([ModuleName], [Module])
forall a b. [(a, b)] -> ([a], [b])
unzip [ (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mn, Module
mn) | Module
mn <- [Module]
pluginModules ]
plugin_dep_pkgs :: [UnitId]
plugin_dep_pkgs = (UnitId -> Bool) -> [UnitId] -> [UnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
iuid) ((Module -> UnitId) -> [Module] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> UnitId
toUnitId (Unit -> UnitId) -> (Module -> Unit) -> Module -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit) [Module]
ms)
Bool
th_used <- TcRef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef TcRef Bool
th_var
let dep_mods :: [ModuleNameWithIsBoot]
dep_mods = ModuleNameEnv ModuleNameWithIsBoot -> [ModuleNameWithIsBoot]
modDepsElts (ModuleNameEnv ModuleNameWithIsBoot
-> ModuleName -> ModuleNameEnv ModuleNameWithIsBoot
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> UniqFM key elt
delFromUFM (ImportAvails -> ModuleNameEnv ModuleNameWithIsBoot
imp_dep_mods ImportAvails
imports)
(Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod))
dep_orphs :: [Module]
dep_orphs = (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
mod) (ImportAvails -> [Module]
imp_orphs ImportAvails
imports)
raw_pkgs :: Set UnitId
raw_pkgs = (UnitId -> Set UnitId -> Set UnitId)
-> Set UnitId -> [UnitId] -> Set UnitId
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => a -> Set a -> Set a
Set.insert (ImportAvails -> Set UnitId
imp_dep_pkgs ImportAvails
imports) [UnitId]
plugin_dep_pkgs
pkgs :: Set UnitId
pkgs | Bool
th_used = UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => a -> Set a -> Set a
Set.insert UnitId
thUnitId Set UnitId
raw_pkgs
| Bool
otherwise = Set UnitId
raw_pkgs
sorted_pkgs :: [UnitId]
sorted_pkgs = [UnitId] -> [UnitId]
forall a. Ord a => [a] -> [a]
sort (Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toList Set UnitId
pkgs)
trust_pkgs :: Set UnitId
trust_pkgs = ImportAvails -> Set UnitId
imp_trust_pkgs ImportAvails
imports
dep_pkgs' :: [(UnitId, Bool)]
dep_pkgs' = (UnitId -> (UnitId, Bool)) -> [UnitId] -> [(UnitId, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\UnitId
x -> (UnitId
x, UnitId
x UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set UnitId
trust_pkgs)) [UnitId]
sorted_pkgs
Dependencies -> IO Dependencies
forall (m :: * -> *) a. Monad m => a -> m a
return Deps { dep_mods :: [ModuleNameWithIsBoot]
dep_mods = [ModuleNameWithIsBoot]
dep_mods,
dep_pkgs :: [(UnitId, Bool)]
dep_pkgs = [(UnitId, Bool)]
dep_pkgs',
dep_orphs :: [Module]
dep_orphs = [Module]
dep_orphs,
dep_plgins :: [ModuleName]
dep_plgins = [ModuleName]
dep_plgins,
dep_finsts :: [Module]
dep_finsts = (Module -> Module -> Ordering) -> [Module] -> [Module]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Module -> Module -> Ordering
stableModuleCmp (ImportAvails -> [Module]
imp_finsts ImportAvails
imports) }
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus :: TcGblEnv -> DefUses
tcg_dus = DefUses
dus } = DefUses -> NameSet
allUses DefUses
dus
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
-> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]
mkUsageInfo :: HscEnv
-> Module
-> ImportedMods
-> NameSet
-> [FilePath]
-> [(Module, Fingerprint)]
-> [ModIface]
-> IO [Usage]
mkUsageInfo HscEnv
hsc_env Module
this_mod ImportedMods
dir_imp_mods NameSet
used_names [FilePath]
dependent_files [(Module, Fingerprint)]
merged
[ModIface]
pluginModules
= do
ExternalPackageState
eps <- HscEnv -> IO ExternalPackageState
hscEPS HscEnv
hsc_env
[Fingerprint]
hashes <- (FilePath -> IO Fingerprint) -> [FilePath] -> IO [Fingerprint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Fingerprint
getFileHash [FilePath]
dependent_files
[[Usage]]
plugin_usages <- (ModIface -> IO [Usage]) -> [ModIface] -> IO [[Usage]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HscEnv -> ModIface -> IO [Usage]
mkPluginUsage HscEnv
hsc_env) [ModIface]
pluginModules
let mod_usages :: [Usage]
mod_usages = PackageIfaceTable
-> HscEnv -> Module -> ImportedMods -> NameSet -> [Usage]
mk_mod_usage_info (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) HscEnv
hsc_env Module
this_mod
ImportedMods
dir_imp_mods NameSet
used_names
usages :: [Usage]
usages = [Usage]
mod_usages [Usage] -> [Usage] -> [Usage]
forall a. [a] -> [a] -> [a]
++ [ UsageFile { usg_file_path :: FilePath
usg_file_path = FilePath
f
, usg_file_hash :: Fingerprint
usg_file_hash = Fingerprint
hash }
| (FilePath
f, Fingerprint
hash) <- [FilePath] -> [Fingerprint] -> [(FilePath, Fingerprint)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
dependent_files [Fingerprint]
hashes ]
[Usage] -> [Usage] -> [Usage]
forall a. [a] -> [a] -> [a]
++ [ UsageMergedRequirement
{ usg_mod :: Module
usg_mod = Module
mod,
usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
hash
}
| (Module
mod, Fingerprint
hash) <- [(Module, Fingerprint)]
merged ]
[Usage] -> [Usage] -> [Usage]
forall a. [a] -> [a] -> [a]
++ [[Usage]] -> [Usage]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Usage]]
plugin_usages
[Usage]
usages [Usage] -> IO [Usage] -> IO [Usage]
forall a b. [a] -> b -> b
`seqList` [Usage] -> IO [Usage]
forall (m :: * -> *) a. Monad m => a -> m a
return [Usage]
usages
mkPluginUsage :: HscEnv -> ModIface -> IO [Usage]
mkPluginUsage :: HscEnv -> ModIface -> IO [Usage]
mkPluginUsage HscEnv
hsc_env ModIface
pluginModule
= case UnitState -> ModuleName -> Maybe FastString -> LookupResult
lookupPluginModuleWithSuggestions UnitState
pkgs ModuleName
pNm Maybe FastString
forall a. Maybe a
Nothing of
LookupFound Module
_ (UnitInfo
pkg, ModuleOrigin
_) -> do
let searchPaths :: [FilePath]
searchPaths = Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo
pkg]
useDyn :: Bool
useDyn = Way
WayDyn Way -> Ways -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> Ways
ways DynFlags
dflags
suffix :: FilePath
suffix = if Bool
useDyn then Platform -> FilePath
platformSOExt Platform
platform else FilePath
"a"
libLocs :: [FilePath]
libLocs = [ FilePath
searchPath FilePath -> FilePath -> FilePath
</> FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
libLoc FilePath -> FilePath -> FilePath
<.> FilePath
suffix
| FilePath
searchPath <- [FilePath]
searchPaths
, FilePath
libLoc <- GhcNameVersion -> Ways -> UnitInfo -> [FilePath]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags) (DynFlags -> Ways
ways DynFlags
dflags) UnitInfo
pkg
]
paths :: [FilePath]
paths =
if Bool
useDyn
then [FilePath]
libLocs
else
let dflags' :: DynFlags
dflags' = DynFlags
dflags { targetWays_ :: Ways
targetWays_ = Way -> Ways -> Ways
addWay Way
WayDyn (DynFlags -> Ways
targetWays_ DynFlags
dflags) }
dlibLocs :: [FilePath]
dlibLocs = [ FilePath
searchPath FilePath -> FilePath -> FilePath
</> Platform -> FilePath -> FilePath
platformHsSOName Platform
platform FilePath
dlibLoc
| FilePath
searchPath <- [FilePath]
searchPaths
, FilePath
dlibLoc <- GhcNameVersion -> Ways -> UnitInfo -> [FilePath]
unitHsLibs (DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags') (DynFlags -> Ways
ways DynFlags
dflags') UnitInfo
pkg
]
in [FilePath]
libLocs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dlibLocs
[FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
paths
case [FilePath]
files of
[] ->
FilePath -> SDoc -> IO [Usage]
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic
( FilePath
"mkPluginUsage: missing plugin library, tried:\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [FilePath]
paths
)
(ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pNm)
[FilePath]
_ -> (FilePath -> IO Usage) -> [FilePath] -> IO [Usage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Usage
hashFile ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub [FilePath]
files)
LookupResult
_ -> do
FindResult
foundM <- HscEnv -> ModuleName -> IO FindResult
findPluginModule HscEnv
hsc_env ModuleName
pNm
case FindResult
foundM of
Found ModLocation
ml Module
_ -> do
Usage
pluginObject <- FilePath -> IO Usage
hashFile (ModLocation -> FilePath
ml_obj_file ModLocation
ml)
[Usage]
depObjects <- [Maybe Usage] -> [Usage]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Usage] -> [Usage]) -> IO [Maybe Usage] -> IO [Usage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModuleName -> IO (Maybe Usage))
-> [ModuleName] -> IO [Maybe Usage]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ModuleName -> IO (Maybe Usage)
lookupObjectFile [ModuleName]
deps
[Usage] -> IO [Usage]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Usage] -> [Usage]
forall a. Eq a => [a] -> [a]
nub (Usage
pluginObject Usage -> [Usage] -> [Usage]
forall a. a -> [a] -> [a]
: [Usage]
depObjects))
FindResult
_ -> FilePath -> SDoc -> IO [Usage]
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"mkPluginUsage: no object file found" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pNm)
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
pkgs :: UnitState
pkgs = HscEnv -> UnitState
hsc_units HscEnv
hsc_env
pNm :: ModuleName
pNm = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
pluginModule
pPkg :: Unit
pPkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit) -> Module -> Unit
forall a b. (a -> b) -> a -> b
$ ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
pluginModule
deps :: [ModuleName]
deps = (ModuleNameWithIsBoot -> ModuleName)
-> [ModuleNameWithIsBoot] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map ModuleNameWithIsBoot -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod ([ModuleNameWithIsBoot] -> [ModuleName])
-> [ModuleNameWithIsBoot] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
Dependencies -> [ModuleNameWithIsBoot]
dep_mods (Dependencies -> [ModuleNameWithIsBoot])
-> Dependencies -> [ModuleNameWithIsBoot]
forall a b. (a -> b) -> a -> b
$ ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps ModIface
pluginModule
lookupObjectFile :: ModuleName -> IO (Maybe Usage)
lookupObjectFile ModuleName
nm = do
FindResult
foundM <- HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
nm Maybe FastString
forall a. Maybe a
Nothing
case FindResult
foundM of
Found ModLocation
ml Module
m
| Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
pPkg -> Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage) -> IO Usage -> IO (Maybe Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Usage
hashFile (ModLocation -> FilePath
ml_obj_file ModLocation
ml)
| Bool
otherwise -> Maybe Usage -> IO (Maybe Usage)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Usage
forall a. Maybe a
Nothing
FindResult
_ -> FilePath -> SDoc -> IO (Maybe Usage)
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"mkPluginUsage: no object for dependency"
(ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pNm SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
nm)
hashFile :: FilePath -> IO Usage
hashFile FilePath
f = do
Bool
fExist <- FilePath -> IO Bool
doesFileExist FilePath
f
if Bool
fExist
then do
Fingerprint
h <- FilePath -> IO Fingerprint
getFileHash FilePath
f
Usage -> IO Usage
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Fingerprint -> Usage
UsageFile FilePath
f Fingerprint
h)
else FilePath -> SDoc -> IO Usage
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"mkPluginUsage: file not found" (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pNm SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
f)
mk_mod_usage_info :: PackageIfaceTable
-> HscEnv
-> Module
-> ImportedMods
-> NameSet
-> [Usage]
mk_mod_usage_info :: PackageIfaceTable
-> HscEnv -> Module -> ImportedMods -> NameSet -> [Usage]
mk_mod_usage_info PackageIfaceTable
pit HscEnv
hsc_env Module
this_mod ImportedMods
direct_imports NameSet
used_names
= (Module -> Maybe Usage) -> [Module] -> [Usage]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Module -> Maybe Usage
mkUsage [Module]
usage_mods
where
hpt :: HomePackageTable
hpt = HscEnv -> HomePackageTable
hsc_HPT 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
used_mods :: [Module]
used_mods = ModuleEnv [OccName] -> [Module]
forall a. ModuleEnv a -> [Module]
moduleEnvKeys ModuleEnv [OccName]
ent_map
dir_imp_mods :: [Module]
dir_imp_mods = ImportedMods -> [Module]
forall a. ModuleEnv a -> [Module]
moduleEnvKeys ImportedMods
direct_imports
all_mods :: [Module]
all_mods = [Module]
used_mods [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter (Module -> [Module] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Module]
used_mods) [Module]
dir_imp_mods
usage_mods :: [Module]
usage_mods = (Module -> Module -> Ordering) -> [Module] -> [Module]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Module -> Module -> Ordering
stableModuleCmp [Module]
all_mods
ent_map :: ModuleEnv [OccName]
ent_map :: ModuleEnv [OccName]
ent_map = (Name -> ModuleEnv [OccName] -> ModuleEnv [OccName])
-> ModuleEnv [OccName] -> NameSet -> ModuleEnv [OccName]
forall elt a. (elt -> a -> a) -> a -> UniqSet elt -> a
nonDetStrictFoldUniqSet Name -> ModuleEnv [OccName] -> ModuleEnv [OccName]
add_mv ModuleEnv [OccName]
forall a. ModuleEnv a
emptyModuleEnv NameSet
used_names
where
add_mv :: Name -> ModuleEnv [OccName] -> ModuleEnv [OccName]
add_mv Name
name ModuleEnv [OccName]
mv_map
| Name -> Bool
isWiredInName Name
name = ModuleEnv [OccName]
mv_map
| Bool
otherwise
= case Name -> Maybe Module
nameModule_maybe Name
name of
Maybe Module
Nothing -> ASSERT2( isSystemName name, ppr name ) mv_map
Just Module
mod ->
let mod' :: Module
mod' = if Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
then HomeUnit -> ModuleName -> Module
mkHomeModule HomeUnit
home_unit (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
else Module
mod
in ([OccName] -> [OccName] -> [OccName])
-> ModuleEnv [OccName]
-> Module
-> [OccName]
-> ModuleEnv [OccName]
forall a.
(a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnvWith (\[OccName]
_ [OccName]
xs -> OccName
occOccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
:[OccName]
xs) ModuleEnv [OccName]
mv_map Module
mod' [OccName
occ]
where occ :: OccName
occ = Name -> OccName
nameOccName Name
name
mkUsage :: Module -> Maybe Usage
mkUsage :: Module -> Maybe Usage
mkUsage Module
mod
| Maybe ModIface -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModIface
maybe_iface
Bool -> Bool -> Bool
|| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
= Maybe Usage
forall a. Maybe a
Nothing
| Bool -> Bool
not (HomeUnit -> Module -> Bool
isHomeModule HomeUnit
home_unit Module
mod)
= Usage -> Maybe Usage
forall a. a -> Maybe a
Just UsagePackageModule{ usg_mod :: Module
usg_mod = Module
mod,
usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod_hash,
usg_safe :: Bool
usg_safe = Bool
imp_safe }
| ([OccName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OccName]
used_occs
Bool -> Bool -> Bool
&& Maybe Fingerprint -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Fingerprint
export_hash
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
is_direct_import
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
finsts_mod)
= Maybe Usage
forall a. Maybe a
Nothing
| Bool
otherwise
= Usage -> Maybe Usage
forall a. a -> Maybe a
Just UsageHomeModule {
usg_mod_name :: ModuleName
usg_mod_name = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod,
usg_mod_hash :: Fingerprint
usg_mod_hash = Fingerprint
mod_hash,
usg_exports :: Maybe Fingerprint
usg_exports = Maybe Fingerprint
export_hash,
usg_entities :: [(OccName, Fingerprint)]
usg_entities = Map OccName Fingerprint -> [(OccName, Fingerprint)]
forall k a. Map k a -> [(k, a)]
Map.toList Map OccName Fingerprint
ent_hashs,
usg_safe :: Bool
usg_safe = Bool
imp_safe }
where
maybe_iface :: Maybe ModIface
maybe_iface = HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt PackageIfaceTable
pit Module
mod
Just ModIface
iface = Maybe ModIface
maybe_iface
finsts_mod :: Bool
finsts_mod = ModIfaceBackend -> Bool
mi_finsts (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
hash_env :: OccName -> Maybe (OccName, Fingerprint)
hash_env = ModIfaceBackend -> OccName -> Maybe (OccName, Fingerprint)
mi_hash_fn (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
mod_hash :: Fingerprint
mod_hash = ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface)
export_hash :: Maybe Fingerprint
export_hash | Bool
depend_on_exports = Fingerprint -> Maybe Fingerprint
forall a. a -> Maybe a
Just (ModIfaceBackend -> Fingerprint
mi_exp_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))
| Bool
otherwise = Maybe Fingerprint
forall a. Maybe a
Nothing
by_is_safe :: ImportedBy -> Bool
by_is_safe (ImportedByUser ImportedModsVal
imv) = ImportedModsVal -> Bool
imv_is_safe ImportedModsVal
imv
by_is_safe ImportedBy
_ = Bool
False
(Bool
is_direct_import, Bool
imp_safe)
= case ImportedMods -> Module -> Maybe [ImportedBy]
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ImportedMods
direct_imports Module
mod of
Just [ImportedBy]
bys -> (Bool
True, (ImportedBy -> Bool) -> [ImportedBy] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ImportedBy -> Bool
by_is_safe [ImportedBy]
bys)
Maybe [ImportedBy]
Nothing -> (Bool
False, DynFlags -> Bool
safeImplicitImpsReq DynFlags
dflags)
used_occs :: [OccName]
used_occs = ModuleEnv [OccName] -> Module -> Maybe [OccName]
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv [OccName]
ent_map Module
mod Maybe [OccName] -> [OccName] -> [OccName]
forall a. Maybe a -> a -> a
`orElse` []
ent_hashs :: Map OccName Fingerprint
ent_hashs :: Map OccName Fingerprint
ent_hashs = [(OccName, Fingerprint)] -> Map OccName Fingerprint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((OccName -> (OccName, Fingerprint))
-> [OccName] -> [(OccName, Fingerprint)]
forall a b. (a -> b) -> [a] -> [b]
map OccName -> (OccName, Fingerprint)
lookup_occ [OccName]
used_occs)
lookup_occ :: OccName -> (OccName, Fingerprint)
lookup_occ OccName
occ =
case OccName -> Maybe (OccName, Fingerprint)
hash_env OccName
occ of
Maybe (OccName, Fingerprint)
Nothing -> FilePath -> SDoc -> (OccName, Fingerprint)
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"mkUsage" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ SDoc -> SDoc -> SDoc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
used_names)
Just (OccName, Fingerprint)
r -> (OccName, Fingerprint)
r
depend_on_exports :: Bool
depend_on_exports = Bool
is_direct_import