diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/deSugar/Desugar.hs | 5 | ||||
| -rw-r--r-- | compiler/deSugar/DsUsage.hs | 103 | ||||
| -rw-r--r-- | compiler/iface/MkIface.hs | 11 | ||||
| -rw-r--r-- | compiler/main/DynamicLoading.hs | 11 | ||||
| -rw-r--r-- | compiler/main/HscTypes.hs | 9 | ||||
| -rw-r--r-- | compiler/main/Plugins.hs | 4 |
6 files changed, 124 insertions, 19 deletions
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 583bc5979c..c1e728b734 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -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 diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index c8a04247cc..45d4dcfb48 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -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 diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 8091587c84..8381a5975b 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -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" diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 21fe359d3c..764bf2dd41 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -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" diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 27c699c190..77445f6bc3 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -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 diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs index 0e2ab32015..8ead643f49 100644 --- a/compiler/main/Plugins.hs +++ b/compiler/main/Plugins.hs @@ -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 |