{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module GHC.HsToCore.Usage (
    -- * Dependency/fingerprinting code (used by GHC.Iface.Make)
    mkUsageInfo, mkUsedNames,

    UsageConfig(..),
    ) where

import GHC.Prelude

import GHC.Driver.Env

import GHC.Tc.Types

import GHC.Iface.Load

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Fingerprint
import GHC.Utils.Panic
import GHC.Utils.Monad

import GHC.Types.Name
import GHC.Types.Name.Set ( NameSet, allUses )
import GHC.Types.Unique.Set

import GHC.Unit
import GHC.Unit.Env
import GHC.Unit.External
import GHC.Unit.Module.Imported
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.Deps

import GHC.Data.Maybe
import GHC.Data.FastString

import Data.IORef
import Data.List (sortBy)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set

import GHC.Linker.Types
import GHC.Unit.Finder
import GHC.Types.Unique.DFM
import GHC.Driver.Plugins

{- Note [Module self-dependency]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

GHC.Rename.Names.calculateAvails asserts the invariant that a module must not occur in
its own dep_orphs or dep_finsts. However, if we aren't careful this can occur
in the presence of hs-boot files: Consider that we have two modules, A and B,
both with hs-boot files,

    A.hs contains a SOURCE import of B B.hs-boot contains a SOURCE import of A
    A.hs-boot declares an orphan instance A.hs defines the orphan instance

In this case, B's dep_orphs will contain A due to its SOURCE import of A.
Consequently, A will contain itself in its imp_orphs due to its import of B.
This fact would end up being recorded in A's interface file. This would then
break the invariant asserted by calculateAvails that a module does not itself in
its dep_orphs. This was the cause of #14128.

-}

mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus :: TcGblEnv -> DefUses
tcg_dus = DefUses
dus } = DefUses -> NameSet
allUses DefUses
dus

data UsageConfig = UsageConfig
  { UsageConfig -> Bool
uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode?
  }

mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
            -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IfG [Usage]
mkUsageInfo :: UsageConfig
-> Plugins
-> FinderCache
-> UnitEnv
-> Module
-> ImportedMods
-> NameSet
-> [FilePath]
-> [(Module, Fingerprint)]
-> [Linkable]
-> PkgsLoaded
-> IfG [Usage]
mkUsageInfo UsageConfig
uc Plugins
plugins FinderCache
fc UnitEnv
unit_env Module
this_mod ImportedMods
dir_imp_mods NameSet
used_names [FilePath]
dependent_files [(Module, Fingerprint)]
merged [Linkable]
needed_links PkgsLoaded
needed_pkgs
  = do
    eps <- IO ExternalPackageState
-> IOEnv (Env IfGblEnv ()) ExternalPackageState
forall a. IO a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExternalPackageState
 -> IOEnv (Env IfGblEnv ()) ExternalPackageState)
-> IO ExternalPackageState
-> IOEnv (Env IfGblEnv ()) ExternalPackageState
forall a b. (a -> b) -> a -> b
$ IORef ExternalPackageState -> IO ExternalPackageState
forall a. IORef a -> IO a
readIORef (ExternalUnitCache -> IORef ExternalPackageState
euc_eps (UnitEnv -> ExternalUnitCache
ue_eps UnitEnv
unit_env))
    hashes <- liftIO $ mapM getFileHash dependent_files
    let hu = UnitEnv -> HomeUnit
unsafeGetHomeUnit UnitEnv
unit_env
        hug = UnitEnv -> HomeUnitGraph
ue_home_unit_graph UnitEnv
unit_env
    -- Dependencies on object files due to TH and plugins
    object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs
    let all_home_ids = UnitEnv -> Set UnitId
ue_all_home_unit_ids UnitEnv
unit_env
    mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod
                                       dir_imp_mods used_names
    let usages = [Usage]
mod_usages [Usage] -> [Usage] -> [Usage]
forall a. [a] -> [a] -> [a]
++ [ UsageFile { usg_file_path :: FastString
usg_file_path = FilePath -> FastString
mkFastString FilePath
f
                                           , usg_file_hash :: Fingerprint
usg_file_hash = Fingerprint
hash
                                           , usg_file_label :: Maybe FilePath
usg_file_label = Maybe FilePath
forall a. Maybe a
Nothing }
                               | (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]
object_usages
    usages `seqList` return usages
    -- seq the list of Usages returned: occasionally these
    -- don't get evaluated for a while and we can end up hanging on to
    -- the entire collection of Ifaces.

{- Note [Plugin dependencies]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~

Modules for which plugins were used in the compilation process, should be
recompiled whenever one of those plugins changes. But how do we know if a
plugin changed from the previous time a module was compiled?

We could try storing the fingerprints of the interface files of plugins in
the interface file of the module. And see if there are changes between
compilation runs. However, this is pretty much a non-option because interface
fingerprints of plugin modules are fairly stable, unless you compile plugins
with optimisations turned on, and give basically all binders an INLINE pragma.

So instead:

  * For plugins that were built locally: we store the filepath and hash of the
    object files of the module with the `plugin` binder, and the object files of
    modules that are dependencies of the plugin module and belong to the same
    `UnitId` as the plugin
  * For plugins in an external package: we store the filepath and hash of
    the dynamic library containing the plugin module.

During recompilation we then compare the hashes of those files again to see
if anything has changed.

One issue with this approach is that object files are currently (GHC 8.6.1)
not created fully deterministically, which could sometimes induce accidental
recompilation of a module for which plugins were used in the compile process.

One way to improve this is to either:

  * Have deterministic object file creation
  * Create and store implementation hashes, which would be based on the Core
    of the module and the implementation hashes of its dependencies, and then
    compare implementation hashes for recompilation. Creation of implementation
    hashes is however potentially expensive.

    A serious issue with the interface hash idea is that if you include an
    interface hash, that hash also needs to depend on the hash of its
    dependencies. Therefore, if any of the transitive dependencies of a modules
    gets updated then you need to recompile the module in case the interface
    hash has changed irrespective if the module uses TH or not.

    This is important to maintain the invariant that the information in the
    interface file is always up-to-date.


    See #20790 (comment 3)
-}

{-
Note [Object File Dependencies]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In addition to the Note [Plugin dependencies] above, for TH we also need to record
the hashes of object files that the TH code is required to load. These are
calculated by the loader in `getLinkDeps` and are accumulated in each individual
`TcGblEnv`, in `tcg_th_needed_deps`. We read this just before compute the UsageInfo
to inject the appropriate dependencies.
-}

-- | Find object files corresponding to the transitive closure of given home
-- modules and direct object files for pkg dependencies
mkObjectUsage :: PackageIfaceTable -> Plugins -> FinderCache -> HomeUnitGraph-> [Linkable] -> PkgsLoaded -> IO [Usage]
mkObjectUsage :: PackageIfaceTable
-> Plugins
-> FinderCache
-> HomeUnitGraph
-> [Linkable]
-> PkgsLoaded
-> IO [Usage]
mkObjectUsage PackageIfaceTable
pit Plugins
plugins FinderCache
fc HomeUnitGraph
hug [Linkable]
th_links_needed PkgsLoaded
th_pkgs_needed = do
      let ls :: [Linkable]
ls = (Linkable -> Module) -> [Linkable] -> [Linkable]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubOn Linkable -> Module
linkableModule  ([Linkable]
th_links_needed [Linkable] -> [Linkable] -> [Linkable]
forall a. [a] -> [a] -> [a]
++ [Linkable]
plugins_links_needed)
          ds :: [LibrarySpec]
ds = (LoadedPkgInfo -> [LibrarySpec])
-> [LoadedPkgInfo] -> [LibrarySpec]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LoadedPkgInfo -> [LibrarySpec]
loaded_pkg_hs_objs ([LoadedPkgInfo] -> [LibrarySpec])
-> [LoadedPkgInfo] -> [LibrarySpec]
forall a b. (a -> b) -> a -> b
$ PkgsLoaded -> [LoadedPkgInfo]
forall {k} (key :: k) elt. UniqDFM key elt -> [elt]
eltsUDFM (PkgsLoaded -> PkgsLoaded -> PkgsLoaded
forall {k} (key :: k) elt.
UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
plusUDFM PkgsLoaded
th_pkgs_needed PkgsLoaded
plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well
          ([Linkable]
plugins_links_needed, PkgsLoaded
plugin_pkgs_needed) = Plugins -> ([Linkable], PkgsLoaded)
loadedPluginDeps Plugins
plugins
      [[Usage]] -> [Usage]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Usage]] -> [Usage]) -> IO [[Usage]] -> IO [Usage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO [Usage]] -> IO [[Usage]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((Linkable -> IO [Usage]) -> [Linkable] -> [IO [Usage]]
forall a b. (a -> b) -> [a] -> [b]
map Linkable -> IO [Usage]
linkableToUsage [Linkable]
ls [IO [Usage]] -> [IO [Usage]] -> [IO [Usage]]
forall a. [a] -> [a] -> [a]
++ (LibrarySpec -> IO [Usage]) -> [LibrarySpec] -> [IO [Usage]]
forall a b. (a -> b) -> [a] -> [b]
map LibrarySpec -> IO [Usage]
librarySpecToUsage [LibrarySpec]
ds)
  where
    linkableToUsage :: Linkable -> IO [Usage]
linkableToUsage (LM UTCTime
_ Module
m [Unlinked]
uls) = (Unlinked -> IO Usage) -> [Unlinked] -> IO [Usage]
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 -> Unlinked -> IO Usage
unlinkedToUsage Module
m) [Unlinked]
uls

    msg :: GenModule unit -> FilePath
msg GenModule unit
m = ModuleName -> FilePath
moduleNameString (GenModule unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule unit
m) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"[TH] changed"

    fing :: Maybe FilePath -> FilePath -> IO Usage
fing Maybe FilePath
mmsg FilePath
fn = FastString -> Fingerprint -> Maybe FilePath -> Usage
UsageFile (FilePath -> FastString
mkFastString FilePath
fn) (Fingerprint -> Maybe FilePath -> Usage)
-> IO Fingerprint -> IO (Maybe FilePath -> Usage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinderCache -> FilePath -> IO Fingerprint
lookupFileCache FinderCache
fc FilePath
fn IO (Maybe FilePath -> Usage) -> IO (Maybe FilePath) -> IO Usage
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
mmsg

    unlinkedToUsage :: Module -> Unlinked -> IO Usage
unlinkedToUsage Module
m Unlinked
ul =
      case Unlinked -> Maybe FilePath
nameOfObject_maybe Unlinked
ul of
        Just FilePath
fn -> Maybe FilePath -> FilePath -> IO Usage
fing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Module -> FilePath
forall {unit}. GenModule unit -> FilePath
msg Module
m)) FilePath
fn
        Maybe FilePath
Nothing ->  do
          -- This should only happen for home package things but oneshot puts
          -- home package ifaces in the PIT.
          let miface :: Maybe ModIface
miface = HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hug PackageIfaceTable
pit Module
m
          case Maybe ModIface
miface of
            Maybe ModIface
Nothing -> FilePath -> SDoc -> IO Usage
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"mkObjectUsage" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m)
            Just ModIface
iface ->
              Usage -> IO Usage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Usage -> IO Usage) -> Usage -> IO Usage
forall a b. (a -> b) -> a -> b
$ ModuleName -> UnitId -> Fingerprint -> Usage
UsageHomeModuleInterface (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m) (Unit -> UnitId
toUnitId (Unit -> UnitId) -> Unit -> UnitId
forall a b. (a -> b) -> a -> b
$ Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m) (ModIfaceBackend -> Fingerprint
mi_iface_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts ModIface
iface))

    librarySpecToUsage :: LibrarySpec -> IO [Usage]
    librarySpecToUsage :: LibrarySpec -> IO [Usage]
librarySpecToUsage (Objects [FilePath]
os) = (FilePath -> IO Usage) -> [FilePath] -> IO [Usage]
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 (Maybe FilePath -> FilePath -> IO Usage
fing Maybe FilePath
forall a. Maybe a
Nothing) [FilePath]
os
    librarySpecToUsage (Archive FilePath
fn) = (FilePath -> IO Usage) -> [FilePath] -> IO [Usage]
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 (Maybe FilePath -> FilePath -> IO Usage
fing Maybe FilePath
forall a. Maybe a
Nothing) [FilePath
fn]
    librarySpecToUsage (DLLPath FilePath
fn) = (FilePath -> IO Usage) -> [FilePath] -> IO [Usage]
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 (Maybe FilePath -> FilePath -> IO Usage
fing Maybe FilePath
forall a. Maybe a
Nothing) [FilePath
fn]
    librarySpecToUsage LibrarySpec
_ = [Usage] -> IO [Usage]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

mk_mod_usage_info :: UsageConfig
              -> HomeUnit
              -> Set.Set UnitId
              -> Module
              -> ImportedMods
              -> NameSet
              -> IfG [Usage]
mk_mod_usage_info :: UsageConfig
-> HomeUnit
-> Set UnitId
-> Module
-> ImportedMods
-> NameSet
-> IfG [Usage]
mk_mod_usage_info UsageConfig
uc HomeUnit
home_unit Set UnitId
home_unit_ids Module
this_mod ImportedMods
direct_imports NameSet
used_names
  = (Module -> IOEnv (Env IfGblEnv ()) (Maybe Usage))
-> [Module] -> IfG [Usage]
forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Module -> IOEnv (Env IfGblEnv ()) (Maybe Usage)
mkUsageM [Module]
usage_mods
  where
    safe_implicit_imps_req :: Bool
safe_implicit_imps_req = UsageConfig -> Bool
uc_safe_implicit_imps_req UsageConfig
uc

    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
                        -- canonical order is imported, to avoid interface-file
                        -- wobblage.

    -- ent_map groups together all the things imported and used
    -- from a particular module
    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
     -- nonDetStrictFoldUniqSet is OK here. If you follow the logic, we sort by
     -- OccName in ent_hashs
     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  -- ignore wired-in names
        | Bool
otherwise
        = case Name -> Maybe Module
nameModule_maybe Name
name of
             Maybe Module
Nothing  -> Bool -> SDoc -> ModuleEnv [OccName] -> ModuleEnv [OccName]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isSystemName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) ModuleEnv [OccName]
mv_map
                -- See Note [Internal used_names]

             Just Module
mod ->
                -- See Note [Identity versus semantic module]
                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
                -- This lambda function is really just a
                -- specialised (++); originally came about to
                -- avoid quadratic behaviour (#2680)
                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

    mkUsageM :: Module -> IfG (Maybe Usage)
    mkUsageM :: Module -> IOEnv (Env IfGblEnv ()) (Maybe Usage)
mkUsageM Module
mod | Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod -- We don't care about usages of things in *this* module
                 Bool -> Bool -> Bool
|| Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
interactiveUnit -- ... or in GHCi
                 = Maybe Usage -> IOEnv (Env IfGblEnv ()) (Maybe Usage)
forall a. a -> IOEnv (Env IfGblEnv ()) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Usage
forall a. Maybe a
Nothing
    mkUsageM Module
mod = do
      iface <- SDoc -> Module -> IfM () ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"mk_mod_usage") Module
mod
        -- Make sure the interface is loaded even if we don't directly use
        -- any symbols from it, to ensure determinism. See #22217.
      return $ mkUsage mod iface


    -- We want to create a Usage for a home module if
    --  a) we used something from it; has something in used_names
    --  b) we imported it, even if we used nothing from it
    --     (need to recompile if its export list changes: export_fprint)
    mkUsage :: Module -> ModIface -> Maybe Usage
    mkUsage :: Module -> ModIface -> Maybe Usage
mkUsage Module
mod ModIface
iface
      | Unit -> UnitId
toUnitId (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod) UnitId -> Set UnitId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set UnitId
home_unit_ids
      = Usage -> Maybe Usage
forall a. a -> Maybe a
Just (Usage -> Maybe Usage) -> Usage -> Maybe Usage
forall a b. (a -> b) -> a -> b
$ 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 }
        -- for package modules, we record the module hash only

      | ([OccName] -> Bool
forall a. [a] -> 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                 -- Record no usage info
        -- for directly-imported modules, we always want to record a usage
        -- on the orphan hash.  This is what triggers a recompilation if
        -- an orphan is added or removed somewhere below us in the future.

      | 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_unit_id :: UnitId
usg_unit_id  = Unit -> UnitId
toUnitId (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit 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
        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
                -- ezyang: I'm not sure if any is the correct
                -- metric here. If safety was guaranteed to be uniform
                -- across all imports, why did the old code only look
                -- at the first import?
                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, Bool
safe_implicit_imps_req)
                -- Nothing case is for references to entities which were
                -- not directly imported (NB: the "implicit" Prelude import
                -- counts as directly imported!  An entity is not directly
                -- imported if, e.g., we got a reference to it from a
                -- reexport of another module.)

        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` []

        -- Making a Map here ensures that (a) we remove duplicates
        -- when we have usages on several subordinates of a single parent,
        -- and (b) that the usages emerge in a canonical order, which
        -- is why we use Map rather than OccEnv: Map works
        -- using Ord on the OccNames, which is a lexicographic ordering.
        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
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> 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
        {- True
              Even if we used 'import M ()', we have to register a
              usage on the export list because we are sensitive to
              changes in orphan instances/rules.
           False
              In GHC 6.8.x we always returned true, and in
              fact it recorded a dependency on *all* the
              modules underneath in the dependency tree.  This
              happens to make orphans work right, but is too
              expensive: it'll read too many interface files.
              The 'isNothing maybe_iface' check above saved us
              from generating many of these usages (at least in
              one-shot mode), but that's even more bogus!
        -}

{-
Note [Internal used_names]
~~~~~~~~~~~~~~~~~~~~~~~~~~
Most of the used_names are External Names, but we can have System
Names too. Two examples:

* Names arising from Language.Haskell.TH.newName.
  See Note [Binders in Template Haskell] in GHC.ThToHs (and #5362).
* The names of auxiliary bindings in derived instances.
  See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.

Such Names are always for locally-defined things, for which we don't gather
usage info, so we can just ignore them in ent_map. Moreover, they are always
System Names, hence the assert, just as a double check.
-}