{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

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

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

#include "HsVersions.h"

import GHC.Prelude

import GHC.Driver.Session
import GHC.Driver.Ways
import GHC.Driver.Types
import GHC.Tc.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Unit
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Utils.Fingerprint
import GHC.Data.Maybe
import GHC.Driver.Finder

import Control.Monad (filterM)
import Data.List
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

{- 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.

-}

-- | Extract information from the rename and typecheck phases to produce
-- a dependencies information for the module being compiled.
--
-- The first argument is additional dependencies from plugins
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
      -- Template Haskell used?
      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))
                -- M.hi-boot can be in the imp_dep_mods, but we must remove
                -- it before recording the modules on which this one depends!
                -- (We want to retain M.hi-boot in imp_dep_mods so that
                --  loadHiBootInterface can see if M's direct imports depend
                --  on M.hi-boot, and hence that we should do the hi-boot consistency
                --  check.)

          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)
                -- We must also remove self-references from imp_orphs. See
                -- Note [Module self-dependency]

          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

          -- Set the packages required to be Safe according to Safe Haskell.
          -- See Note [Tracking Trust Transitively] in GHC.Rename.Names
          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 :: [ModuleNameWithIsBoot]
-> [(UnitId, Bool)]
-> [Module]
-> [Module]
-> [ModuleName]
-> Dependencies
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) }
                    -- sort to get into canonical order
                    -- NB. remember to use lexicographic ordering

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 :: FilePath -> Fingerprint -> Usage
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 :: Module -> Fingerprint -> Usage
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
    -- 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.
-}
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
    -- The plugin is from an external package:
    -- search for the library files containing the plugin.
      let searchPaths :: [FilePath]
searchPaths = DynFlags -> [UnitInfo] -> [FilePath]
collectLibraryPaths DynFlags
dflags [UnitInfo
pkg]
          useDyn :: Bool
useDyn = Way
WayDyn Way -> Set Way -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> Set Way
ways DynFlags
dflags
          suffix :: FilePath
suffix = if Bool
useDyn then Platform -> FilePath
soExt 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     <- DynFlags -> UnitInfo -> [FilePath]
packageHsLibs DynFlags
dflags UnitInfo
pkg
                    ]
          -- we also try to find plugin library files by adding WayDyn way,
          -- if it isn't already present (see trac #15492)
          paths :: [FilePath]
paths =
            if Bool
useDyn
              then [FilePath]
libLocs
              else
                let dflags' :: DynFlags
dflags'  = Way -> DynFlags -> DynFlags
addWay' Way
WayDyn DynFlags
dflags
                    dlibLocs :: [FilePath]
dlibLocs = [ FilePath
searchPath FilePath -> FilePath -> FilePath
</> Platform -> FilePath -> FilePath
mkHsSOName Platform
platform FilePath
dlibLoc
                               | FilePath
searchPath <- [FilePath]
searchPaths
                               , FilePath
dlibLoc    <- DynFlags -> UnitInfo -> [FilePath]
packageHsLibs 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
      -- The plugin was built locally: look up the object file containing
      -- the `plugin` binder, and all object files belong to modules that are
      -- transitive dependencies of the plugin that belong to the same package.
        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     = DynFlags -> UnitState
unitState DynFlags
dflags
    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

    -- Lookup object file for a plugin dependency,
    -- from the same package as the plugin.
    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
    this_pkg :: Unit
this_pkg = DynFlags -> Unit
homeUnit DynFlags
dflags

    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  -> ASSERT2( isSystemName name, ppr name ) 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 Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule Unit
this_pkg (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 (trac #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

    -- 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 -> Maybe Usage
    mkUsage :: Module -> Maybe Usage
mkUsage Module
mod
      | Maybe ModIface -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModIface
maybe_iface           -- We can't depend on it if we didn't
                                        -- load its interface.
      Bool -> Bool -> Bool
|| 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
      = Maybe Usage
forall a. Maybe a
Nothing

      | Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
/= Unit
this_pkg
      = Usage -> Maybe Usage
forall a. a -> Maybe a
Just UsagePackageModule :: Module -> Fingerprint -> Bool -> Usage
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 (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 :: ModuleName
-> Fingerprint
-> [(OccName, Fingerprint)]
-> Maybe Fingerprint
-> Bool
-> Usage
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
                -- In one-shot mode, the interfaces for home-package
                -- modules accumulate in the PIT not HPT.  Sigh.

        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
                -- 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, DynFlags -> Bool
safeImplicitImpsReq DynFlags
dflags)
                -- 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
<+> 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
        {- 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.
-}