From 7a2ef5a8a09afa8955e28e969bb2a6268fd34508 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 5 Jun 2012 13:11:38 +0100 Subject: Tabs -> Spaces in GhcMake.hs. --- compiler/main/GhcMake.hs | 916 +++++++++++++++++++++++------------------------ 1 file changed, 458 insertions(+), 458 deletions(-) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 3db920553e..cca1f17c75 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -28,7 +28,7 @@ module GhcMake( #include "HsVersions.h" #ifdef GHCI -import qualified Linker ( unload ) +import qualified Linker ( unload ) #endif import DriverPipeline @@ -41,19 +41,19 @@ import DynFlags import HsSyn import Finder import HeaderInfo -import TcIface ( typecheckIface ) -import TcRnMonad ( initIfaceCheck ) -import RdrName ( RdrName ) +import TcIface ( typecheckIface ) +import TcRnMonad ( initIfaceCheck ) +import RdrName ( RdrName ) -import Exception ( evaluate, tryIO ) +import Exception ( evaluate, tryIO ) import Panic import SysTools import BasicTypes import SrcLoc import Util import Digraph -import Bag ( listToBag ) -import Maybes ( expectJust, mapCatMaybes ) +import Bag ( listToBag ) +import Maybes ( expectJust, mapCatMaybes ) import StringBuffer import FastString import Outputable @@ -63,9 +63,9 @@ import qualified Data.Map as Map import qualified FiniteMap as Map( insertListWith) import System.Directory ( doesFileExist, getModificationTime ) -import System.IO ( fixIO ) -import System.IO.Error ( isDoesNotExistError ) -import System.Time ( ClockTime ) +import System.IO ( fixIO ) +import System.IO.Error ( isDoesNotExistError ) +import System.Time ( ClockTime ) import System.FilePath import Control.Monad import Data.Maybe @@ -94,14 +94,14 @@ depanal :: GhcMonad m => depanal excluded_mods allow_dup_roots = do hsc_env <- getSession let - dflags = hsc_dflags hsc_env - targets = hsc_targets hsc_env - old_graph = hsc_mod_graph hsc_env - + dflags = hsc_dflags hsc_env + targets = hsc_targets hsc_env + old_graph = hsc_mod_graph hsc_env + liftIO $ showPass dflags "Chasing dependencies" liftIO $ debugTraceMsg dflags 2 (hcat [ - text "Chasing modules from: ", - hcat (punctuate comma (map pprTarget targets))]) + text "Chasing modules from: ", + hcat (punctuate comma (map pprTarget targets))]) mod_graph <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots modifySession $ \_ -> hsc_env { hsc_mod_graph = mod_graph } @@ -140,20 +140,20 @@ load2 :: GhcMonad m => LoadHowMuch -> [ModSummary] -> m SuccessFlag load2 how_much mod_graph = do guessOutputFile - hsc_env <- getSession + hsc_env <- getSession let hpt1 = hsc_HPT hsc_env let dflags = hsc_dflags hsc_env - -- The "bad" boot modules are the ones for which we have - -- B.hs-boot in the module graph, but no B.hs - -- The downsweep should have ensured this does not happen - -- (see msDeps) + -- The "bad" boot modules are the ones for which we have + -- B.hs-boot in the module graph, but no B.hs + -- The downsweep should have ensured this does not happen + -- (see msDeps) let all_home_mods = [ms_mod_name s - | s <- mod_graph, not (isBootSummary s)] - bad_boot_mods = [s | s <- mod_graph, isBootSummary s, - not (ms_mod_name s `elem` all_home_mods)] - ASSERT( null bad_boot_mods ) return () + | s <- mod_graph, not (isBootSummary s)] + bad_boot_mods = [s | s <- mod_graph, isBootSummary s, + not (ms_mod_name s `elem` all_home_mods)] + ASSERT( null bad_boot_mods ) return () -- check that the module given in HowMuch actually exists, otherwise -- topSortModuleGraph will bomb later. @@ -171,29 +171,29 @@ load2 how_much mod_graph = do checkHowMuch how_much $ do -- mg2_with_srcimps drops the hi-boot nodes, returning a - -- graph with cycles. Among other things, it is used for + -- graph with cycles. Among other things, it is used for -- backing out partially complete cycles following a failed -- upsweep, and for removing from hpt all the modules -- not in strict downwards closure, during calls to compile. let mg2_with_srcimps :: [SCC ModSummary] - mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing + mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing - -- If we can determine that any of the {-# SOURCE #-} imports - -- are definitely unnecessary, then emit a warning. - warnUnnecessarySourceImports mg2_with_srcimps + -- If we can determine that any of the {-# SOURCE #-} imports + -- are definitely unnecessary, then emit a warning. + warnUnnecessarySourceImports mg2_with_srcimps - let - -- check the stability property for each module. - stable_mods@(stable_obj,stable_bco) - = checkStability hpt1 mg2_with_srcimps all_home_mods + let + -- check the stability property for each module. + stable_mods@(stable_obj,stable_bco) + = checkStability hpt1 mg2_with_srcimps all_home_mods - -- prune bits of the HPT which are definitely redundant now, - -- to save space. - pruned_hpt = pruneHomePackageTable hpt1 - (flattenSCCs mg2_with_srcimps) - stable_mods + -- prune bits of the HPT which are definitely redundant now, + -- to save space. + pruned_hpt = pruneHomePackageTable hpt1 + (flattenSCCs mg2_with_srcimps) + stable_mods - _ <- liftIO $ evaluate pruned_hpt + _ <- liftIO $ evaluate pruned_hpt -- before we unload anything, make sure we don't leave an old -- interactive context around pointing to dead bindings. Also, @@ -201,15 +201,15 @@ load2 how_much mod_graph = do modifySession $ \_ -> hsc_env{ hsc_IC = emptyInteractiveContext, hsc_HPT = pruned_hpt } - liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$ - text "Stable BCO:" <+> ppr stable_bco) + liftIO $ debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$ + text "Stable BCO:" <+> ppr stable_bco) - -- Unload any modules which are going to be re-linked this time around. - let stable_linkables = [ linkable - | m <- stable_obj++stable_bco, - Just hmi <- [lookupUFM pruned_hpt m], - Just linkable <- [hm_linkable hmi] ] - liftIO $ unload hsc_env stable_linkables + -- Unload any modules which are going to be re-linked this time around. + let stable_linkables = [ linkable + | m <- stable_obj++stable_bco, + Just hmi <- [lookupUFM pruned_hpt m], + Just linkable <- [hm_linkable hmi] ] + liftIO $ unload hsc_env stable_linkables -- We could at this point detect cycles which aren't broken by -- a source-import, and complain immediately, but it seems better @@ -222,56 +222,56 @@ load2 how_much mod_graph = do -- turn. Final result is version 3 of everything. -- Topologically sort the module graph, this time including hi-boot - -- nodes, and possibly just including the portion of the graph - -- reachable from the module specified in the 2nd argument to load. - -- This graph should be cycle-free. - -- If we're restricting the upsweep to a portion of the graph, we - -- also want to retain everything that is still stable. + -- nodes, and possibly just including the portion of the graph + -- reachable from the module specified in the 2nd argument to load. + -- This graph should be cycle-free. + -- If we're restricting the upsweep to a portion of the graph, we + -- also want to retain everything that is still stable. let full_mg :: [SCC ModSummary] - full_mg = topSortModuleGraph False mod_graph Nothing - - maybe_top_mod = case how_much of - LoadUpTo m -> Just m - LoadDependenciesOf m -> Just m - _ -> Nothing - - partial_mg0 :: [SCC ModSummary] - partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod - - -- LoadDependenciesOf m: we want the upsweep to stop just - -- short of the specified module (unless the specified module - -- is stable). - partial_mg - | LoadDependenciesOf _mod <- how_much - = ASSERT( case last partial_mg0 of - AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False ) - List.init partial_mg0 - | otherwise - = partial_mg0 + full_mg = topSortModuleGraph False mod_graph Nothing + + maybe_top_mod = case how_much of + LoadUpTo m -> Just m + LoadDependenciesOf m -> Just m + _ -> Nothing + + partial_mg0 :: [SCC ModSummary] + partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod + + -- LoadDependenciesOf m: we want the upsweep to stop just + -- short of the specified module (unless the specified module + -- is stable). + partial_mg + | LoadDependenciesOf _mod <- how_much + = ASSERT( case last partial_mg0 of + AcyclicSCC ms -> ms_mod_name ms == _mod; _ -> False ) + List.init partial_mg0 + | otherwise + = partial_mg0 - stable_mg = - [ AcyclicSCC ms - | AcyclicSCC ms <- full_mg, - ms_mod_name ms `elem` stable_obj++stable_bco, - ms_mod_name ms `notElem` [ ms_mod_name ms' | - AcyclicSCC ms' <- partial_mg ] ] + stable_mg = + [ AcyclicSCC ms + | AcyclicSCC ms <- full_mg, + ms_mod_name ms `elem` stable_obj++stable_bco, + ms_mod_name ms `notElem` [ ms_mod_name ms' | + AcyclicSCC ms' <- partial_mg ] ] - mg = stable_mg ++ partial_mg + mg = stable_mg ++ partial_mg - -- clean up between compilations + -- clean up between compilations let cleanup hsc_env = intermediateCleanTempFiles dflags (flattenSCCs mg2_with_srcimps) hsc_env - liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep") - 2 (ppr mg)) + liftIO $ debugTraceMsg dflags 2 (hang (text "Ready for upsweep") + 2 (ppr mg)) setSession hsc_env{ hsc_HPT = emptyHomePackageTable } (upsweep_ok, modsUpswept) <- upsweep pruned_hpt stable_mods cleanup mg - -- Make modsDone be the summaries for each home module now - -- available; this should equal the domain of hpt3. + -- Make modsDone be the summaries for each home module now + -- available; this should equal the domain of hpt3. -- Get in in a roughly top .. bottom order (hence reverse). let modsDone = reverse modsUpswept @@ -285,35 +285,35 @@ load2 how_much mod_graph = do -- Easy; just relink it all. do liftIO $ debugTraceMsg dflags 2 (text "Upsweep completely successful.") - -- Clean up after ourselves + -- Clean up after ourselves hsc_env1 <- getSession liftIO $ intermediateCleanTempFiles dflags modsDone hsc_env1 -- Issue a warning for the confusing case where the user - -- said '-o foo' but we're not going to do any linking. - -- We attempt linking if either (a) one of the modules is - -- called Main, or (b) the user said -no-hs-main, indicating - -- that main() is going to come from somewhere else. - -- - let ofile = outputFile dflags - let no_hs_main = dopt Opt_NoHsMain dflags - let - main_mod = mainModIs dflags - a_root_is_Main = any ((==main_mod).ms_mod) mod_graph - do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib - - when (ghcLink dflags == LinkBinary + -- said '-o foo' but we're not going to do any linking. + -- We attempt linking if either (a) one of the modules is + -- called Main, or (b) the user said -no-hs-main, indicating + -- that main() is going to come from somewhere else. + -- + let ofile = outputFile dflags + let no_hs_main = dopt Opt_NoHsMain dflags + let + main_mod = mainModIs dflags + a_root_is_Main = any ((==main_mod).ms_mod) mod_graph + do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib + + when (ghcLink dflags == LinkBinary && isJust ofile && not do_linking) $ - liftIO $ debugTraceMsg dflags 1 $ + liftIO $ debugTraceMsg dflags 1 $ text ("Warning: output was redirected with -o, " ++ "but no output will be generated\n" ++ - "because there is no " ++ + "because there is no " ++ moduleNameString (moduleName main_mod) ++ " module.") - -- link everything together + -- link everything together linkresult <- liftIO $ link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1) - loadFinish Succeeded linkresult + loadFinish Succeeded linkresult else -- Tricky. We need to back out the effects of compiling any @@ -325,27 +325,27 @@ load2 how_much mod_graph = do = map ms_mod modsDone let mods_to_zap_names = findPartiallyCompletedCycles modsDone_names - mg2_with_srcimps + mg2_with_srcimps let mods_to_keep = filter ((`notElem` mods_to_zap_names).ms_mod) - modsDone + modsDone hsc_env1 <- getSession let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep) - (hsc_HPT hsc_env1) + (hsc_HPT hsc_env1) - -- Clean up after ourselves + -- Clean up after ourselves liftIO $ intermediateCleanTempFiles dflags mods_to_keep hsc_env1 - -- there should be no Nothings where linkables should be, now - ASSERT(all (isJust.hm_linkable) - (eltsUFM (hsc_HPT hsc_env))) do - - -- Link everything together + -- there should be no Nothings where linkables should be, now + ASSERT(all (isJust.hm_linkable) + (eltsUFM (hsc_HPT hsc_env))) do + + -- Link everything together linkresult <- liftIO $ link (ghcLink dflags) dflags False hpt4 modifySession $ \hsc_env -> hsc_env{ hsc_HPT = hpt4 } - loadFinish Failed linkresult + loadFinish Failed linkresult -- Finish up after a load. @@ -370,8 +370,8 @@ loadFinish all_ok Succeeded discardProg :: HscEnv -> HscEnv discardProg hsc_env = hsc_env { hsc_mod_graph = emptyMG, - hsc_IC = emptyInteractiveContext, - hsc_HPT = emptyHomePackageTable } + hsc_IC = emptyInteractiveContext, + hsc_HPT = emptyHomePackageTable } intermediateCleanTempFiles :: DynFlags -> [ModSummary] -> HscEnv -> IO () intermediateCleanTempFiles dflags summaries hsc_env @@ -422,7 +422,7 @@ guessOutputFile = modifySession $ \env -> -- Before doing an upsweep, we can throw away: -- -- - For non-stable modules: --- - all ModDetails, all linked code +-- - all ModDetails, all linked code -- - all unlinked code that is out of date with respect to -- the source file -- @@ -440,19 +440,19 @@ pruneHomePackageTable pruneHomePackageTable hpt summ (stable_obj, stable_bco) = mapUFM prune hpt where prune hmi - | is_stable modl = hmi' - | otherwise = hmi'{ hm_details = emptyModDetails } - where - modl = moduleName (mi_module (hm_iface hmi)) - hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms - = hmi{ hm_linkable = Nothing } - | otherwise - = hmi - where ms = expectJust "prune" (lookupUFM ms_map modl) + | is_stable modl = hmi' + | otherwise = hmi'{ hm_details = emptyModDetails } + where + modl = moduleName (mi_module (hm_iface hmi)) + hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms + = hmi{ hm_linkable = Nothing } + | otherwise + = hmi + where ms = expectJust "prune" (lookupUFM ms_map modl) ms_map = listToUFM [(ms_mod_name ms, ms) | ms <- summ] - is_stable m = m `elem` stable_obj || m `elem` stable_bco + is_stable m = m `elem` stable_obj || m `elem` stable_bco -- ----------------------------------------------------------------------------- @@ -481,16 +481,16 @@ findPartiallyCompletedCycles modsDone theGraph -- Unloading unload :: HscEnv -> [Linkable] -> IO () -unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' +unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' = case ghcLink (hsc_dflags hsc_env) of #ifdef GHCI - LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables + LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables #else - LinkInMemory -> panic "unload: no interpreter" + LinkInMemory -> panic "unload: no interpreter" -- urgh. avoid warnings: hsc_env stable_linkables #endif - _other -> return () + _other -> return () -- ----------------------------------------------------------------------------- @@ -514,25 +514,25 @@ unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' stable m = stableObject m || stableBCO m stableObject m = - all stableObject (imports m) - && old linkable does not exist, or is == on-disk .o - && date(on-disk .o) > date(.hs) + all stableObject (imports m) + && old linkable does not exist, or is == on-disk .o + && date(on-disk .o) > date(.hs) stableBCO m = - all stable (imports m) - && date(BCO) > date(.hs) + all stable (imports m) + && date(BCO) > date(.hs) @ These properties embody the following ideas: - if a module is stable, then: - - if it has been compiled in a previous pass (present in HPT) - then it does not need to be compiled or re-linked. + - if it has been compiled in a previous pass (present in HPT) + then it does not need to be compiled or re-linked. - if it has not been compiled in a previous pass, - then we only need to read its .hi file from disk and - link it to produce a 'ModDetails'. + then we only need to read its .hi file from disk and + link it to produce a 'ModDetails'. - if a modules is not stable, we will definitely be at least re-linking, and possibly re-compiling it during the 'upsweep'. @@ -544,11 +544,11 @@ unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' -} checkStability - :: HomePackageTable -- HPT from last compilation - -> [SCC ModSummary] -- current module graph (cyclic) - -> [ModuleName] -- all home modules - -> ([ModuleName], -- stableObject - [ModuleName]) -- stableBCO + :: HomePackageTable -- HPT from last compilation + -> [SCC ModSummary] -- current module graph (cyclic) + -> [ModuleName] -- all home modules + -> ([ModuleName], -- stableObject + [ModuleName]) -- stableBCO checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs where @@ -557,49 +557,49 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs | stableBCOs = (stable_obj, scc_mods ++ stable_bco) | otherwise = (stable_obj, stable_bco) where - scc = flattenSCC scc0 - scc_mods = map ms_mod_name scc - home_module m = m `elem` all_home_mods && m `notElem` scc_mods + scc = flattenSCC scc0 + scc_mods = map ms_mod_name scc + home_module m = m `elem` all_home_mods && m `notElem` scc_mods scc_allimps = nub (filter home_module (concatMap ms_home_allimps scc)) - -- all imports outside the current SCC, but in the home pkg - - stable_obj_imps = map (`elem` stable_obj) scc_allimps - stable_bco_imps = map (`elem` stable_bco) scc_allimps - - stableObjects = - and stable_obj_imps - && all object_ok scc - - stableBCOs = - and (zipWith (||) stable_obj_imps stable_bco_imps) - && all bco_ok scc - - object_ok ms - | Just t <- ms_obj_date ms = t >= ms_hs_date ms - && same_as_prev t - | otherwise = False - where - same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of - Just hmi | Just l <- hm_linkable hmi - -> isObjectLinkable l && t == linkableTime l - _other -> True - -- why '>=' rather than '>' above? If the filesystem stores - -- times to the nearset second, we may occasionally find that - -- the object & source have the same modification time, - -- especially if the source was automatically generated - -- and compiled. Using >= is slightly unsafe, but it matches - -- make's behaviour. + -- all imports outside the current SCC, but in the home pkg + + stable_obj_imps = map (`elem` stable_obj) scc_allimps + stable_bco_imps = map (`elem` stable_bco) scc_allimps + + stableObjects = + and stable_obj_imps + && all object_ok scc + + stableBCOs = + and (zipWith (||) stable_obj_imps stable_bco_imps) + && all bco_ok scc + + object_ok ms + | Just t <- ms_obj_date ms = t >= ms_hs_date ms + && same_as_prev t + | otherwise = False + where + same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of + Just hmi | Just l <- hm_linkable hmi + -> isObjectLinkable l && t == linkableTime l + _other -> True + -- why '>=' rather than '>' above? If the filesystem stores + -- times to the nearset second, we may occasionally find that + -- the object & source have the same modification time, + -- especially if the source was automatically generated + -- and compiled. Using >= is slightly unsafe, but it matches + -- make's behaviour. -- -- But see #5527, where someone ran into this and it caused -- a problem. - bco_ok ms - = case lookupUFM hpt (ms_mod_name ms) of - Just hmi | Just l <- hm_linkable hmi -> - not (isObjectLinkable l) && - linkableTime l >= ms_hs_date ms - _other -> False + bco_ok ms + = case lookupUFM hpt (ms_mod_name ms) of + Just hmi | Just l <- hm_linkable hmi -> + not (isObjectLinkable l) && + linkableTime l >= ms_hs_date ms + _other -> False -- ----------------------------------------------------------------------------- @@ -612,10 +612,10 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs upsweep :: GhcMonad m - => HomePackageTable -- ^ HPT from last time round (pruned) + => HomePackageTable -- ^ HPT from last time round (pruned) -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability) -> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files - -> [SCC ModSummary] -- ^ Mods to do (the worklist) + -> [SCC ModSummary] -- ^ Mods to do (the worklist) -> m (SuccessFlag, [ModSummary]) -- ^ Returns: @@ -642,8 +642,8 @@ upsweep old_hpt stable_mods cleanup sccs = do upsweep' old_hpt done (AcyclicSCC mod:mods) mod_index nmods = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++ - -- show (map (moduleUserString.moduleName.mi_module.hm_iface) - -- (moduleEnvElts (hsc_HPT hsc_env))) + -- show (map (moduleUserString.moduleName.mi_module.hm_iface) + -- (moduleEnvElts (hsc_HPT hsc_env))) let logger _mod = defaultWarnErrLogger hsc_env <- getSession @@ -662,21 +662,21 @@ upsweep old_hpt stable_mods cleanup sccs = do case mb_mod_info of Nothing -> return (Failed, done) Just mod_info -> do - let this_mod = ms_mod_name mod - - -- Add new info to hsc_env - hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info - hsc_env1 = hsc_env { hsc_HPT = hpt1 } - - -- Space-saving: delete the old HPT entry - -- for mod BUT if mod is a hs-boot - -- node, don't delete it. For the - -- interface, the HPT entry is probaby for the - -- main Haskell source file. Deleting it - -- would force the real module to be recompiled + let this_mod = ms_mod_name mod + + -- Add new info to hsc_env + hpt1 = addToUFM (hsc_HPT hsc_env) this_mod mod_info + hsc_env1 = hsc_env { hsc_HPT = hpt1 } + + -- Space-saving: delete the old HPT entry + -- for mod BUT if mod is a hs-boot + -- node, don't delete it. For the + -- interface, the HPT entry is probaby for the + -- main Haskell source file. Deleting it + -- would force the real module to be recompiled -- every time. - old_hpt1 | isBootSummary mod = old_hpt - | otherwise = delFromUFM old_hpt this_mod + old_hpt1 | isBootSummary mod = old_hpt + | otherwise = delFromUFM old_hpt this_mod done' = mod:done @@ -685,13 +685,13 @@ upsweep old_hpt stable_mods cleanup sccs = do hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done' setSession hsc_env2 - upsweep' old_hpt1 done' mods (mod_index+1) nmods + upsweep' old_hpt1 done' mods (mod_index+1) nmods -- | Compile a single module. Always produce a Linkable for it if -- successful. If no compilation happened, return the old Linkable. upsweep_mod :: HscEnv -> HomePackageTable - -> ([ModuleName],[ModuleName]) + -> ([ModuleName],[ModuleName]) -> ModSummary -> Int -- index of module -> Int -- total number of modules @@ -699,16 +699,16 @@ upsweep_mod :: HscEnv upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods = let - this_mod_name = ms_mod_name summary - this_mod = ms_mod summary - mb_obj_date = ms_obj_date summary - obj_fn = ml_obj_file (ms_location summary) - hs_date = ms_hs_date summary + this_mod_name = ms_mod_name summary + this_mod = ms_mod summary + mb_obj_date = ms_obj_date summary + obj_fn = ml_obj_file (ms_location summary) + hs_date = ms_hs_date summary - is_stable_obj = this_mod_name `elem` stable_obj - is_stable_bco = this_mod_name `elem` stable_bco + is_stable_obj = this_mod_name `elem` stable_obj + is_stable_bco = this_mod_name `elem` stable_bco - old_hmi = lookupUFM old_hpt this_mod_name + old_hmi = lookupUFM old_hpt this_mod_name -- We're using the dflags for this module now, obtained by -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas. @@ -729,23 +729,23 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods -- store the corrected hscTarget into the summary summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } } - -- The old interface is ok if - -- a) we're compiling a source file, and the old HPT - -- entry is for a source file - -- b) we're compiling a hs-boot file - -- Case (b) allows an hs-boot file to get the interface of its - -- real source file on the second iteration of the compilation - -- manager, but that does no harm. Otherwise the hs-boot file - -- will always be recompiled + -- The old interface is ok if + -- a) we're compiling a source file, and the old HPT + -- entry is for a source file + -- b) we're compiling a hs-boot file + -- Case (b) allows an hs-boot file to get the interface of its + -- real source file on the second iteration of the compilation + -- manager, but that does no harm. Otherwise the hs-boot file + -- will always be recompiled mb_old_iface - = case old_hmi of - Nothing -> Nothing - Just hm_info | isBootSummary summary -> Just iface - | not (mi_boot iface) -> Just iface - | otherwise -> Nothing - where - iface = hm_iface hm_info + = case old_hmi of + Nothing -> Nothing + Just hm_info | isBootSummary summary -> Just iface + | not (mi_boot iface) -> Just iface + | otherwise -> Nothing + where + iface = hm_iface hm_info compile_it :: Maybe Linkable -> SourceModified -> IO HomeModInfo compile_it mb_linkable src_modified = @@ -850,9 +850,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable retainInTopLevelEnvs keep_these hpt = listToUFM [ (mod, expectJust "retain" mb_mod_info) - | mod <- keep_these - , let mb_mod_info = lookupUFM hpt mod - , isJust mb_mod_info ] + | mod <- keep_these + , let mb_mod_info = lookupUFM hpt mod + , isJust mb_mod_info ] -- --------------------------------------------------------------------------- -- Typecheck module loops @@ -929,12 +929,12 @@ reachableBackwards mod summaries type SummaryNode = (ModSummary, Int, [Int]) topSortModuleGraph - :: Bool + :: Bool -- ^ Drop hi-boot nodes? (see below) - -> [ModSummary] - -> Maybe ModuleName + -> [ModSummary] + -> Maybe ModuleName -- ^ Root module name. If @Nothing@, use the full graph. - -> [SCC ModSummary] + -> [SCC ModSummary] -- ^ Calculate SCCs of the module graph, possibly dropping the hi-boot nodes -- The resulting list of strongly-connected-components is in topologically -- sorted order, starting with the module(s) at the bottom of the @@ -943,12 +943,12 @@ topSortModuleGraph -- -- Drop hi-boot nodes (first boolean arg)? -- --- - @False@: treat the hi-boot summaries as nodes of the graph, --- so the graph must be acyclic +-- - @False@: treat the hi-boot summaries as nodes of the graph, +-- so the graph must be acyclic -- --- - @True@: eliminate the hi-boot nodes, and instead pretend --- the a source-import of Foo is an import of Foo --- The resulting graph has no hi-boot nodes, but can be cyclic +-- - @True@: eliminate the hi-boot nodes, and instead pretend +-- the a source-import of Foo is an import of Foo +-- The resulting graph has no hi-boot nodes, but can be cyclic topSortModuleGraph drop_hs_boot_nodes summaries mb_root_mod = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph @@ -1022,14 +1022,14 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are -type NodeMap a = Map.Map NodeKey a -- keyed by (mod, src_file_type) pairs +type NodeMap a = Map.Map NodeKey a -- keyed by (mod, src_file_type) pairs msKey :: ModSummary -> NodeKey msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot) mkNodeMap :: [ModSummary] -> NodeMap ModSummary mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries] - + nodeMapElts :: NodeMap a -> [a] nodeMapElts = Map.elems @@ -1041,15 +1041,15 @@ warnUnnecessarySourceImports :: GhcMonad m => [SCC ModSummary] -> m () warnUnnecessarySourceImports sccs = do logWarnings (listToBag (concatMap (check.flattenSCC) sccs)) where check ms = - let mods_in_this_cycle = map ms_mod_name ms in - [ warn i | m <- ms, i <- ms_home_srcimps m, - unLoc i `notElem` mods_in_this_cycle ] + let mods_in_this_cycle = map ms_mod_name ms in + [ warn i | m <- ms, i <- ms_home_srcimps m, + unLoc i `notElem` mods_in_this_cycle ] - warn :: Located ModuleName -> WarnMsg - warn (L loc mod) = - mkPlainErrMsg loc - (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ") - <+> quotes (ppr mod)) + warn :: Located ModuleName -> WarnMsg + warn (L loc mod) = + mkPlainErrMsg loc + (ptext (sLit "Warning: {-# SOURCE #-} unnecessary in import of ") + <+> quotes (ppr mod)) ----------------------------------------------------------------------------- -- Downsweep (dependency analysis) @@ -1067,16 +1067,16 @@ warnUnnecessarySourceImports sccs = do -- are all there, including the imports of non-home-package modules. downsweep :: HscEnv - -> [ModSummary] -- Old summaries - -> [ModuleName] -- Ignore dependencies on these; treat - -- them as if they were package modules - -> Bool -- True <=> allow multiple targets to have - -- the same module name; this is - -- very useful for ghc -M - -> IO [ModSummary] - -- The elts of [ModSummary] all have distinct - -- (Modules, IsBoot) identifiers, unless the Bool is true - -- in which case there can be repeats + -> [ModSummary] -- Old summaries + -> [ModuleName] -- Ignore dependencies on these; treat + -- them as if they were package modules + -> Bool -- True <=> allow multiple targets to have + -- the same module name; this is + -- very useful for ghc -M + -> IO [ModSummary] + -- The elts of [ModSummary] all have distinct + -- (Modules, IsBoot) identifiers, unless the Bool is true + -- in which case there can be repeats downsweep hsc_env old_summaries excl_mods allow_dup_roots = do rootSummaries <- mapM getRootSummary roots @@ -1085,67 +1085,67 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots summs <- loop (concatMap msDeps rootSummaries) root_map return summs where - roots = hsc_targets hsc_env + roots = hsc_targets hsc_env - old_summary_map :: NodeMap ModSummary - old_summary_map = mkNodeMap old_summaries + old_summary_map :: NodeMap ModSummary + old_summary_map = mkNodeMap old_summaries - getRootSummary :: Target -> IO ModSummary - getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) - = do exists <- liftIO $ doesFileExist file - if exists - then summariseFile hsc_env old_summaries file mb_phase + getRootSummary :: Target -> IO ModSummary + getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf) + = do exists <- liftIO $ doesFileExist file + if exists + then summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf - else throwOneError $ mkPlainErrMsg noSrcSpan $ - text "can't find file:" <+> text file - getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf) - = do maybe_summary <- summariseModule hsc_env old_summary_map False - (L rootLoc modl) obj_allowed + else throwOneError $ mkPlainErrMsg noSrcSpan $ + text "can't find file:" <+> text file + getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf) + = do maybe_summary <- summariseModule hsc_env old_summary_map False + (L rootLoc modl) obj_allowed maybe_buf excl_mods - case maybe_summary of - Nothing -> packageModErr modl - Just s -> return s - - rootLoc = mkGeneralSrcSpan (fsLit "") - - -- In a root module, the filename is allowed to diverge from the module - -- name, so we have to check that there aren't multiple root files - -- defining the same module (otherwise the duplicates will be silently - -- ignored, leading to confusing behaviour). - checkDuplicates :: NodeMap [ModSummary] -> IO () - checkDuplicates root_map - | allow_dup_roots = return () - | null dup_roots = return () - | otherwise = liftIO $ multiRootsErr (head dup_roots) - where - dup_roots :: [[ModSummary]] -- Each at least of length 2 - dup_roots = filterOut isSingleton (nodeMapElts root_map) - - loop :: [(Located ModuleName,IsBootInterface)] - -- Work list: process these modules - -> NodeMap [ModSummary] - -- Visited set; the range is a list because - -- the roots can have the same module names - -- if allow_dup_roots is True - -> IO [ModSummary] - -- The result includes the worklist, except - -- for those mentioned in the visited set - loop [] done = return (concat (nodeMapElts done)) - loop ((wanted_mod, is_boot) : ss) done - | Just summs <- Map.lookup key done - = if isSingleton summs then - loop ss done - else - do { multiRootsErr summs; return [] } - | otherwise + case maybe_summary of + Nothing -> packageModErr modl + Just s -> return s + + rootLoc = mkGeneralSrcSpan (fsLit "") + + -- In a root module, the filename is allowed to diverge from the module + -- name, so we have to check that there aren't multiple root files + -- defining the same module (otherwise the duplicates will be silently + -- ignored, leading to confusing behaviour). + checkDuplicates :: NodeMap [ModSummary] -> IO () + checkDuplicates root_map + | allow_dup_roots = return () + | null dup_roots = return () + | otherwise = liftIO $ multiRootsErr (head dup_roots) + where + dup_roots :: [[ModSummary]] -- Each at least of length 2 + dup_roots = filterOut isSingleton (nodeMapElts root_map) + + loop :: [(Located ModuleName,IsBootInterface)] + -- Work list: process these modules + -> NodeMap [ModSummary] + -- Visited set; the range is a list because + -- the roots can have the same module names + -- if allow_dup_roots is True + -> IO [ModSummary] + -- The result includes the worklist, except + -- for those mentioned in the visited set + loop [] done = return (concat (nodeMapElts done)) + loop ((wanted_mod, is_boot) : ss) done + | Just summs <- Map.lookup key done + = if isSingleton summs then + loop ss done + else + do { multiRootsErr summs; return [] } + | otherwise = do mb_s <- summariseModule hsc_env old_summary_map is_boot wanted_mod True Nothing excl_mods case mb_s of Nothing -> loop ss done Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done) - where - key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile) + where + key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile) -- XXX Does the (++) here need to be flipped? mkRootMap :: [ModSummary] -> NodeMap [ModSummary] @@ -1156,15 +1156,15 @@ mkRootMap summaries = Map.insertListWith (flip (++)) msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)] -- (msDeps s) returns the dependencies of the ModSummary s. -- A wrinkle is that for a {-# SOURCE #-} import we return --- *both* the hs-boot file --- *and* the source file +-- *both* the hs-boot file +-- *and* the source file -- as "dependencies". That ensures that the list of all relevant -- modules always contains B.hs if it contains B.hs-boot. -- Remember, this pass isn't doing the topological sort. It's -- just gathering the list of all relevant ModSummaries msDeps s = concat [ [(m,True), (m,False)] | m <- ms_home_srcimps s ] - ++ [ (m,False) | m <- ms_home_imps s ] + ++ [ (m,False) | m <- ms_home_imps s ] home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName] home_imps imps = [ ideclName i | L _ i <- imps, isLocal (ideclPkgQual i) ] @@ -1187,107 +1187,107 @@ ms_home_imps = home_imps . ms_imps -- We have two types of summarisation: -- -- * Summarise a file. This is used for the root module(s) passed to --- cmLoadModules. The file is read, and used to determine the root --- module name. The module name may differ from the filename. +-- cmLoadModules. The file is read, and used to determine the root +-- module name. The module name may differ from the filename. -- -- * Summarise a module. We are given a module name, and must provide --- a summary. The finder is used to locate the file in which the module --- resides. +-- a summary. The finder is used to locate the file in which the module +-- resides. summariseFile - :: HscEnv - -> [ModSummary] -- old summaries - -> FilePath -- source file name - -> Maybe Phase -- start phase + :: HscEnv + -> [ModSummary] -- old summaries + -> FilePath -- source file name + -> Maybe Phase -- start phase -> Bool -- object code allowed? - -> Maybe (StringBuffer,ClockTime) - -> IO ModSummary + -> Maybe (StringBuffer,ClockTime) + -> IO ModSummary summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf - -- we can use a cached summary if one is available and the - -- source file hasn't changed, But we have to look up the summary - -- by source file, rather than module name as we do in summarise. + -- we can use a cached summary if one is available and the + -- source file hasn't changed, But we have to look up the summary + -- by source file, rather than module name as we do in summarise. | Just old_summary <- findSummaryBySourceFile old_summaries file = do - let location = ms_location old_summary - - -- return the cached summary if the source didn't change - src_timestamp <- case maybe_buf of - Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file - -- The file exists; we checked in getRootSummary above. - -- If it gets removed subsequently, then this - -- getModificationTime may fail, but that's the right - -- behaviour. - - if ms_hs_date old_summary == src_timestamp - then do -- update the object-file timestamp - obj_timestamp <- + let location = ms_location old_summary + + -- return the cached summary if the source didn't change + src_timestamp <- case maybe_buf of + Just (_,t) -> return t + Nothing -> liftIO $ getModificationTime file + -- The file exists; we checked in getRootSummary above. + -- If it gets removed subsequently, then this + -- getModificationTime may fail, but that's the right + -- behaviour. + + if ms_hs_date old_summary == src_timestamp + then do -- update the object-file timestamp + obj_timestamp <- if isObjectTarget (hscTarget (hsc_dflags hsc_env)) || obj_allowed -- bug #1205 then liftIO $ getObjTimestamp location False else return Nothing - return old_summary{ ms_obj_date = obj_timestamp } - else - new_summary + return old_summary{ ms_obj_date = obj_timestamp } + else + new_summary | otherwise = new_summary where new_summary = do - let dflags = hsc_dflags hsc_env + let dflags = hsc_dflags hsc_env - (dflags', hspp_fn, buf) - <- preprocessFile hsc_env file mb_phase maybe_buf + (dflags', hspp_fn, buf) + <- preprocessFile hsc_env file mb_phase maybe_buf (srcimps,the_imps, L _ mod_name) <- getImports dflags' buf hspp_fn file - -- Make a ModLocation for this file - location <- liftIO $ mkHomeModLocation dflags mod_name file + -- Make a ModLocation for this file + location <- liftIO $ mkHomeModLocation dflags mod_name file - -- Tell the Finder cache where it is, so that subsequent calls - -- to findModule will find it, even if it's not on any search path - mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location + -- Tell the Finder cache where it is, so that subsequent calls + -- to findModule will find it, even if it's not on any search path + mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location src_timestamp <- case maybe_buf of - Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file - -- getMofificationTime may fail + Just (_,t) -> return t + Nothing -> liftIO $ getModificationTime file + -- getMofificationTime may fail -- when the user asks to load a source file by name, we only -- use an object file if -fobject-code is on. See #1205. - obj_timestamp <- + obj_timestamp <- if isObjectTarget (hscTarget (hsc_dflags hsc_env)) || obj_allowed -- bug #1205 then liftIO $ modificationTimeIfExists (ml_obj_file location) else return Nothing return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile, - ms_location = location, + ms_location = location, ms_hspp_file = hspp_fn, ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, + ms_hspp_buf = Just buf, ms_srcimps = srcimps, ms_textual_imps = the_imps, - ms_hs_date = src_timestamp, - ms_obj_date = obj_timestamp }) + ms_hs_date = src_timestamp, + ms_obj_date = obj_timestamp }) findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary findSummaryBySourceFile summaries file = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms], - expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of - [] -> Nothing - (x:_) -> Just x + expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of + [] -> Nothing + (x:_) -> Just x -- Summarise a module, and pick up source and timestamp. summariseModule - :: HscEnv - -> NodeMap ModSummary -- Map of old summaries - -> IsBootInterface -- True <=> a {-# SOURCE #-} import - -> Located ModuleName -- Imported module to be summarised + :: HscEnv + -> NodeMap ModSummary -- Map of old summaries + -> IsBootInterface -- True <=> a {-# SOURCE #-} import + -> Located ModuleName -- Imported module to be summarised -> Bool -- object code allowed? - -> Maybe (StringBuffer, ClockTime) - -> [ModuleName] -- Modules to exclude - -> IO (Maybe ModSummary) -- Its new summary + -> Maybe (StringBuffer, ClockTime) + -> [ModuleName] -- Modules to exclude + -> IO (Maybe ModSummary) -- Its new summary summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) obj_allowed maybe_buf excl_mods @@ -1295,22 +1295,22 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) = return Nothing | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map - = do -- Find its new timestamp; all the - -- ModSummaries in the old map have valid ml_hs_files - let location = ms_location old_summary - src_fn = expectJust "summariseModule" (ml_hs_file location) - - -- check the modification time on the source file, and - -- return the cached summary if it hasn't changed. If the - -- file has disappeared, we need to call the Finder again. - case maybe_buf of - Just (_,t) -> check_timestamp old_summary location src_fn t - Nothing -> do - m <- tryIO (getModificationTime src_fn) - case m of - Right t -> check_timestamp old_summary location src_fn t - Left e | isDoesNotExistError e -> find_it - | otherwise -> ioError e + = do -- Find its new timestamp; all the + -- ModSummaries in the old map have valid ml_hs_files + let location = ms_location old_summary + src_fn = expectJust "summariseModule" (ml_hs_file location) + + -- check the modification time on the source file, and + -- return the cached summary if it hasn't changed. If the + -- file has disappeared, we need to call the Finder again. + case maybe_buf of + Just (_,t) -> check_timestamp old_summary location src_fn t + Nothing -> do + m <- tryIO (getModificationTime src_fn) + case m of + Right t -> check_timestamp old_summary location src_fn t + Left e | isDoesNotExistError e -> find_it + | otherwise -> ioError e | otherwise = find_it where @@ -1319,89 +1319,89 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) hsc_src = if is_boot then HsBootFile else HsSrcFile check_timestamp old_summary location src_fn src_timestamp - | ms_hs_date old_summary == src_timestamp = do - -- update the object-file timestamp + | ms_hs_date old_summary == src_timestamp = do + -- update the object-file timestamp obj_timestamp <- if isObjectTarget (hscTarget (hsc_dflags hsc_env)) || obj_allowed -- bug #1205 then getObjTimestamp location is_boot else return Nothing - return (Just old_summary{ ms_obj_date = obj_timestamp }) - | otherwise = - -- source changed: re-summarise. - new_summary location (ms_mod old_summary) src_fn src_timestamp + return (Just old_summary{ ms_obj_date = obj_timestamp }) + | otherwise = + -- source changed: re-summarise. + new_summary location (ms_mod old_summary) src_fn src_timestamp find_it = do - -- Don't use the Finder's cache this time. If the module was - -- previously a package module, it may have now appeared on the - -- search path, so we want to consider it to be a home module. If - -- the module was previously a home module, it may have moved. - uncacheModule hsc_env wanted_mod - found <- findImportedModule hsc_env wanted_mod Nothing - case found of - Found location mod - | isJust (ml_hs_file location) -> - -- Home package - just_found location mod - | otherwise -> - -- Drop external-pkg - ASSERT(modulePackageId mod /= thisPackage dflags) - return Nothing - - err -> noModError dflags loc wanted_mod err - -- Not found + -- Don't use the Finder's cache this time. If the module was + -- previously a package module, it may have now appeared on the + -- search path, so we want to consider it to be a home module. If + -- the module was previously a home module, it may have moved. + uncacheModule hsc_env wanted_mod + found <- findImportedModule hsc_env wanted_mod Nothing + case found of + Found location mod + | isJust (ml_hs_file location) -> + -- Home package + just_found location mod + | otherwise -> + -- Drop external-pkg + ASSERT(modulePackageId mod /= thisPackage dflags) + return Nothing + + err -> noModError dflags loc wanted_mod err + -- Not found just_found location mod = do - -- Adjust location to point to the hs-boot source file, - -- hi file, object file, when is_boot says so - let location' | is_boot = addBootSuffixLocn location - | otherwise = location - src_fn = expectJust "summarise2" (ml_hs_file location') + -- Adjust location to point to the hs-boot source file, + -- hi file, object file, when is_boot says so + let location' | is_boot = addBootSuffixLocn location + | otherwise = location + src_fn = expectJust "summarise2" (ml_hs_file location') - -- Check that it exists - -- It might have been deleted since the Finder last found it - maybe_t <- modificationTimeIfExists src_fn - case maybe_t of - Nothing -> noHsFileErr loc src_fn - Just t -> new_summary location' mod src_fn t + -- Check that it exists + -- It might have been deleted since the Finder last found it + maybe_t <- modificationTimeIfExists src_fn + case maybe_t of + Nothing -> noHsFileErr loc src_fn + Just t -> new_summary location' mod src_fn t new_summary location mod src_fn src_timestamp = do - -- Preprocess the source file and get its imports - -- The dflags' contains the OPTIONS pragmas - (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf + -- Preprocess the source file and get its imports + -- The dflags' contains the OPTIONS pragmas + (dflags', hspp_fn, buf) <- preprocessFile hsc_env src_fn Nothing maybe_buf (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn src_fn - when (mod_name /= wanted_mod) $ - throwOneError $ mkPlainErrMsg mod_loc $ - text "File name does not match module name:" - $$ text "Saw:" <+> quotes (ppr mod_name) + when (mod_name /= wanted_mod) $ + throwOneError $ mkPlainErrMsg mod_loc $ + text "File name does not match module name:" + $$ text "Saw:" <+> quotes (ppr mod_name) $$ text "Expected:" <+> quotes (ppr wanted_mod) - -- Find the object timestamp, and return the summary - obj_timestamp <- + -- Find the object timestamp, and return the summary + obj_timestamp <- if isObjectTarget (hscTarget (hsc_dflags hsc_env)) || obj_allowed -- bug #1205 then getObjTimestamp location is_boot else return Nothing - return (Just (ModSummary { ms_mod = mod, - ms_hsc_src = hsc_src, - ms_location = location, - ms_hspp_file = hspp_fn, + return (Just (ModSummary { ms_mod = mod, + ms_hsc_src = hsc_src, + ms_location = location, + ms_hspp_file = hspp_fn, ms_hspp_opts = dflags', - ms_hspp_buf = Just buf, - ms_srcimps = srcimps, - ms_textual_imps = the_imps, - ms_hs_date = src_timestamp, - ms_obj_date = obj_timestamp })) + ms_hspp_buf = Just buf, + ms_srcimps = srcimps, + ms_textual_imps = the_imps, + ms_hs_date = src_timestamp, + ms_obj_date = obj_timestamp })) getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime) getObjTimestamp location is_boot = if is_boot then return Nothing - else modificationTimeIfExists (ml_obj_file location) + else modificationTimeIfExists (ml_obj_file location) preprocessFile :: HscEnv @@ -1411,43 +1411,43 @@ preprocessFile :: HscEnv -> IO (DynFlags, FilePath, StringBuffer) preprocessFile hsc_env src_fn mb_phase Nothing = do - (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase) - buf <- hGetStringBuffer hspp_fn - return (dflags', hspp_fn, buf) + (dflags', hspp_fn) <- preprocess hsc_env (src_fn, mb_phase) + buf <- hGetStringBuffer hspp_fn + return (dflags', hspp_fn, buf) preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) = do let dflags = hsc_dflags hsc_env - let local_opts = getOptions dflags buf src_fn + let local_opts = getOptions dflags buf src_fn - (dflags', leftovers, warns) + (dflags', leftovers, warns) <- parseDynamicFilePragma dflags local_opts checkProcessArgsResult leftovers handleFlagWarnings dflags' warns - let needs_preprocessing - | Just (Unlit _) <- mb_phase = True - | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True - -- note: local_opts is only required if there's no Unlit phase - | xopt Opt_Cpp dflags' = True - | dopt Opt_Pp dflags' = True - | otherwise = False + let needs_preprocessing + | Just (Unlit _) <- mb_phase = True + | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True + -- note: local_opts is only required if there's no Unlit phase + | xopt Opt_Cpp dflags' = True + | dopt Opt_Pp dflags' = True + | otherwise = False - when needs_preprocessing $ - ghcError (ProgramError "buffer needs preprocesing; interactive check disabled") + when needs_preprocessing $ + ghcError (ProgramError "buffer needs preprocesing; interactive check disabled") - return (dflags', src_fn, buf) + return (dflags', src_fn, buf) ----------------------------------------------------------------------------- --- Error messages +-- Error messages ----------------------------------------------------------------------------- noModError :: DynFlags -> SrcSpan -> ModuleName -> FindResult -> IO ab -- ToDo: we don't have a proper line number for this error noModError dflags loc wanted_mod err = throwOneError $ mkPlainErrMsg loc $ cannotFindModule dflags wanted_mod err - + noHsFileErr :: SrcSpan -> String -> IO a noHsFileErr loc path = throwOneError $ mkPlainErrMsg loc $ text "Can't find" <+> text path @@ -1455,15 +1455,15 @@ noHsFileErr loc path packageModErr :: ModuleName -> IO a packageModErr mod = throwOneError $ mkPlainErrMsg noSrcSpan $ - text "module" <+> quotes (ppr mod) <+> text "is a package module" + text "module" <+> quotes (ppr mod) <+> text "is a package module" multiRootsErr :: [ModSummary] -> IO () multiRootsErr [] = panic "multiRootsErr" multiRootsErr summs@(summ1:_) = throwOneError $ mkPlainErrMsg noSrcSpan $ - text "module" <+> quotes (ppr mod) <+> - text "is defined in multiple files:" <+> - sep (map text files) + text "module" <+> quotes (ppr mod) <+> + text "is defined in multiple files:" <+> + sep (map text files) where mod = ms_mod summ1 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs @@ -1498,5 +1498,5 @@ cyclicModuleErr mss ppr_ms :: ModSummary -> SDoc ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+> - (parens (text (msHsFilePath ms))) + (parens (text (msHsFilePath ms))) -- cgit v1.2.1