From 660c3f9d8534e3b249b27ab4024939d204366cc7 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 16 May 2014 10:19:45 +0100 Subject: [PATCH] Just formatting --- compiler/iface/MkIface.lhs | 26 +++++++++++++------- compiler/main/HscMain.hs | 28 ++++++++++++---------- compiler/main/HscTypes.lhs | 49 ++++++++++++++++++++++++-------------- 3 files changed, 64 insertions(+), 39 deletions(-) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 1310de13d0f7..d1a8605b9c48 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1133,27 +1133,35 @@ recompileRequired _ = True -- first element is a bool saying if we should recompile the object file -- and the second is maybe the interface file, where Nothng means to -- rebuild the interface file not use the exisitng one. -checkOldIface :: HscEnv - -> ModSummary - -> SourceModified - -> Maybe ModIface -- Old interface from compilation manager, if any - -> IO (RecompileRequired, Maybe ModIface) +checkOldIface + :: HscEnv + -> ModSummary + -> SourceModified + -> Maybe ModIface -- Old interface from compilation manager, if any + -> IO (RecompileRequired, Maybe ModIface) checkOldIface hsc_env mod_summary source_modified maybe_iface = do let dflags = hsc_dflags hsc_env showPass dflags $ - "Checking old interface for " ++ (showPpr dflags $ ms_mod mod_summary) + "Checking old interface for " ++ + (showPpr dflags $ ms_mod mod_summary) initIfaceCheck hsc_env $ check_old_iface hsc_env mod_summary source_modified maybe_iface -check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface - -> IfG (RecompileRequired, Maybe ModIface) +check_old_iface + :: HscEnv + -> ModSummary + -> SourceModified + -> Maybe ModIface + -> IfG (RecompileRequired, Maybe ModIface) + check_old_iface hsc_env mod_summary src_modified maybe_iface = let dflags = hsc_dflags hsc_env getIface = case maybe_iface of Just _ -> do - traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary)) + traceIf (text "We already have the old interface for" <+> + ppr (ms_mod mod_summary)) return maybe_iface Nothing -> loadIface diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 7cda3d6184d9..9b6c4d762fa2 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -517,8 +517,9 @@ genericHscCompileGetFrontendResult :: -> (Int,Int) -- (i,n) = module i of n (for msgs) -> IO (Either ModIface (TcGblEnv, Maybe Fingerprint)) -genericHscCompileGetFrontendResult always_do_basic_recompilation_check m_tc_result - mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index +genericHscCompileGetFrontendResult + always_do_basic_recompilation_check m_tc_result + mHscMessage hsc_env mod_summary source_modified mb_old_iface mod_index = do let msg what = case mHscMessage of @@ -554,16 +555,19 @@ genericHscCompileGetFrontendResult always_do_basic_recompilation_check m_tc_resu case mb_checked_iface of Just iface | not (recompileRequired recomp_reqd) -> - -- If the module used TH splices when it was last compiled, - -- then the recompilation check is not accurate enough (#481) - -- and we must ignore it. However, if the module is stable - -- (none of the modules it depends on, directly or indirectly, - -- changed), then we *can* skip recompilation. This is why - -- the SourceModified type contains SourceUnmodifiedAndStable, - -- and it's pretty important: otherwise ghc --make would - -- always recompile TH modules, even if nothing at all has - -- changed. Stability is just the same check that make is - -- doing for us in one-shot mode. + -- If the module used TH splices when it was last + -- compiled, then the recompilation check is not + -- accurate enough (#481) and we must ignore + -- it. However, if the module is stable (none of + -- the modules it depends on, directly or + -- indirectly, changed), then we *can* skip + -- recompilation. This is why the SourceModified + -- type contains SourceUnmodifiedAndStable, and + -- it's pretty important: otherwise ghc --make + -- would always recompile TH modules, even if + -- nothing at all has changed. Stability is just + -- the same check that make is doing for us in + -- one-shot mode. case m_tc_result of Nothing | mi_used_th iface && not stable -> diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 8843d9542a72..1e40d4225f0c 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -2210,37 +2210,50 @@ type ModuleGraph = [ModSummary] emptyMG :: ModuleGraph emptyMG = [] --- | A single node in a 'ModuleGraph. The nodes of the module graph are one of: +-- | A single node in a 'ModuleGraph'. The nodes of the module graph +-- are one of: -- -- * A regular Haskell source module --- -- * A hi-boot source module --- -- * An external-core source module +-- data ModSummary = ModSummary { - ms_mod :: Module, -- ^ Identity of the module - ms_hsc_src :: HscSource, -- ^ The module source either plain Haskell, hs-boot or external core - ms_location :: ModLocation, -- ^ Location of the various files belonging to the module - ms_hs_date :: UTCTime, -- ^ Timestamp of source file - ms_obj_date :: Maybe UTCTime, -- ^ Timestamp of object, if we have one - ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module - ms_textual_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module from the module *text* - ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file - ms_hspp_opts :: DynFlags, -- ^ Cached flags from @OPTIONS@, @INCLUDE@ - -- and @LANGUAGE@ pragmas in the modules source code - ms_hspp_buf :: Maybe StringBuffer -- ^ The actual preprocessed source, if we have it + ms_mod :: Module, + -- ^ Identity of the module + ms_hsc_src :: HscSource, + -- ^ The module source either plain Haskell, hs-boot or external core + ms_location :: ModLocation, + -- ^ Location of the various files belonging to the module + ms_hs_date :: UTCTime, + -- ^ Timestamp of source file + ms_obj_date :: Maybe UTCTime, + -- ^ Timestamp of object, if we have one + ms_srcimps :: [Located (ImportDecl RdrName)], + -- ^ Source imports of the module + ms_textual_imps :: [Located (ImportDecl RdrName)], + -- ^ Non-source imports of the module from the module *text* + ms_hspp_file :: FilePath, + -- ^ Filename of preprocessed source file + ms_hspp_opts :: DynFlags, + -- ^ Cached flags from @OPTIONS@, @INCLUDE@ and @LANGUAGE@ + -- pragmas in the modules source code + ms_hspp_buf :: Maybe StringBuffer + -- ^ The actual preprocessed source, if we have it } ms_mod_name :: ModSummary -> ModuleName ms_mod_name = moduleName . ms_mod ms_imps :: ModSummary -> [Located (ImportDecl RdrName)] -ms_imps ms = ms_textual_imps ms ++ map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms)) +ms_imps ms = + ms_textual_imps ms ++ + map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms)) where - -- This is a not-entirely-satisfactory means of creating an import that corresponds to an - -- import that did not occur in the program text, such as those induced by the use of - -- plugins (the -plgFoo flag) + -- This is a not-entirely-satisfactory means of creating an import + -- that corresponds to an import that did not occur in the program + -- text, such as those induced by the use of plugins (the -plgFoo + -- flag) mk_additional_import mod_nm = noLoc $ ImportDecl { ideclName = noLoc mod_nm, ideclPkgQual = Nothing,