diff options
Diffstat (limited to 'compiler/main/GhcMake.hs')
| -rw-r--r-- | compiler/main/GhcMake.hs | 54 |
1 files changed, 34 insertions, 20 deletions
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 134a0607bc..57af356b38 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -138,9 +138,11 @@ depanal excluded_mods allow_dup_roots = do -- cached finder data. liftIO $ flushFinderCaches hsc_env - mod_graphE <- liftIO $ downsweep hsc_env old_graph + mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph) excluded_mods allow_dup_roots - mod_graph <- reportImportErrors mod_graphE + mod_summaries <- reportImportErrors mod_summariesE + + let mod_graph = mkModuleGraph mod_summaries warnMissingHomeModules hsc_env mod_graph @@ -193,7 +195,7 @@ warnMissingHomeModules hsc_env mod_graph = is_my_target _ _ = False missing = map (moduleName . ms_mod) $ - filter (not . is_known_module) mod_graph + filter (not . is_known_module) (mgModSummaries mod_graph) msg = text "Modules are not listed in command line: " <> sep (map ppr missing) @@ -248,7 +250,7 @@ load' how_much mHscMessage mod_graph = do -- (see msDeps) let all_home_mods = mkUniqSet [ ms_mod_name s - | s <- mod_graph, not (isBootSummary s)] + | s <- mgModSummaries mod_graph, not (isBootSummary s)] -- TODO: Figure out what the correct form of this assert is. It's violated -- when you have HsBootMerge nodes in the graph: then you'll have hs-boot -- files without corresponding hs files. @@ -417,7 +419,7 @@ load' how_much mHscMessage mod_graph = do let no_hs_main = gopt Opt_NoHsMain dflags let main_mod = mainModIs dflags - a_root_is_Main = any ((==main_mod).ms_mod) mod_graph + a_root_is_Main = mgElemModule mod_graph main_mod do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib -- link everything together @@ -538,8 +540,7 @@ guessOutputFile = modifySession $ \env -> !mod_graph = hsc_mod_graph env mainModuleSrcPath :: Maybe String mainModuleSrcPath = do - let isMain = (== mainModIs dflags) . ms_mod - [ms] <- return (filter isMain mod_graph) + ms <- mgLookupModule mod_graph (mainModIs dflags) ml_hs_file (ms_location ms) name = fmap dropExtension mainModuleSrcPath @@ -884,13 +885,15 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do -- The list of all loops in the compilation graph. -- NB: For convenience, the last module of each loop (aka the module that -- finishes the loop) is prepended to the beginning of the loop. - let comp_graph_loops = go (map fstOf3 (reverse comp_graph)) + let comp_graph_loops = go graph where - go [] = [] - go (ms:mss) | Just loop <- getModLoop ms (ms:mss) - = map mkBuildModule (ms:loop) : go mss - | otherwise - = go mss + graph = mkModuleGraph (map fstOf3 (reverse comp_graph)) + go mg + | Just (ms, mg') <- mgHead mg = + case getModLoop ms mg of + Just loop -> map mkBuildModule (ms:loop) : go mg' + Nothing -> go mg' + | otherwise = [] -- Build a Map out of the compilation graph with which we can efficiently -- look up the result MVar associated with a particular home module. @@ -1231,12 +1234,22 @@ upsweep upsweep mHscMessage old_hpt stable_mods cleanup sccs = do dflags <- getSessionDynFlags - (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs) + (res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs) (unitIdsToCheck dflags) done_holes - return (res, reverse done) + return (res, reverse $ mgModSummaries done) where done_holes = emptyUniqSet + upsweep' + :: GhcMonad m + => HomePackageTable + -> ModuleGraph + -> [SCC ModSummary] + -> Int + -> Int + -> [UnitId] + -> UniqSet ModuleName + -> m (SuccessFlag, ModuleGraph) upsweep' _old_hpt done [] _ _ uids_to_check _ = do hsc_env <- getSession @@ -1314,7 +1327,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do old_hpt1 | isBootSummary mod = old_hpt | otherwise = delFromHpt old_hpt this_mod - done' = mod:done + done' = extendMG done mod -- fixup our HomePackageTable after we've finished compiling -- a mutually-recursive loop. We have to do this again @@ -1650,8 +1663,8 @@ reTypecheckLoop hsc_env ms graph getModLoop :: ModSummary -> ModuleGraph -> Maybe [ModSummary] getModLoop ms graph | not (isBootSummary ms) - , any (\m -> ms_mod m == this_mod && isBootSummary m) graph - , let mss = reachableBackwards (ms_mod_name ms) graph + , mgElemBootModule graph this_mod + , let mss = reachableBackwards (ms_mod_name ms) (mgModSummaries graph) = Just mss | otherwise = Nothing @@ -1689,7 +1702,7 @@ reachableBackwards mod summaries topSortModuleGraph :: Bool -- ^ Drop hi-boot nodes? (see below) - -> [ModSummary] + -> ModuleGraph -> Maybe ModuleName -- ^ Root module name. If @Nothing@, use the full graph. -> [SCC ModSummary] @@ -1708,9 +1721,10 @@ topSortModuleGraph -- 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 +topSortModuleGraph drop_hs_boot_nodes module_graph mb_root_mod = map (fmap summaryNodeSummary) $ stronglyConnCompG initial_graph where + summaries = mgModSummaries module_graph -- stronglyConnCompG flips the original order, so if we reverse -- the summaries we get a stable topological sort. (graph, lookup_node) = |