X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcompMan%2FCompManager.lhs;h=16ba8d5dd0f4f834872d149c3c2646f31be46ff9;hb=805924ab8715c429c48fedc7fc0b3a498d4d3933;hp=bb08b7b6ec5819fabda9f5ff5786151d9e4614e1;hpb=e663f7b8508aac0df712250bee90488429fcbad6;p=ghc-hetmet.git diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index bb08b7b..16ba8d5 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -4,7 +4,7 @@ \section[CompManager]{The Compilation Manager} \begin{code} -module CompManager ( cmInit, cmLoadModule, +module CompManager ( cmInit, cmLoadModule, cmUnload, #ifdef GHCI cmGetExpr, cmRunExpr, #endif @@ -17,36 +17,33 @@ where import CmLink import CmTypes import HscTypes -import Module ( ModuleName, moduleName, - isHomeModule, moduleEnvElts, - moduleNameUserString ) -import CmStaticInfo ( PackageConfigInfo, GhciMode(..) ) +import Module ( Module, ModuleName, moduleName, isHomeModule, + mkHomeModule, mkModuleName, moduleNameUserString ) +import CmStaticInfo ( GhciMode(..) ) import DriverPipeline import GetImports import HscTypes ( HomeSymbolTable, HomeIfaceTable, PersistentCompilerState, ModDetails(..) ) -import Name ( lookupNameEnv ) -import Module -import PrelNames ( mainName ) import HscMain ( initPersistentCompilerState ) import Finder import UniqFM ( emptyUFM, lookupUFM, addToUFM, delListFromUFM, UniqFM, listToUFM ) import Unique ( Uniquable ) -import Digraph ( SCC(..), stronglyConnComp ) +import Digraph ( SCC(..), stronglyConnComp, flattenSCC ) import DriverFlags ( getDynFlags ) import DriverPhases -import DriverUtil ( BarfKind(..), splitFilename3 ) +import DriverUtil ( splitFilename3 ) import ErrUtils ( showPass ) import Util +import DriverUtil import Outputable -import Panic ( panic ) +import Panic +import CmdLineOpts ( DynFlags(..) ) #ifdef GHCI -import CmdLineOpts ( DynFlags(..) ) import Interpreter ( HValue ) import HscMain ( hscExpr ) -import RdrName +import Type ( Type ) import PrelGHC ( unsafeCoerce# ) #endif @@ -59,29 +56,31 @@ import Directory ( getModificationTime, doesFileExist ) import IO import Monad import List ( nub ) -import Maybe ( catMaybes, fromMaybe, isJust ) +import Maybe ( catMaybes, fromMaybe, maybeToList ) \end{code} \begin{code} -cmInit :: PackageConfigInfo -> GhciMode -> IO CmState -cmInit raw_package_info gmode - = emptyCmState raw_package_info gmode +cmInit :: GhciMode -> IO CmState +cmInit gmode + = emptyCmState gmode #ifdef GHCI cmGetExpr :: CmState -> DynFlags -> ModuleName -> String - -> IO (CmState, Maybe HValue) -cmGetExpr cmstate dflags modname expr - = do (new_pcs, maybe_unlinked_iexpr) <- - hscExpr dflags hst hit pcs (mkHomeModule modname) expr - case maybe_unlinked_iexpr of + -> Bool + -> IO (CmState, Maybe (HValue, PrintUnqualified, Type)) +cmGetExpr cmstate dflags modname expr wrap_print + = do (new_pcs, maybe_stuff) <- + hscExpr dflags hst hit pcs (mkHomeModule modname) expr wrap_print + case maybe_stuff of Nothing -> return (cmstate{ pcs=new_pcs }, Nothing) - Just uiexpr -> do - hValue <- linkExpr pls uiexpr - return (cmstate{ pcs=new_pcs }, Just hValue) + Just (bcos, print_unqual, ty) -> do + hValue <- linkExpr pls bcos + return (cmstate{ pcs=new_pcs }, + Just (hValue, print_unqual, ty)) -- ToDo: check that the module we passed in is sane/exists? where @@ -102,15 +101,14 @@ data PersistentCMState hit :: HomeIfaceTable, -- home interface table ui :: UnlinkedImage, -- the unlinked images mg :: ModuleGraph, -- the module graph - pci :: PackageConfigInfo, -- NEVER CHANGES gmode :: GhciMode -- NEVER CHANGES } -emptyPCMS :: PackageConfigInfo -> GhciMode -> PersistentCMState -emptyPCMS pci gmode +emptyPCMS :: GhciMode -> PersistentCMState +emptyPCMS gmode = PersistentCMState { hst = emptyHST, hit = emptyHIT, ui = emptyUI, mg = emptyMG, - pci = pci, gmode = gmode } + gmode = gmode } emptyHIT :: HomeIfaceTable emptyHIT = emptyUFM @@ -127,9 +125,9 @@ data CmState pls :: PersistentLinkerState -- link's persistent state } -emptyCmState :: PackageConfigInfo -> GhciMode -> IO CmState -emptyCmState pci gmode - = do let pcms = emptyPCMS pci gmode +emptyCmState :: GhciMode -> IO CmState +emptyCmState gmode + = do let pcms = emptyPCMS gmode pcs <- initPersistentCompilerState pls <- emptyPLS return (CmState { pcms = pcms, @@ -147,6 +145,22 @@ emptyMG = [] \end{code} +Unload the compilation manager's state: everything it knows about the +current collection of modules in the Home package. + +\begin{code} +cmUnload :: CmState -> IO CmState +cmUnload state + = do -- Throw away the old home dir cache + emptyHomeDirCache + -- Throw away the HIT and the HST + return state{ pcms=pcms{ hst=new_hst, hit=new_hit } } + where + CmState{ pcms=pcms } = state + PersistentCMState{ hst=hst, hit=hit } = pcms + (new_hst, new_hit,[]) = retainInTopLevelEnvs [] (hst,hit,[]) +\end{code} + The real business of the compilation manager: given a system state and a module name, try and bring the module up to date, probably changing the system state at the same time. @@ -163,34 +177,35 @@ cmLoadModule cmstate1 rootname let pcms1 = pcms cmstate1 let pls1 = pls cmstate1 let pcs1 = pcs cmstate1 + -- mg1 is the complete (home) set of summaries from the + -- previous pass of cmLoadModule, if there was one. let mg1 = mg pcms1 let hst1 = hst pcms1 let hit1 = hit pcms1 + -- similarly, ui1 is the (complete) set of linkables from + -- the previous pass, if any. let ui1 = ui pcms1 - let pcii = pci pcms1 -- this never changes - let ghci_mode = gmode pcms1 -- ToDo: fix! + let ghci_mode = gmode pcms1 -- this never changes -- Do the downsweep to reestablish the module graph - -- then generate version 2's by removing from HIT,HST,UI any - -- modules in the old MG which are not in the new one. - - -- Throw away the old home dir cache - emptyHomeDirCache + -- then generate version 2's by retaining in HIT,HST,UI a + -- stable set S of modules, as defined below. dflags <- getDynFlags let verb = verbosity dflags showPass dflags "Chasing dependencies" + when (verb >= 1 && ghci_mode == Batch) $ + hPutStrLn stderr (progName ++ ": chasing modules from: " ++ rootname) - mg2unsorted <- downsweep [rootname] + (mg2unsorted, a_root_is_Main) <- downsweep [rootname] + let mg2unsorted_names = map name_of_summary mg2unsorted - let modnames1 = map name_of_summary mg1 - let modnames2 = map name_of_summary mg2unsorted - let mods_to_zap = filter (`notElem` modnames2) modnames1 + -- reachable_from follows source as well as normal imports + let reachable_from :: ModuleName -> [ModuleName] + reachable_from = downwards_closure_of_module mg2unsorted - let (hst2, hit2, ui2) - = removeFromTopLevelEnvs mods_to_zap (hst1, hit1, ui1) -- should be cycle free; ignores 'import source's let mg2 = topological_sort False mg2unsorted -- ... whereas this takes them into account. Used for @@ -198,9 +213,47 @@ cmLoadModule cmstate1 rootname -- upsweep, and for removing from hst/hit all the modules -- not in strict downwards closure, during calls to compile. let mg2_with_srcimps = topological_sort True mg2unsorted - - let reachable_from :: ModuleName -> [ModuleName] - reachable_from = downwards_closure_of_module mg2unsorted + + -- Figure out a stable set of modules which can be retained + -- the top level envs, to avoid upsweeping them. Goes to a + -- bit of trouble to avoid upsweeping module cycles. + -- + -- Construct a set S of stable modules like this: + -- Travel upwards, over the sccified graph. For each scc + -- of modules ms, add ms to S only if: + -- 1. All home imports of ms are either in ms or S + -- 2. All m <- ms satisfy P, where + -- P | interactive = have old summary for m and it indicates + -- that the source is unchanged + -- | batch = linkable exists on disk, and is younger + -- than source. + + (stable_mods, linkables_for_stable_mods) + <- preUpsweep ghci_mode ui1 mg1 mg2unsorted_names [] [] mg2_with_srcimps + let stable_old_summaries + = concatMap (findInSummaries mg1) stable_mods + + when (verb >= 2) $ + putStrLn (showSDoc (text "STABLE MODULES:" + <+> sep (map (text.moduleNameUserString) stable_mods))) + + + let (hst2, hit2, []) + = retainInTopLevelEnvs stable_mods (hst1, hit1, []) + ui2 + = linkables_for_stable_mods + + -- Now hst2, hit2, ui2 now hold the 'reduced system', just the set of + -- modules which are stable. + + -- We could at this point detect cycles which aren't broken by + -- a source-import, and complain immediately, but it seems better + -- to let upsweep_mods do this, so at least some useful work gets + -- done before the upsweep is abandoned. + let upsweep_these + = filter (\scc -> any (`notElem` stable_mods) + (map name_of_summary (flattenSCC scc))) + mg2 --hPutStrLn stderr "after tsort:\n" --hPutStrLn stderr (showSDoc (vcat (map ppr mg2))) @@ -215,16 +268,25 @@ cmLoadModule cmstate1 rootname let threaded2 = CmThreaded pcs1 hst2 hit2 - (upsweep_complete_success, threaded3, modsDone, newLis) - <- upsweep_mods ghci_mode ui2 reachable_from threaded2 mg2 + (upsweep_complete_success, threaded3, modsUpswept, newLis) + <- upsweep_mods ghci_mode dflags ui2 reachable_from + threaded2 upsweep_these let ui3 = add_to_ui ui2 newLis let (CmThreaded pcs3 hst3 hit3) = threaded3 - -- At this point, modsDone and newLis should have the same + -- At this point, modsUpswept and newLis should have the same -- length, so there is one new (or old) linkable for each -- mod which was processed (passed to compile). + -- Make modsDone be the summaries for each home module now + -- available; this should equal the domains of hst3 and hit3. + -- (NOT STRICTLY TRUE if an interactive session was started + -- with some object on disk ???) + -- Get in in a roughly top .. bottom order (hence reverse). + + let modsDone = reverse modsUpswept ++ stable_old_summaries + -- Try and do linking in some form, depending on whether the -- upsweep was completely or only partially successful. @@ -233,21 +295,20 @@ cmLoadModule cmstate1 rootname then -- Easy; just relink it all. do when (verb >= 2) $ - hPutStrLn stderr "Upsweep completely successful." + hPutStrLn stderr "Upsweep completely successful." linkresult - <- link ghci_mode dflags - (any exports_main (moduleEnvElts hst3)) - newLis pls1 + <- link ghci_mode dflags a_root_is_Main ui3 pls1 case linkresult of LinkErrs _ _ -> panic "cmLoadModule: link failed (1)" LinkOK pls3 -> do let pcms3 = PersistentCMState { hst=hst3, hit=hit3, ui=ui3, mg=modsDone, - pci=pcii, gmode=ghci_mode } + gmode=ghci_mode } let cmstate3 = CmState { pcms=pcms3, pcs=pcs3, pls=pls3 } - return (cmstate3, True, map name_of_summary modsDone) + return (cmstate3, True, + map name_of_summary modsDone) else -- Tricky. We need to back out the effects of compiling any @@ -279,10 +340,104 @@ cmLoadModule cmstate1 rootname LinkOK pls4 -> do let pcms4 = PersistentCMState { hst=hst4, hit=hit4, ui=ui4, mg=mods_to_keep, - pci=pcii, gmode=ghci_mode } + gmode=ghci_mode } let cmstate4 = CmState { pcms=pcms4, pcs=pcs3, pls=pls4 } - return (cmstate4, False, mods_to_keep_names) + return (cmstate4, False, + mods_to_keep_names) + + + +-- Do a pre-upsweep without use of "compile", to establish a +-- (downward-closed) set of stable modules which can be retained +-- in the top-level environments. Also return linkables for those +-- modules determined to be stable, since (in Batch mode, at least) +-- there's no other way for them to get into UI. +preUpsweep :: GhciMode + -> [Linkable] -- linkables from previous cmLoadModule pass + -- should be [] in batch mode + -> [ModSummary] -- summaries from previous cmLoadModule pass + -- should be [] in batch mode + -> [ModuleName] -- names of all mods encountered in downsweep + -> [ModuleName] -- accumulating stable modules + -> [Linkable] -- their linkables, in batch mode + -> [SCC ModSummary] -- scc-ified mod graph, including src imps + -> IO ([ModuleName], [Linkable]) + -- stable modules and their linkables + +preUpsweep ghci_mode old_lis old_summaries all_home_mods stable lis [] + = return (stable, lis) +preUpsweep ghci_mode old_lis old_summaries all_home_mods stable lis (scc0:sccs) + = do let scc = flattenSCC scc0 + scc_allhomeimps :: [ModuleName] + scc_allhomeimps + = nub (filter (`elem` all_home_mods) (concatMap ms_allimps scc)) + all_imports_in_scc_or_stable + = all in_stable_or_scc scc_allhomeimps + scc_names + = map name_of_summary scc + in_stable_or_scc m + = --trace (showSDoc (text "ISOS" <+> ppr m <+> ppr scc_names <+> ppr stable)) ( + m `elem` scc_names || m `elem` stable + --) + (all_scc_stable, more_lis) + <- if not all_imports_in_scc_or_stable + then do --putStrLn ("PART1 fail " ++ showSDoc (ppr scc_allhomeimps <+> ppr (filter (not.in_stable_or_scc) scc_allhomeimps))) + return (False, []) + else do bools_n_lis + <- mapM (is_stable ghci_mode old_lis old_summaries) scc + let (bools, liss) = unzip bools_n_lis + --when (not (and bools)) (putStrLn ("PART2 fail: " ++ showSDoc (ppr scc_names))) + return (and bools, concat liss) + if not all_scc_stable + then preUpsweep ghci_mode old_lis old_summaries all_home_mods stable lis sccs + else preUpsweep ghci_mode old_lis old_summaries all_home_mods + (scc_names++stable) (more_lis++lis) sccs + + +-- Helper for preUpsweep. Assuming that new_summary's imports are all +-- stable (in the sense of preUpsweep), determine if new_summary is itself +-- stable, and, if so, in batch mode, return its linkable. +findInSummaries :: [ModSummary] -> ModuleName -> [ModSummary] +findInSummaries old_summaries mod_name + = [s | s <- old_summaries, name_of_summary s == mod_name] + +is_stable :: GhciMode + -> [Linkable] -> [ModSummary] -- OLD lis and summs, in Interactive mode + -> ModSummary -- this module + -> IO (Bool, [Linkable]) + +is_stable Interactive old_lis old_summaries new_summary + -- Only true if the old summary exists and + -- the new source date matches the old one. + = case found_old_summarys of + [] -> return (False, old_linkable) + (old_summary:_) + -> case (ms_hs_date new_summary, ms_hs_date old_summary) of + (Just d1, Just d2) -> return (d1 == d2, old_linkable) + (_, _ ) -> return (False, old_linkable) + where + old_linkable + = maybeToList + (findModuleLinkable_maybe old_lis (name_of_summary new_summary)) + found_old_summarys + = findInSummaries old_summaries (name_of_summary new_summary) + +is_stable Batch [] [] new_summary + -- Only true if we can find a linkable, and it is younger than + -- the source time. + = case ms_hs_date new_summary of + Nothing -> return (False, []) -- no source date (?!) + Just hs_time + -> case ml_obj_file (ms_location new_summary) of + Nothing -> return (False, []) -- no obj filename + Just fn + -> do maybe_li <- maybe_getFileLinkable + (moduleName (ms_mod new_summary)) fn + case maybe_li of + Nothing -> return (False, []) -- no object file on disk + Just li -> return (linkableTime li >= hs_time, [li]) + -- Return (names of) all those in modsDone who are part of a cycle @@ -307,9 +462,9 @@ findPartiallyCompletedCycles modsDone theGraph -- Does this ModDetails export Main.main? -exports_main :: ModDetails -> Bool -exports_main md - = isJust (lookupNameEnv (md_types md) mainName) +--exports_main :: ModDetails -> Bool +--exports_main md +-- = isJust (lookupNameEnv (md_types md) mainName) -- Add the given (LM-form) Linkables to the UI, overwriting previous @@ -336,6 +491,7 @@ data CmThreaded -- stuff threaded through individual module compilations -- Compile multiple modules, stopping as soon as an error appears. -- There better had not be any cyclic groups here -- we check for them. upsweep_mods :: GhciMode + -> DynFlags -> UnlinkedImage -- old linkables -> (ModuleName -> [ModuleName]) -- to construct downward closures -> CmThreaded -- PCS & HST & HIT @@ -346,26 +502,30 @@ upsweep_mods :: GhciMode [ModSummary], -- mods which succeeded [Linkable]) -- new linkables -upsweep_mods ghci_mode oldUI reachable_from threaded +upsweep_mods ghci_mode dflags oldUI reachable_from threaded [] = return (True, threaded, [], []) -upsweep_mods ghci_mode oldUI reachable_from threaded +upsweep_mods ghci_mode dflags oldUI reachable_from threaded ((CyclicSCC ms):_) = do hPutStrLn stderr ("Module imports form a cycle for modules:\n\t" ++ unwords (map (moduleNameUserString.name_of_summary) ms)) return (False, threaded, [], []) -upsweep_mods ghci_mode oldUI reachable_from threaded +upsweep_mods ghci_mode dflags oldUI reachable_from threaded ((AcyclicSCC mod):mods) - = do (threaded1, maybe_linkable) - <- upsweep_mod ghci_mode oldUI threaded mod - (reachable_from (name_of_summary mod)) + = do --case threaded of + -- CmThreaded pcsz hstz hitz + -- -> putStrLn ("UPSWEEP_MOD: hit = " ++ show (map (moduleNameUserString.moduleName.mi_module) (eltsUFM hitz))) + + (threaded1, maybe_linkable) + <- upsweep_mod ghci_mode dflags oldUI threaded mod + (reachable_from (name_of_summary mod)) case maybe_linkable of Just linkable -> -- No errors; do the rest do (restOK, threaded2, modOKs, linkables) - <- upsweep_mods ghci_mode oldUI reachable_from + <- upsweep_mods ghci_mode dflags oldUI reachable_from threaded1 mods return (restOK, threaded2, mod:modOKs, linkable:linkables) Nothing -- we got a compilation error; give up now @@ -390,29 +550,29 @@ maybe_getFileLinkable mod_name obj_fn upsweep_mod :: GhciMode + -> DynFlags -> UnlinkedImage -> CmThreaded -> ModSummary -> [ModuleName] -> IO (CmThreaded, Maybe Linkable) -upsweep_mod ghci_mode oldUI threaded1 summary1 reachable_from_here - = do hPutStr stderr ("ghc: module " - ++ moduleNameUserString (name_of_summary summary1) ++ ": ") +upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_from_here + = do let mod_name = name_of_summary summary1 + let verb = verbosity dflags + + when (verb == 1) $ + if (ghci_mode == Batch) + then hPutStr stderr (progName ++ ": module " + ++ moduleNameUserString mod_name + ++ ": ") + else hPutStr stderr ("Compiling " + ++ moduleNameUserString mod_name + ++ " ... ") + let (CmThreaded pcs1 hst1 hit1) = threaded1 - let old_iface = lookupUFM hit1 (name_of_summary summary1) - - -- We *have* to compile it if we're in batch mode and we can't see - -- a previous linkable for it on disk. - compilation_mandatory - <- if ghci_mode /= Batch then return False - else case ml_obj_file (ms_location summary1) of - Nothing -> do --putStrLn "cmcm: object?!" - return True - Just obj_fn -> do --putStrLn ("cmcm: old obj " ++ obj_fn) - b <- doesFileExist obj_fn - return (not b) + let old_iface = lookupUFM hit1 mod_name let maybe_oldUI_linkable = findModuleLinkable_maybe oldUI mod_name maybe_oldDisk_linkable @@ -441,8 +601,10 @@ upsweep_mod ghci_mode oldUI threaded1 summary1 reachable_from_here source_unchanged = not compilation_mandatory - (hst1_strictDC, hit1_strictDC) - = retainInTopLevelEnvs reachable_from_here (hst1,hit1) + (hst1_strictDC, hit1_strictDC, []) + = retainInTopLevelEnvs + (filter (/= (name_of_summary summary1)) reachable_from_here) + (hst1,hit1,[]) old_linkable = unJust "upsweep_mod:old_linkable" maybe_old_linkable @@ -456,25 +618,42 @@ upsweep_mod ghci_mode oldUI threaded1 summary1 reachable_from_here -- linkable, meaning that compilation wasn't needed, and the -- new details were manufactured from the old iface. CompOK pcs2 new_details new_iface Nothing - -> let hst2 = addToUFM hst1 mod_name new_details - hit2 = addToUFM hit1 mod_name new_iface - threaded2 = CmThreaded pcs2 hst2 hit2 - in return (threaded2, Just old_linkable) + -> do let hst2 = addToUFM hst1 mod_name new_details + hit2 = addToUFM hit1 mod_name new_iface + threaded2 = CmThreaded pcs2 hst2 hit2 + + if ghci_mode == Interactive && verb >= 1 then + -- if we're using an object file, tell the user + case maybe_old_linkable of + Just (LM _ _ objs@(DotO _:_)) + -> do hPutStr stderr (showSDoc (space <> + parens (hsep (text "using": + punctuate comma + [ text o | DotO o <- objs ])))) + when (verb > 1) $ hPutStrLn stderr "" + _ -> return () + else + return () + + when (verb == 1) $ hPutStrLn stderr "" + return (threaded2, Just old_linkable) -- Compilation really did happen, and succeeded. A new -- details, iface and linkable are returned. CompOK pcs2 new_details new_iface (Just new_linkable) - -> let hst2 = addToUFM hst1 mod_name new_details - hit2 = addToUFM hit1 mod_name new_iface - threaded2 = CmThreaded pcs2 hst2 hit2 - in return (threaded2, Just new_linkable) + -> do let hst2 = addToUFM hst1 mod_name new_details + hit2 = addToUFM hit1 mod_name new_iface + threaded2 = CmThreaded pcs2 hst2 hit2 + + when (verb == 1) $ hPutStrLn stderr "" + return (threaded2, Just new_linkable) -- Compilation failed. compile may still have updated -- the PCS, tho. CompErrs pcs2 - -> let threaded2 = CmThreaded pcs2 hst1 hit1 - in return (threaded2, Nothing) - + -> do let threaded2 = CmThreaded pcs2 hst1 hit1 + when (verb == 1) $ hPutStrLn stderr "" + return (threaded2, Nothing) -- Remove unwanted modules from the top level envs (HST, HIT, UI). removeFromTopLevelEnvs :: [ModuleName] @@ -487,11 +666,12 @@ removeFromTopLevelEnvs zap_these (hst, hit, ui) ) retainInTopLevelEnvs :: [ModuleName] - -> (HomeSymbolTable, HomeIfaceTable) - -> (HomeSymbolTable, HomeIfaceTable) -retainInTopLevelEnvs keep_these (hst, hit) + -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage) + -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage) +retainInTopLevelEnvs keep_these (hst, hit, ui) = (retainInUFM hst keep_these, - retainInUFM hit keep_these + retainInUFM hit keep_these, + filterModuleLinkables (`elem` keep_these) ui ) where retainInUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt @@ -504,8 +684,7 @@ retainInTopLevelEnvs keep_these (hst, hit) downwards_closure_of_module :: [ModSummary] -> ModuleName -> [ModuleName] downwards_closure_of_module summaries root = let toEdge :: ModSummary -> (ModuleName,[ModuleName]) - toEdge summ - = (name_of_summary summ, ms_srcimps summ ++ ms_imps summ) + toEdge summ = (name_of_summary summ, ms_allimps summ) res = simple_transitive_closure (map toEdge summaries) [root] in --trace (showSDoc (text "DC of mod" <+> ppr root @@ -553,11 +732,17 @@ topological_sort include_source_imports summaries -- Chase downwards from the specified root set, returning summaries -- for all home modules encountered. Only follow source-import --- links. -downsweep :: [FilePath] -> IO [ModSummary] +-- links. Also returns a Bool to indicate whether any of the roots +-- are module Main. +downsweep :: [FilePath] -> IO ([ModSummary], Bool) downsweep rootNm = do rootSummaries <- mapM getRootSummary rootNm - loop (filter (isHomeModule.ms_mod) rootSummaries) + let a_root_is_Main + = any ((=="Main").moduleNameUserString.name_of_summary) + rootSummaries + all_summaries + <- loop (filter (isHomeModule.ms_mod) rootSummaries) + return (all_summaries, a_root_is_Main) where getRootSummary :: FilePath -> IO ModSummary getRootSummary file