From de21f53e25eb67248ba416187d34ba7ec9ec143a Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 3 Aug 2007 10:20:45 +0000 Subject: [PATCH] FIX part of #1372, improvements to the recompilation checker This patch adds a check that each imported module is listed in the dependencies from the previous interface. It catches the following cases and forces recompilation: - an exposed package has been upgraded - we are compiling with different package flags - a home module that was shadowing a package module has been removed - a new home module has been added that shadows a package module I haven't yet added the package timestamping as described in #1372. --- compiler/iface/MkIface.lhs | 64 +++++++++++++++++++++++++++++++++++---- compiler/main/DriverPipeline.hs | 12 ++++---- 2 files changed, 64 insertions(+), 12 deletions(-) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 7d1622c..489c2f7 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -193,7 +193,7 @@ import InstEnv import FamInstEnv import TcRnMonad import HscTypes - +import Finder import DynFlags import VarEnv import Var @@ -893,7 +893,7 @@ check_old_iface hsc_env mod_summary source_unchanged maybe_iface case maybe_iface of { Just old_iface -> do -- Use the one we already have { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary)) - ; recomp <- checkVersions hsc_env source_unchanged old_iface + ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface ; return (recomp, Just old_iface) } ; Nothing -> do @@ -912,9 +912,10 @@ check_old_iface hsc_env mod_summary source_unchanged maybe_iface -- We have got the old iface; check its versions { traceIf (text "Read the interface file" <+> text iface_path) - ; recomp <- checkVersions hsc_env source_unchanged iface + ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface ; returnM (recomp, Just iface) }}}}} + \end{code} @recompileRequired@ is called from the HscMain. It checks whether @@ -929,15 +930,19 @@ outOfDate = True -- Recompile required checkVersions :: HscEnv -> Bool -- True <=> source unchanged + -> ModSummary -> ModIface -- Old interface -> IfG RecompileRequired -checkVersions hsc_env source_unchanged iface +checkVersions hsc_env source_unchanged mod_summary iface | not source_unchanged = returnM outOfDate | otherwise = do { traceHiDiffs (text "Considering whether compilation is required for" <+> ppr (mi_module iface) <> colon) + ; recomp <- checkDependencies hsc_env mod_summary iface + ; if recomp then return outOfDate else do { + -- Source code unchanged and no errors yet... carry on -- First put the dependent-module info, read from the old interface, into the envt, @@ -950,16 +955,63 @@ checkVersions hsc_env source_unchanged iface -- We do this regardless of compilation mode, although in --make mode -- all the dependent modules should be in the HPT already, so it's -- quite redundant - ; updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } + updateEps_ $ \eps -> eps { eps_is_boot = mod_deps } ; let this_pkg = thisPackage (hsc_dflags hsc_env) ; checkList [checkModUsage this_pkg u | u <- mi_usages iface] - } + }} where -- This is a bit of a hack really mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface) mod_deps = mkModDeps (dep_mods (mi_deps iface)) + +-- If the direct imports of this module are resolved to targets that +-- are not among the dependencies of the previous interface file, +-- then we definitely need to recompile. This catches cases like +-- - an exposed package has been upgraded +-- - we are compiling with different package flags +-- - a home module that was shadowing a package module has been removed +-- - a new home module has been added that shadows a package module +-- See bug #1372. +-- +-- Returns True if recompilation is required. +checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired +checkDependencies hsc_env summary iface + = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary)) + where + prev_dep_mods = dep_mods (mi_deps iface) + prev_dep_pkgs = dep_pkgs (mi_deps iface) + + this_pkg = thisPackage (hsc_dflags hsc_env) + + orM = foldr f (return False) + where f m rest = do b <- m; if b then return True else rest + + dep_missing (L _ mod) = do + find_res <- ioToIOEnv $ findImportedModule hsc_env mod Nothing + case find_res of + Found _ mod + | pkg == this_pkg + -> if moduleName mod `notElem` map fst prev_dep_mods + then do traceHiDiffs $ + text "imported module " <> quotes (ppr mod) <> + text " not among previous dependencies" + return outOfDate + else + return upToDate + | otherwise + -> if pkg `notElem` prev_dep_pkgs + then do traceHiDiffs $ + text "imported module " <> quotes (ppr mod) <> + text " is from package " <> quotes (ppr pkg) <> + text ", which is not among previous dependencies" + return outOfDate + else + return upToDate + where pkg = modulePackageId mod + _otherwise -> return outOfDate + checkModUsage :: PackageId ->Usage -> IfG RecompileRequired -- Given the usage information extracted from the old -- M.hi file for the module being compiled, figure out diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 3a0fefa..e9fb307 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -640,15 +640,15 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma dflags = dflags0 { includePaths = current_dir : paths } -- gather the imports and module name - (hspp_buf,mod_name) <- + (hspp_buf,mod_name,imps,src_imps) <- case src_flavour of ExtCoreFile -> do { -- no explicit imports in ExtCore input. ; m <- getCoreModuleName input_fn - ; return (Nothing, mkModuleName m) } + ; return (Nothing, mkModuleName m, [], []) } other -> do { buf <- hGetStringBuffer input_fn - ; (_,_,L _ mod_name) <- getImports dflags buf input_fn - ; return (Just buf, mod_name) } + ; (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn + ; return (Just buf, mod_name, imps, src_imps) } -- Build a ModLocation to pass to hscMain. -- The source filename is rather irrelevant by now, but it's used @@ -735,8 +735,8 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma ms_location = location4, ms_hs_date = src_timestamp, ms_obj_date = Nothing, - ms_imps = unused_field, - ms_srcimps = unused_field } + ms_imps = imps, + ms_srcimps = src_imps } -- run the compiler! mbResult <- hscCompileOneShot hsc_env -- 1.7.10.4