X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=e89d8be3fcd895a4e5b75bfdbd447edfb6f6112d;hb=5b99c6d19d96479956f7e4438982f2eb34bac5e1;hp=c0b9717c64d98afa0ff8dadcc168e45307d3b2d3;hpb=23e4e1039c16bb30fec04b5006bfc0f4989239d9;p=ghc-hetmet.git diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index c0b9717..e89d8be 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -131,7 +131,7 @@ We produce a line for every module B below the module, A, currently being compiled: import B ; to record the fact that A does import B indirectly. This is used to decide -to look to look for B.hi rather than B.hi-boot when compiling a module that +to look for B.hi rather than B.hi-boot when compiling a module that imports A. This line says that A imports B, but uses nothing in it. So we'll get an early bale-out when compiling A if B's version changes. @@ -181,6 +181,10 @@ code of A, and thereby haul in all the stuff reachable from it. haul in all the unfoldings for B, in case the module that imports A *is* compiled with -O. I think this is the case.] +SimonM [30/11/2007]: I believe the above is all out of date; the +current implementation doesn't do it this way. Instead, when any of +the dependencies of a declaration changes, the version of the +declaration itself changes. \begin{code} #include "HsVersions.h" @@ -219,7 +223,7 @@ import SrcLoc import PackageConfig hiding ( Version ) import Outputable import BasicTypes hiding ( SuccessFlag(..) ) -import UniqFM +import LazyUniqFM import Util hiding ( eqListBy ) import FiniteMap import FastString @@ -229,6 +233,7 @@ import ListSetOps import Control.Monad import Data.List import Data.IORef +import System.FilePath \end{code} @@ -409,7 +414,7 @@ mkIface_ hsc_env maybe_old_iface mi_fix_fn = mkIfaceFixCache fixities } -- Add version information - ; ext_ver_fn = mkParentVerFun hsc_env eps + ; ext_ver_fn = mkParentVerFun hsc_env eps ; (new_iface, no_change_at_all, pp_diffs, pp_orphs) = {-# SCC "versioninfo" #-} addVersionInfo ext_ver_fn maybe_old_iface @@ -461,7 +466,7 @@ mkIface_ hsc_env maybe_old_iface ----------------------------- writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO () writeIfaceFile dflags location new_iface - = do createDirectoryHierarchy (directoryOf hi_file_path) + = do createDirectoryHierarchy (takeDirectory hi_file_path) writeBinIface dflags hi_file_path new_iface where hi_file_path = ml_hi_file location @@ -513,7 +518,7 @@ addVersionInfo ver_fn Nothing new_iface new_decls new_decls) }, False, - ptext SLIT("No old interface file"), + ptext (sLit "No old interface file"), pprOrphans orph_insts orph_rules) where orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface) @@ -529,9 +534,9 @@ addVersionInfo ver_fn (Just old_iface@(ModIface { new_iface@(ModIface { mi_fix_fn = new_fixities }) new_decls | no_change_at_all - = (old_iface, True, ptext SLIT("Interface file unchanged"), pp_orphs) + = (old_iface, True, ptext (sLit "Interface file unchanged"), pp_orphs) | otherwise - = (final_iface, False, vcat [ptext SLIT("Interface file has changed"), + = (final_iface, False, vcat [ptext (sLit "Interface file has changed"), nest 2 pp_diffs], pp_orphs) where final_iface = new_iface { @@ -589,7 +594,7 @@ addVersionInfo ver_fn (Just old_iface@(ModIface { pp_change no_other_changes "Usages" empty, pp_decl_diffs] pp_change True what info = empty - pp_change False what info = text what <+> ptext SLIT("changed") <+> info + pp_change False what info = text what <+> ptext (sLit "changed") <+> info ------------------- old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls] @@ -651,8 +656,8 @@ addVersionInfo ver_fn (Just old_iface@(ModIface { pp_decl_diffs | isEmptyOccSet changed_occs = empty | otherwise - = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs), - ptext SLIT("Version change for these decls:"), + = vcat [ptext (sLit "Changed occs:") <+> ppr (occSetElts changed_occs), + ptext (sLit "Version change for these decls:"), nest 2 (vcat (map show_change new_decls))] eq_env = mkOccEnv eq_info @@ -664,16 +669,16 @@ addVersionInfo ver_fn (Just old_iface@(ModIface { where occ = ifName new_decl why = case lookupOccEnv eq_env occ of - Just (EqBut names) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:") <> ppr names, + Just (EqBut names) -> sep [ppr occ <> colon, ptext (sLit "Free vars (only) changed:") <> ppr names, nest 2 (braces (fsep (map ppr (occSetElts (occs `intersectOccSet` changed_occs)))))] where occs = mkOccSet (map nameOccName (nameSetToList names)) Just NotEqual | Just old_decl <- lookupOccEnv old_decl_env occ - -> vcat [ptext SLIT("Old:") <+> ppr old_decl, - ptext SLIT("New:") <+> ppr new_decl] + -> vcat [ptext (sLit "Old:") <+> ppr old_decl, + ptext (sLit "New:") <+> ppr new_decl] | otherwise - -> ppr occ <+> ptext SLIT("only in new interface") + -> ppr occ <+> ptext (sLit "only in new interface") other -> pprPanic "MkIface.show_change" (ppr occ) pp_orphs = pprOrphans new_orph_insts new_orph_rules @@ -684,10 +689,10 @@ pprOrphans insts rules | otherwise = Just $ vcat [ if null insts then empty else - hang (ptext SLIT("Warning: orphan instances:")) + hang (ptext (sLit "Warning: orphan instances:")) 2 (vcat (map ppr insts)), if null rules then empty else - hang (ptext SLIT("Warning: orphan rules:")) + hang (ptext (sLit "Warning: orphan rules:")) 2 (vcat (map ppr rules)) ] @@ -704,20 +709,28 @@ computeChangedOccs ver_fn this_module old_usages eq_info -- return True if an external name has changed name_changed :: Name -> Bool name_changed nm - | Just ents <- lookupUFM usg_modmap (moduleName mod) - = case lookupUFM ents parent_occ of - Nothing -> pprPanic "computeChangedOccs" (ppr nm) - Just v -> v < new_version + | isWiredInName nm -- Wired-in things don't get into interface + = False -- files and hence don't get into the ver_fn + | Just ents <- lookupUFM usg_modmap (moduleName mod), + Just v <- lookupUFM ents parent_occ + = v < new_version + | modulePackageId mod == this_pkg + = WARN(True, ptext (sLit "computeChangedOccs") <+> ppr nm) True + -- should really be a panic, see #1959. The problem is that the usages doesn't + -- contain all the names that might be referred to by unfoldings. So as a + -- conservative workaround we just assume these names have changed. | otherwise = False -- must be in another package where mod = nameModule nm (parent_occ, new_version) = ver_fn nm + this_pkg = modulePackageId this_module + -- Turn the usages from the old ModIface into a mapping - usg_modmap = listToUFM [ (usg_mod usg, listToUFM (usg_entities usg)) + usg_modmap = listToUFM [ (usg_name usg, listToUFM (usg_entities usg)) | usg <- old_usages ] - get_local_eq_info :: GenIfaceEq NameSet -> GenIfaceEq OccSet + get_local_eq_info :: GenIfaceEq Name -> GenIfaceEq OccName get_local_eq_info Equal = Equal get_local_eq_info NotEqual = NotEqual get_local_eq_info (EqBut ns) = foldNameSet f Equal ns @@ -747,7 +760,7 @@ computeChangedOccs ver_fn this_module old_usages eq_info where (occs, iface_eqs) = unzip pairs add_changes so_far other = so_far -type OccIfaceEq = GenIfaceEq OccSet +type OccIfaceEq = GenIfaceEq OccName changedWrt :: OccSet -> OccIfaceEq -> Bool changedWrt so_far Equal = False @@ -985,7 +998,7 @@ checkOldIface hsc_env mod_summary source_unchanged maybe_iface check_old_iface hsc_env mod_summary source_unchanged maybe_iface = do -- CHECK WHETHER THE SOURCE HAS CHANGED - { ifM (not source_unchanged) + { when (not source_unchanged) (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off"))) -- If the source has changed and we're in interactive mode, avoid reading @@ -1017,7 +1030,7 @@ 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 mod_summary iface - ; returnM (recomp, Just iface) + ; return (recomp, Just iface) }}}}} \end{code} @@ -1039,7 +1052,7 @@ checkVersions :: HscEnv -> IfG RecompileRequired checkVersions hsc_env source_unchanged mod_summary iface | not source_unchanged - = returnM outOfDate + = return outOfDate | otherwise = do { traceHiDiffs (text "Considering whether compilation is required for" <+> ppr (mi_module iface) <> colon) @@ -1093,7 +1106,7 @@ checkDependencies hsc_env summary iface 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 + find_res <- liftIO $ findImportedModule hsc_env mod Nothing case find_res of Found _ mod | pkg == this_pkg @@ -1125,21 +1138,18 @@ checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_vers, usg_rules = old_rule_vers, usg_exports = maybe_old_export_vers, usg_entities = old_decl_vers }) - = -- Load the imported interface is possible - let - doc_str = sep [ptext SLIT("need version info for"), ppr mod_name] - in - traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_` + = do -- Load the imported interface is possible + let doc_str = sep [ptext (sLit "need version info for"), ppr mod_name] + traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) - let - mod = mkModule this_pkg mod_name - in - loadInterface doc_str mod ImportBySystem `thenM` \ mb_iface -> + let mod = mkModule this_pkg mod_name + + mb_iface <- loadInterface doc_str mod ImportBySystem -- Load the interface, but don't complain on failure; -- Instead, get an Either back which we can test case mb_iface of { - Failed exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"), + Failed exn -> (out_of_date (sep [ptext (sLit "Can't find version number for module"), ppr mod_name])); -- Couldn't find or parse a module mentioned in the -- old interface file. Don't complain -- it might just be that @@ -1153,39 +1163,39 @@ checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_vers, new_rule_vers = mi_rule_vers iface in -- CHECK MODULE - checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile -> + checkModuleVersion old_mod_vers new_mod_vers >>= \ recompile -> if not recompile then - returnM upToDate + return upToDate else -- CHECK EXPORT LIST if checkExportList maybe_old_export_vers new_export_vers then - out_of_date_vers (ptext SLIT(" Export list changed")) + out_of_date_vers (ptext (sLit " Export list changed")) (expectJust "checkModUsage" maybe_old_export_vers) new_export_vers else -- CHECK RULES if old_rule_vers /= new_rule_vers then - out_of_date_vers (ptext SLIT(" Rules changed")) + out_of_date_vers (ptext (sLit " Rules changed")) old_rule_vers new_rule_vers else -- CHECK ITEMS ONE BY ONE - checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile -> + checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] >>= \ recompile -> if recompile then - returnM outOfDate -- This one failed, so just bail out now + return outOfDate -- This one failed, so just bail out now else - up_to_date (ptext SLIT(" Great! The bits I use are up to date")) + up_to_date (ptext (sLit " Great! The bits I use are up to date")) } ------------------------ checkModuleVersion old_mod_vers new_mod_vers | new_mod_vers == old_mod_vers - = up_to_date (ptext SLIT("Module version unchanged")) + = up_to_date (ptext (sLit "Module version unchanged")) | otherwise - = out_of_date_vers (ptext SLIT(" Module version has changed")) + = out_of_date_vers (ptext (sLit " Module version has changed")) old_mod_vers new_mod_vers ------------------------ @@ -1197,28 +1207,27 @@ checkEntityUsage new_vers (name,old_vers) = case new_vers name of Nothing -> -- We used it before, but it ain't there now - out_of_date (sep [ptext SLIT("No longer exported:"), ppr name]) + out_of_date (sep [ptext (sLit "No longer exported:"), ppr name]) Just (_, new_vers) -- It's there, but is it up to date? - | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_` - returnM upToDate - | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name) + | new_vers == old_vers -> do traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) + return upToDate + | otherwise -> out_of_date_vers (ptext (sLit " Out of date:") <+> ppr name) old_vers new_vers -up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate -out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate +up_to_date msg = traceHiDiffs msg >> return upToDate +out_of_date msg = traceHiDiffs msg >> return outOfDate out_of_date_vers msg old_vers new_vers - = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers]) + = out_of_date (hsep [msg, ppr old_vers, ptext (sLit "->"), ppr new_vers]) ---------------------- checkList :: [IfG RecompileRequired] -> IfG RecompileRequired -- This helper is used in two places -checkList [] = returnM upToDate -checkList (check:checks) = check `thenM` \ recompile -> - if recompile then - returnM outOfDate - else - checkList checks +checkList [] = return upToDate +checkList (check:checks) = do recompile <- check + if recompile + then return outOfDate + else checkList checks \end{code} %************************************************************************ @@ -1487,7 +1496,7 @@ coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn, bogusIfaceRule :: Name -> IfaceRule bogusIfaceRule id_name - = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive, + = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive, ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [], ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }