X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=124e7aae177c364457131dc9cd362e8ec87e9915;hp=1521069001d05bd8bb14d8ea61ff8d4ce22f5a62;hb=d51f42f602bf9a6d1b356c41228a534c88723f65;hpb=c4ea1371c0683bbd6e6c78d73435de369bb6c468 diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 1521069..124e7aa 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -223,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 @@ -233,6 +233,7 @@ import ListSetOps import Control.Monad import Data.List import Data.IORef +import System.FilePath \end{code} @@ -413,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 @@ -465,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 @@ -729,7 +730,7 @@ computeChangedOccs ver_fn this_module old_usages eq_info 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 @@ -759,12 +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 - -instance Outputable OccIfaceEq where - ppr Equal = ptext SLIT("Equal") - ppr NotEqual = ptext SLIT("NotEqual") - ppr (EqBut occset) = ptext SLIT("EqBut") <+> ppr (occSetElts occset) +type OccIfaceEq = GenIfaceEq OccName changedWrt :: OccSet -> OccIfaceEq -> Bool changedWrt so_far Equal = False @@ -1002,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 @@ -1034,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} @@ -1056,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) @@ -1110,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 @@ -1142,16 +1138,13 @@ 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 @@ -1170,9 +1163,9 @@ 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 @@ -1189,9 +1182,9 @@ checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_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")) } @@ -1217,25 +1210,24 @@ checkEntityUsage new_vers (name,old_vers) 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 + | 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]) ---------------------- 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} %************************************************************************