diff options
author | Ben Gamari <ben@smart-cactus.org> | 2017-06-27 13:36:29 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-06-27 13:36:29 -0400 |
commit | 22b917eeb1d101cf0b6af2c94826446e4e2f2cdb (patch) | |
tree | cf842eaf2045f5ae36579b5e64200c61a8fe7b75 /compiler/main/GhcMake.hs | |
parent | b0708588e87554899c2efc80a2d3eba353dbe926 (diff) | |
download | haskell-22b917eeb1d101cf0b6af2c94826446e4e2f2cdb.tar.gz |
Revert "Make module membership on ModuleGraph faster"
I had not intended on merging this.
This reverts commit b0708588e87554899c2efc80a2d3eba353dbe926.
Diffstat (limited to 'compiler/main/GhcMake.hs')
-rw-r--r-- | compiler/main/GhcMake.hs | 54 |
1 files changed, 20 insertions, 34 deletions
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 57af356b38..134a0607bc 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -138,11 +138,9 @@ depanal excluded_mods allow_dup_roots = do -- cached finder data. liftIO $ flushFinderCaches hsc_env - mod_summariesE <- liftIO $ downsweep hsc_env (mgModSummaries old_graph) + mod_graphE <- liftIO $ downsweep hsc_env old_graph excluded_mods allow_dup_roots - mod_summaries <- reportImportErrors mod_summariesE - - let mod_graph = mkModuleGraph mod_summaries + mod_graph <- reportImportErrors mod_graphE warnMissingHomeModules hsc_env mod_graph @@ -195,7 +193,7 @@ warnMissingHomeModules hsc_env mod_graph = is_my_target _ _ = False missing = map (moduleName . ms_mod) $ - filter (not . is_known_module) (mgModSummaries mod_graph) + filter (not . is_known_module) mod_graph msg = text "Modules are not listed in command line: " <> sep (map ppr missing) @@ -250,7 +248,7 @@ load' how_much mHscMessage mod_graph = do -- (see msDeps) let all_home_mods = mkUniqSet [ ms_mod_name s - | s <- mgModSummaries mod_graph, not (isBootSummary s)] + | s <- 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. @@ -419,7 +417,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 = mgElemModule mod_graph main_mod + a_root_is_Main = any ((==main_mod).ms_mod) mod_graph do_linking = a_root_is_Main || no_hs_main || ghcLink dflags == LinkDynLib || ghcLink dflags == LinkStaticLib -- link everything together @@ -540,7 +538,8 @@ guessOutputFile = modifySession $ \env -> !mod_graph = hsc_mod_graph env mainModuleSrcPath :: Maybe String mainModuleSrcPath = do - ms <- mgLookupModule mod_graph (mainModIs dflags) + let isMain = (== mainModIs dflags) . ms_mod + [ms] <- return (filter isMain mod_graph) ml_hs_file (ms_location ms) name = fmap dropExtension mainModuleSrcPath @@ -885,15 +884,13 @@ 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 graph + let comp_graph_loops = go (map fstOf3 (reverse comp_graph)) where - 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 = [] + go [] = [] + go (ms:mss) | Just loop <- getModLoop ms (ms:mss) + = map mkBuildModule (ms:loop) : go mss + | otherwise + = go mss -- Build a Map out of the compilation graph with which we can efficiently -- look up the result MVar associated with a particular home module. @@ -1234,22 +1231,12 @@ upsweep upsweep mHscMessage old_hpt stable_mods cleanup sccs = do dflags <- getSessionDynFlags - (res, done) <- upsweep' old_hpt emptyMG sccs 1 (length sccs) + (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs) (unitIdsToCheck dflags) done_holes - return (res, reverse $ mgModSummaries done) + return (res, reverse 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 @@ -1327,7 +1314,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do old_hpt1 | isBootSummary mod = old_hpt | otherwise = delFromHpt old_hpt this_mod - done' = extendMG done mod + done' = mod:done -- fixup our HomePackageTable after we've finished compiling -- a mutually-recursive loop. We have to do this again @@ -1663,8 +1650,8 @@ reTypecheckLoop hsc_env ms graph getModLoop :: ModSummary -> ModuleGraph -> Maybe [ModSummary] getModLoop ms graph | not (isBootSummary ms) - , mgElemBootModule graph this_mod - , let mss = reachableBackwards (ms_mod_name ms) (mgModSummaries graph) + , any (\m -> ms_mod m == this_mod && isBootSummary m) graph + , let mss = reachableBackwards (ms_mod_name ms) graph = Just mss | otherwise = Nothing @@ -1702,7 +1689,7 @@ reachableBackwards mod summaries topSortModuleGraph :: Bool -- ^ Drop hi-boot nodes? (see below) - -> ModuleGraph + -> [ModSummary] -> Maybe ModuleName -- ^ Root module name. If @Nothing@, use the full graph. -> [SCC ModSummary] @@ -1721,10 +1708,9 @@ 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 module_graph mb_root_mod +topSortModuleGraph drop_hs_boot_nodes summaries 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) = |