Commit 52065e95 authored by Christiaan Baaij's avatar Christiaan Baaij Committed by Ben Gamari

Plugin dependency information is stored separately

We need to store the used plugins so that we recompile
a module when a plugin that it uses is recompiled.

However, storing the `ModuleName`s of the plugins used by a
module in the `dep_mods` field made the rest of GHC think
that they belong in the HPT, causing at least the issues
reported in #15234

We therefor store the `ModuleName`s of the plugins in a
new field, `dep_plgins`, which is only used the the
recompilation logic.

Reviewers: mpickering, bgamari

Reviewed By: mpickering, bgamari

Subscribers: alpmestan, rwbarton, thomie, carter

GHC Trac Issues: #15234

Differential Revision: https://phabricator.haskell.org/D4937
parent f8618a9b
......@@ -170,12 +170,13 @@ deSugar hsc_env
pluginModules =
map lpModule (plugins (hsc_dflags hsc_env))
; deps <- mkDependencies (thisInstalledUnitId (hsc_dflags hsc_env))
pluginModules tcg_env
(map mi_module pluginModules) tcg_env
; used_th <- readIORef tc_splice_used
; dep_files <- readIORef dependent_files
; safe_mode <- finalSafeMode dflags tcg_env
; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names dep_files merged
; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names
dep_files merged pluginModules
-- id_mod /= mod when we are processing an hsig, but hsigs
-- never desugared and compiled (there's no code!)
-- Consequently, this should hold for any ModGuts that make
......
......@@ -22,12 +22,16 @@ import UniqSet
import UniqFM
import Fingerprint
import Maybes
import Packages
import Finder
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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -60,13 +64,11 @@ mkDependencies iuid pluginModules
})
= do
-- Template Haskell used?
let (mns, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
plugin_dep_mods = map (,False) mns
let (dep_plgins, ms) = unzip [ (moduleName mn, mn) | mn <- pluginModules ]
plugin_dep_pkgs = filter (/= iuid) (map (toInstalledUnitId . moduleUnitId) ms)
th_used <- readIORef th_var
let dep_mods = modDepsElts (delFromUFM (imp_dep_mods imports)
(moduleName mod))
++ plugin_dep_mods
-- 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
......@@ -92,6 +94,7 @@ mkDependencies iuid pluginModules
return Deps { dep_mods = dep_mods,
dep_pkgs = dep_pkgs',
dep_orphs = dep_orphs,
dep_plgins = dep_plgins,
dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-- sort to get into canonical order
-- NB. remember to use lexicographic ordering
......@@ -99,11 +102,14 @@ mkDependencies iuid pluginModules
mkUsedNames :: TcGblEnv -> NameSet
mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> IO [Usage]
mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath]
-> [(Module, Fingerprint)] -> [ModIface] -> IO [Usage]
mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
pluginModules
= do
eps <- hscEPS hsc_env
hashes <- mapM getFileHash dependent_files
plugin_usages <- mapM (mkPluginUsage hsc_env) pluginModules
let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod
dir_imp_mods used_names
usages = mod_usages ++ [ UsageFile { usg_file_path = f
......@@ -114,11 +120,100 @@ mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged
usg_mod_hash = hash
}
| (mod, hash) <- merged ]
++ concat plugin_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 build 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 deterministicly, 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 hsc_env pluginModule
= case lookupPluginModuleWithSuggestions dflags pNm Nothing of
-- The plug is from an external package, we just look up the dylib that
-- contains the plugin
LookupFound _ pkg ->
let searchPaths = collectLibraryPaths dflags [pkg]
libs = packageHsLibs dflags pkg
dynlibs = [ searchPath </> mkHsSOName platform lib
| searchPath <- searchPaths
, lib <- libs
]
in mapM hashFile (nub dynlibs)
_ -> do
foundM <- findPluginModule hsc_env pNm
case 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 ml _ -> do
pluginObject <- hashFile (ml_obj_file ml)
depObjects <- catMaybes <$> mapM lookupObjectFile deps
return (nub (pluginObject : depObjects))
_ -> pprPanic "mkPluginUsage: no object or dylib" (ppr pNm)
where
-- plugins are shared libraries, so add WayDyn to the dflags in order to get
-- the correct filenames and library paths; just in case the object that is
-- currently being build is not going to be linked dynamically
dflags = addWay' WayDyn (hsc_dflags hsc_env)
platform = targetPlatform dflags
pNm = moduleName (mi_module pluginModule)
pPkg = moduleUnitId (mi_module pluginModule)
deps = map fst (dep_mods (mi_deps pluginModule))
-- loopup object file for a plugin dependencies from the same package as the
-- the plugin
lookupObjectFile nm = do
foundM <- findImportedModule hsc_env nm Nothing
case foundM of
Found ml m
| moduleUnitId m == pPkg -> Just <$> hashFile (ml_obj_file ml)
| otherwise -> return Nothing
_ -> pprPanic "mkPluginUsage: no object for dependency"
(ppr pNm <+> ppr nm)
hashFile f = do
fExist <- doesFileExist f
if fExist
then do
h <- getFileHash f
return (UsageFile f h)
else pprPanic "mkPluginUsage: file not found" (ppr pNm <+> text f)
mk_mod_usage_info :: PackageIfaceTable
-> HscEnv
-> Module
......
......@@ -192,7 +192,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
map lpModule (plugins (hsc_dflags hsc_env))
deps <- mkDependencies
(thisInstalledUnitId (hsc_dflags hsc_env))
pluginModules tc_result
(map mi_module pluginModules) tc_result
let hpc_info = emptyHpcInfo other_hpc_info
used_th <- readIORef tc_splice_used
dep_files <- (readIORef dependent_files)
......@@ -203,7 +203,8 @@ mkIfaceTc hsc_env maybe_old_fingerprint safe_mode mod_details
-- but if you pass that in here, we'll decide it's the local
-- module and does not need to be recorded as a dependency.
-- See Note [Identity versus semantic module]
usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names dep_files merged
usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names
dep_files merged pluginModules
let (doc_hdr', doc_map, arg_map) = extractDocs tc_result
......@@ -791,7 +792,8 @@ sortDependencies d
= Deps { dep_mods = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
dep_pkgs = sortBy (compare `on` fst) (dep_pkgs d),
dep_orphs = sortBy stableModuleCmp (dep_orphs d),
dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
dep_finsts = sortBy stableModuleCmp (dep_finsts d),
dep_plgins = sortBy (compare `on` moduleNameFS) (dep_plgins d) }
-- | Creates cached lookup for the 'mi_anns' field of ModIface
-- Hackily, we use "module" as the OccName for any module-level annotations
......@@ -1390,6 +1392,7 @@ checkDependencies hsc_env summary iface
= checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
where
prev_dep_mods = dep_mods (mi_deps iface)
prev_dep_plgn = dep_plgins (mi_deps iface)
prev_dep_pkgs = dep_pkgs (mi_deps iface)
this_pkg = thisPackage (hsc_dflags hsc_env)
......@@ -1400,7 +1403,7 @@ checkDependencies hsc_env summary iface
case find_res of
Found _ mod
| pkg == this_pkg
-> if moduleName mod `notElem` map fst prev_dep_mods
-> if moduleName mod `notElem` map fst prev_dep_mods ++ prev_dep_plgn
then do traceHiDiffs $
text "imported module " <> quotes (ppr mod) <>
text " not among previous dependencies"
......
......@@ -127,7 +127,7 @@ checkExternalInterpreter hsc_env =
where
dflags = hsc_dflags hsc_env
loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, Module)
loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface)
loadPlugin' occ_name plugin_name hsc_env mod_name
= do { let plugin_rdr_name = mkRdrQual mod_name occ_name
dflags = hsc_dflags hsc_env
......@@ -139,7 +139,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
[ text "The module", ppr mod_name
, text "did not export the plugin name"
, ppr plugin_rdr_name ]) ;
Just (name, mod) ->
Just (name, mod_iface) ->
do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
......@@ -149,7 +149,7 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
[ text "The value", ppr name
, text "did not have the type"
, ppr pluginTyConName, text "as required"])
Just plugin -> return (plugin, mod) } } }
Just plugin -> return (plugin, mod_iface) } } }
-- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
......@@ -258,7 +258,8 @@ lessUnsafeCoerce dflags context what = do
-- being compiled. This was introduced by 57d6798.
--
-- Need the module as well to record information in the interface file
lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe (Name, Module))
lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName
-> IO (Maybe (Name, ModIface))
lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- First find the package the module resides in by searching exposed packages and home modules
found_module <- findPluginModule hsc_env mod_name
......@@ -276,7 +277,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface))
case lookupGRE_RdrName rdr_name env of
[gre] -> return (Just (gre_name gre, mi_module iface))
[gre] -> return (Just (gre_name gre, iface))
[] -> return Nothing
_ -> panic "lookupRdrNameInModule"
......
......@@ -2371,6 +2371,9 @@ data Dependencies
-- This is used by 'checkFamInstConsistency'. This
-- does NOT include us, unlike 'imp_finsts'. See Note
-- [The type family instance consistency story].
, dep_plgins :: [ModuleName]
-- ^ All the plugins used while compiling this module.
}
deriving( Eq )
-- Equality used only for old/new comparison in MkIface.addFingerprints
......@@ -2381,16 +2384,18 @@ instance Binary Dependencies where
put_ bh (dep_pkgs deps)
put_ bh (dep_orphs deps)
put_ bh (dep_finsts deps)
put_ bh (dep_plgins deps)
get bh = do ms <- get bh
ps <- get bh
os <- get bh
fis <- get bh
pl <- get bh
return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os,
dep_finsts = fis })
dep_finsts = fis, dep_plgins = pl })
noDependencies :: Dependencies
noDependencies = Deps [] [] [] []
noDependencies = Deps [] [] [] [] []
-- | Records modules for which changes may force recompilation of this module
-- See wiki: http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
......
......@@ -99,14 +99,14 @@ data Plugin = Plugin {
data LoadedPlugin = LoadedPlugin {
lpPlugin :: Plugin
-- ^ the actual callable plugin
, lpModule :: Module
, lpModule :: ModIface
-- ^ the module containing the plugin
, lpArguments :: [CommandLineOption]
-- ^ command line arguments for the plugin
}
lpModuleName :: LoadedPlugin -> ModuleName
lpModuleName = moduleName . lpModule
lpModuleName = moduleName . mi_module . lpModule
data PluginRecompile = ForceRecompile | NoForceRecompile | MaybeRecompile Fingerprint
......
......@@ -105,3 +105,10 @@ plugin-recomp-flags:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:0
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1
# Should recompile the module because the plugin changed
.PHONY: plugin-recomp-change
plugin-recomp-change:
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
"$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2
"$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin
......@@ -155,3 +155,9 @@ test('plugin-recomp-flags',
pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
],
run_command, ['$MAKE -s --no-print-directory plugin-recomp-flags'])
test('plugin-recomp-change',
[extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']),
pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}')
],
run_command, ['$MAKE -s --no-print-directory plugin-recomp-change'])
Simple Plugin Passes Queried
Got options:
Simple Plugin Pass Run
Simple Plugin Passes Queried
Got options:
Simple Plugin Pass Run 2
{-# LANGUAGE CPP #-}
module Common where
import GhcPlugins
......@@ -13,5 +14,9 @@ install options todos = do
mainPass :: ModGuts -> CoreM ModGuts
mainPass guts = do
#if defined(RUN2)
putMsgS "Simple Plugin Pass Run 2"
#else
putMsgS "Simple Plugin Pass Run"
#endif
return guts
TOP=../../..
RUN=-DRUN1
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
......@@ -12,9 +13,9 @@ package.%:
$(MAKE) -s --no-print-directory clean.$*
mkdir pkg.$*
"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
"$(GHC_PKG)" init pkg.$*/local.package.conf
pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling)
pkg.$*/setup build --distdir pkg.$*/dist -v0
pkg.$*/setup install --distdir pkg.$*/dist -v0
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment