summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2017-06-27 12:55:17 -0400
committerBen Gamari <ben@smart-cactus.org>2017-06-27 13:34:05 -0400
commitb0708588e87554899c2efc80a2d3eba353dbe926 (patch)
tree03817b07a5c542a45d6058cf19a09efeaf5037bc
parent6567c815135e93f8550d526f81d13f31c0cd92b6 (diff)
downloadhaskell-b0708588e87554899c2efc80a2d3eba353dbe926.tar.gz
Make module membership on ModuleGraph faster
When loading/reloading with a large number of modules (>5000) the cost of linear lookups becomes significant. The changes here made `:reload` go from 6s to 1s on my test case. The bottlenecks were `needsLinker` in `DriverPipeline` and `getModLoop` in `GhcMake`. Test Plan: ./validate Reviewers: simonmar, austin, bgamari Subscribers: rwbarton, thomie Differential Revision: https://phabricator.haskell.org/D3646
-rw-r--r--compiler/backpack/DriverBkp.hs5
-rw-r--r--compiler/main/DriverMkDepend.hs16
-rw-r--r--compiler/main/DriverPipeline.hs5
-rw-r--r--compiler/main/GHC.hs23
-rw-r--r--compiler/main/GhcMake.hs54
-rw-r--r--compiler/main/HscMain.hs2
-rw-r--r--compiler/main/HscTypes.hs123
-rw-r--r--ghc/GHCi/UI.hs23
-rw-r--r--ghc/GHCi/UI/Tags.hs2
-rw-r--r--testsuite/tests/ghc-api/apirecomp001/myghc.hs4
-rw-r--r--utils/check-api-annotations/Main.hs10
-rw-r--r--utils/check-ppr/Main.hs2
-rw-r--r--utils/ghctags/Main.hs6
13 files changed, 200 insertions, 75 deletions
diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 6123bc8133..4324e5763b 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -288,7 +288,8 @@ buildUnit session cid insts lunit = do
let hi_dir = expectJust (panic "hiDir Backpack") $ hiDir dflags
export_mod ms = (ms_mod_name ms, ms_mod ms)
-- Export everything!
- mods = [ export_mod ms | ms <- mod_graph, ms_hsc_src ms == HsSrcFile ]
+ mods = [ export_mod ms | ms <- mgModSummaries mod_graph
+ , ms_hsc_src ms == HsSrcFile ]
-- Compile relevant only
hsc_env <- getSession
@@ -660,7 +661,7 @@ hsunitModuleGraph dflags unit = do
else fmap Just $ summariseRequirement pn mod_name
-- 3. Return the kaboodle
- return (nodes ++ req_nodes)
+ return $ mkModuleGraph $ nodes ++ req_nodes
summariseRequirement :: PackageName -> ModuleName -> BkpM ModSummary
summariseRequirement pn mod_name = do
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index dc18a31174..8cf14c57e5 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -75,11 +75,11 @@ doMkDependHS srcs = do
targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
GHC.setTargets targets
let excl_mods = depExcludeMods dflags
- mod_summaries <- GHC.depanal excl_mods True {- Allow dup roots -}
+ module_graph <- GHC.depanal excl_mods True {- Allow dup roots -}
-- Sort into dependency order
-- There should be no cycles
- let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
+ let sorted = GHC.topSortModuleGraph False module_graph Nothing
-- Print out the dependencies if wanted
liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
@@ -91,7 +91,7 @@ doMkDependHS srcs = do
mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
-- If -ddump-mod-cycles, show cycles in the module graph
- liftIO $ dumpModCycles dflags mod_summaries
+ liftIO $ dumpModCycles dflags module_graph
-- Tidy up
liftIO $ endMkDependHS dflags files
@@ -338,8 +338,8 @@ endMkDependHS dflags
-- Module cycles
-----------------------------------------------------------------
-dumpModCycles :: DynFlags -> [ModSummary] -> IO ()
-dumpModCycles dflags mod_summaries
+dumpModCycles :: DynFlags -> ModuleGraph -> IO ()
+dumpModCycles dflags module_graph
| not (dopt Opt_D_dump_mod_cycles dflags)
= return ()
@@ -351,7 +351,8 @@ dumpModCycles dflags mod_summaries
where
cycles :: [[ModSummary]]
- cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
+ cycles =
+ [ c | CyclicSCC c <- GHC.topSortModuleGraph True module_graph Nothing ]
pp_cycles = vcat [ (text "---------- Cycle" <+> int n <+> ptext (sLit "----------"))
$$ pprCycle c $$ blankLine
@@ -379,7 +380,8 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
loop_breaker = head boot_only
all_others = tail boot_only ++ others
- groups = GHC.topSortModuleGraph True all_others Nothing
+ groups =
+ GHC.topSortModuleGraph True (mkModuleGraph all_others) Nothing
pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
<+> (pp_imps empty (map snd (ms_imps summary)) $$
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index eed66b22c1..850f67d061 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -235,10 +235,7 @@ compileOne' m_tc_result mHscMessage
input_fn = expectJust "compile:hs" (ml_hs_file location)
input_fnpp = ms_hspp_file summary
mod_graph = hsc_mod_graph hsc_env0
- needsLinker = any (\ModSummary {ms_hspp_opts} ->
- xopt LangExt.TemplateHaskell ms_hspp_opts
- || xopt LangExt.QuasiQuotes ms_hspp_opts
- ) mod_graph
+ needsLinker = needsTemplateHaskellOrQQ mod_graph
isDynWay = any (== WayDyn) (ways dflags0)
isProfWay = any (== WayProf) (ways dflags0)
internalInterpreter = not (gopt Opt_ExternalInterpreter dflags0)
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 2102009019..3ca07f1443 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -23,7 +23,7 @@ module GHC (
gcatch, gbracket, gfinally,
printException,
handleSourceError,
- needsTemplateHaskell,
+ needsTemplateHaskellOrQQ,
-- * Flags and settings
DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), gopt,
@@ -59,7 +59,8 @@ module GHC (
compileToCoreModule, compileToCoreSimplified,
-- * Inspecting the module structure of the program
- ModuleGraph, emptyMG, mapMG,
+ ModuleGraph, emptyMG, mapMG, mkModuleGraph, mgModSummaries,
+ mgLookupModule,
ModSummary(..), ms_mod_name, ModLocation(..),
getModSummary,
getModuleGraph,
@@ -873,7 +874,10 @@ type TypecheckedSource = LHsBinds GhcTc
getModSummary :: GhcMonad m => ModuleName -> m ModSummary
getModSummary mod = do
mg <- liftM hsc_mod_graph getSession
- case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
+ let mods_by_name = [ ms | ms <- mgModSummaries mg
+ , ms_mod_name ms == mod
+ , not (isBootSummary ms) ]
+ case mods_by_name of
[] -> do dflags <- getDynFlags
liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
[ms] -> return ms
@@ -1023,7 +1027,7 @@ compileCore simplify fn = do
_ <- load LoadAllTargets
-- Then find dependencies
modGraph <- depanal [] True
- case find ((== fn) . msHsFilePath) modGraph of
+ case find ((== fn) . msHsFilePath) (mgModSummaries modGraph) of
Just modSummary -> do
-- Now we have the module name;
-- parse, typecheck and desugar the module
@@ -1075,15 +1079,6 @@ compileCore simplify fn = do
getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary
getModuleGraph = liftM hsc_mod_graph getSession
--- | Determines whether a set of modules requires Template Haskell.
---
--- Note that if the session's 'DynFlags' enabled Template Haskell when
--- 'depanal' was called, then each module in the returned module graph will
--- have Template Haskell enabled whether it is actually needed or not.
-needsTemplateHaskell :: ModuleGraph -> Bool
-needsTemplateHaskell ms =
- any (xopt LangExt.TemplateHaskell . ms_hspp_opts) ms
-
-- | Return @True@ <==> module is loaded.
isLoaded :: GhcMonad m => ModuleName -> m Bool
isLoaded m = withSession $ \hsc_env ->
@@ -1120,7 +1115,7 @@ data ModuleInfo = ModuleInfo {
getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo) -- XXX: Maybe X
getModuleInfo mdl = withSession $ \hsc_env -> do
let mg = hsc_mod_graph hsc_env
- if mdl `elem` map ms_mod mg
+ if mgElemModule mg mdl
then liftIO $ getHomeModuleInfo hsc_env mdl
else do
{- if isHomeModule (hsc_dflags hsc_env) mdl
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) =
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index b8bd76bedd..8d8e26ebb5 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -184,7 +184,7 @@ newHscEnv dflags = do
iserv_mvar <- newMVar Nothing
return HscEnv { hsc_dflags = dflags
, hsc_targets = []
- , hsc_mod_graph = []
+ , hsc_mod_graph = emptyMG
, hsc_IC = emptyInteractiveContext dflags
, hsc_HPT = emptyHomePackageTable
, hsc_EPS = eps_var
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index fa9c18a3e1..868453d351 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
-- | Types for the per-module compiler
module HscTypes (
@@ -12,7 +13,9 @@ module HscTypes (
HscEnv(..), hscEPS,
FinderCache, FindResult(..), InstalledFindResult(..),
Target(..), TargetId(..), pprTarget, pprTargetId,
- ModuleGraph, emptyMG, mapMG,
+ ModuleGraph, emptyMG, mkModuleGraph, mgHead, mgReverse, extendMG, mapMG,
+ mgModSummaries, mgElemModule, mgElemBootModule, mgLookupModule,
+ needsTemplateHaskellOrQQ,
HscStatus(..),
IServ(..),
@@ -199,6 +202,7 @@ import Platform
import Util
import UniqDSet
import GHC.Serialized ( Serialized )
+import qualified GHC.LanguageExtensions as LangExt
import Foreign
import Control.Monad ( guard, liftM, ap )
@@ -2606,13 +2610,120 @@ soExt platform
--
-- The graph is not necessarily stored in topologically-sorted order. Use
-- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this.
-type ModuleGraph = [ModSummary]
-
-emptyMG :: ModuleGraph
-emptyMG = []
+data ModuleGraph = ModuleGraph
+ { mg_mss :: [ModSummary]
+ , mg_non_boot :: ModuleEnv ModSummary
+ -- a map of all non-boot ModSummaries keyed by Modules
+ , mg_boot :: ModuleEnv ModSummary
+ -- a map of all boot ModSummaries keyed by Modules
+ , mg_needs_th_or_qq :: ModuleEnv ModSummary
+ -- all non-boot Modules that need TemplateHaskell or QuasiQuotes
+ }
+-- | Determines whether a set of modules requires Template Haskell or
+-- Quasi Quotes
+--
+-- Note that if the session's 'DynFlags' enabled Template Haskell when
+-- 'depanal' was called, then each module in the returned module graph will
+-- have Template Haskell enabled whether it is actually needed or not.
+needsTemplateHaskellOrQQ :: ModuleGraph -> Bool
+needsTemplateHaskellOrQQ mg = not $ isEmptyModuleEnv $ mg_needs_th_or_qq mg
+
+-- | Map a function 'f' over all the 'ModSummaries'.
+-- To preserve invariants 'f' can't change the isBoot status.
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
-mapMG = map
+mapMG f ModuleGraph{..} =
+ ModuleGraph
+ { mg_mss = map f mg_mss
+ , mg_non_boot = mapModuleEnv f mg_non_boot
+ , mg_boot = mapModuleEnv f mg_boot
+ , mg_needs_th_or_qq = mapModuleEnv f mg_needs_th_or_qq
+ }
+
+mgModSummaries :: ModuleGraph -> [ModSummary]
+mgModSummaries = mg_mss
+
+mgElemModule :: ModuleGraph -> Module -> Bool
+mgElemModule mg m = mgElemNonBootModule mg m || mgElemBootModule mg m
+
+mgElemBootModule :: ModuleGraph -> Module -> Bool
+mgElemBootModule ModuleGraph{..} m = elemModuleEnv m mg_boot
+
+mgElemNonBootModule :: ModuleGraph -> Module -> Bool
+mgElemNonBootModule ModuleGraph{..} m = elemModuleEnv m mg_non_boot
+
+mgLookupNonBootModule :: ModuleGraph -> Module -> Maybe ModSummary
+mgLookupNonBootModule ModuleGraph{..} m = lookupModuleEnv mg_non_boot m
+
+mgLookupBootModule :: ModuleGraph -> Module -> Maybe ModSummary
+mgLookupBootModule ModuleGraph{..} m = lookupModuleEnv mg_boot m
+
+-- | Look up a ModSummary in the ModuleGraph, in non-boot ModSummaries first,
+-- falling back to boot ModSummaries.
+mgLookupModule :: ModuleGraph -> Module -> Maybe ModSummary
+mgLookupModule mg m =
+ case mgLookupNonBootModule mg m of
+ Nothing -> mgLookupBootModule mg m
+ a -> a
+
+emptyMG :: ModuleGraph
+emptyMG =
+ ModuleGraph [] emptyModuleEnv emptyModuleEnv emptyModuleEnv
+
+-- | Reverse the order of elements in the ModuleGraph.
+mgReverse :: ModuleGraph -> ModuleGraph
+mgReverse mg@ModuleGraph { mg_mss = mg_mss } = mg { mg_mss = reverse mg_mss }
+
+isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
+isTemplateHaskellOrQQNonBoot ms =
+ (xopt LangExt.TemplateHaskell (ms_hspp_opts ms)
+ || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) &&
+ not (isBootSummary ms)
+
+-- | Add a ModSummary to ModuleGraph. Assumes that the new ModSummary is
+-- not an element of the ModuleGraph.
+extendMG :: ModuleGraph -> ModSummary -> ModuleGraph
+extendMG ModuleGraph{..} ms = ModuleGraph
+ { mg_mss = ms:mg_mss
+ , mg_non_boot = extendModEnvIf (not . isBootSummary) mg_non_boot ms
+ , mg_boot = extendModEnvIf isBootSummary mg_boot ms
+ , mg_needs_th_or_qq =
+ extendModEnvIf isTemplateHaskellOrQQNonBoot mg_needs_th_or_qq ms
+ }
+ where
+ extendModEnvIf
+ :: (ModSummary -> Bool)
+ -> ModuleEnv ModSummary
+ -> ModSummary
+ -> ModuleEnv ModSummary
+ extendModEnvIf p me ms
+ | p ms = extendModuleEnv me (ms_mod ms) ms
+ | otherwise = me
+
+-- | Take the first element from the ModuleGraph and remove it from the
+-- graph.
+mgHead :: ModuleGraph -> Maybe (ModSummary, ModuleGraph)
+mgHead ModuleGraph { mg_mss = [] } = Nothing
+mgHead ModuleGraph { mg_mss = (ms:mss), ..} = Just (ms, mg')
+ where
+ mg' = ModuleGraph
+ { mg_mss = mss
+ , mg_non_boot = delModEnvIf (not . isBootSummary) mg_non_boot ms
+ , mg_boot = delModEnvIf isBootSummary mg_boot ms
+ , mg_needs_th_or_qq =
+ delModEnvIf isTemplateHaskellOrQQNonBoot mg_needs_th_or_qq ms
+ }
+ delModEnvIf
+ :: (ModSummary -> Bool)
+ -> ModuleEnv ModSummary
+ -> ModSummary
+ -> ModuleEnv ModSummary
+ delModEnvIf p me ms
+ | p ms = delModuleEnv me (ms_mod ms)
+ | otherwise = me
+
+mkModuleGraph :: [ModSummary] -> ModuleGraph
+mkModuleGraph = foldr (flip extendMG) emptyMG
-- | A single node in a 'ModuleGraph'. The nodes of the module graph
-- are one of:
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 40bd0e59c3..6f6edd66ab 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1401,7 +1401,7 @@ changeDirectory "" = do
Right dir -> changeDirectory dir
changeDirectory dir = do
graph <- GHC.getModuleGraph
- when (not (null graph)) $
+ when (not (null $ GHC.mgModSummaries graph)) $
liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed."
GHC.setTargets []
_ <- GHC.load LoadAllTargets
@@ -1461,7 +1461,8 @@ chooseEditFile =
do let hasFailed x = fmap not $ GHC.isLoaded $ GHC.ms_mod_name x
graph <- GHC.getModuleGraph
- failed_graph <- filterM hasFailed graph
+ failed_graph <-
+ GHC.mkModuleGraph <$> filterM hasFailed (GHC.mgModSummaries graph)
let order g = flattenSCCs $ GHC.topSortModuleGraph True g Nothing
pick xs = case xs of
x : _ -> GHC.ml_hs_file (GHC.ms_location x)
@@ -1687,7 +1688,8 @@ doLoadAndCollectInfo retain_context howmuch = do
doLoad retain_context howmuch >>= \case
Succeeded | doCollectInfo -> do
- loaded <- getModuleGraph >>= filterM GHC.isLoaded . map GHC.ms_mod_name
+ mod_summaries <- GHC.mgModSummaries <$> getModuleGraph
+ loaded <- filterM GHC.isLoaded $ map GHC.ms_mod_name mod_summaries
v <- mod_infos <$> getGHCiState
!newInfos <- collectInfo v loaded
modifyGHCiState (\st -> st { mod_infos = newInfos })
@@ -1732,8 +1734,9 @@ setContextAfterLoad keep_ctxt ms = do
targets <- GHC.getTargets
case [ m | Just m <- map (findTarget ms) targets ] of
[] ->
- let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
- load_this (last graph')
+ let graph = GHC.mkModuleGraph ms
+ graph' = flattenSCCs (GHC.topSortModuleGraph True graph Nothing)
+ in load_this (last graph')
(m:_) ->
load_this m
where
@@ -2811,7 +2814,7 @@ showModules = do
getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary]
getLoadedModules = do
graph <- GHC.getModuleGraph
- filterM (GHC.isLoaded . GHC.ms_mod_name) graph
+ filterM (GHC.isLoaded . GHC.ms_mod_name) (GHC.mgModSummaries graph)
showBindings :: GHCi ()
showBindings = do
@@ -3048,7 +3051,7 @@ completeHomeModule = wrapIdentCompleter listHomeModules
listHomeModules :: String -> GHCi [String]
listHomeModules w = do
g <- GHC.getModuleGraph
- let home_mods = map GHC.ms_mod_name g
+ let home_mods = map GHC.ms_mod_name (GHC.mgModSummaries g)
dflags <- getDynFlags
return $ sort $ filter (w `isPrefixOf`)
$ map (showPpr dflags) home_mods
@@ -3490,10 +3493,10 @@ list2 _other =
listModuleLine :: Module -> Int -> InputT GHCi ()
listModuleLine modl line = do
graph <- GHC.getModuleGraph
- let this = filter ((== modl) . GHC.ms_mod) graph
+ let this = GHC.mgLookupModule graph modl
case this of
- [] -> panic "listModuleLine"
- summ:_ -> do
+ Nothing -> panic "listModuleLine"
+ Just summ -> do
let filename = expectJust "listModuleLine" (ml_hs_file (GHC.ms_location summ))
loc = mkRealSrcLoc (mkFastString (filename)) line 0
listAround (realSrcLocSpan loc) False
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index c23db57f81..d8af7f8718 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -72,7 +72,7 @@ ghciCreateTagsFile kind file = do
createTagsFile :: TagsKind -> FilePath -> GHCi ()
createTagsFile tagskind tagsFile = do
graph <- GHC.getModuleGraph
- mtags <- mapM listModuleTags (map GHC.ms_mod graph)
+ mtags <- mapM listModuleTags (map GHC.ms_mod $ GHC.mgModSummaries graph)
either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags
case either_res of
Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e
diff --git a/testsuite/tests/ghc-api/apirecomp001/myghc.hs b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
index 570b479d2f..799382cac8 100644
--- a/testsuite/tests/ghc-api/apirecomp001/myghc.hs
+++ b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
@@ -42,7 +42,9 @@ main = do
-- set context to module "A"
mg <- getModuleGraph
- let [mod] = [ ms_mod_name m | m <- mg, moduleNameString (ms_mod_name m) == "A" ]
+ let [mod] = [ ms_mod_name m
+ | m <- mgModSummaries mg
+ , moduleNameString (ms_mod_name m) == "A" ]
setContext [IIModule mod]
liftIO $ hFlush stdout -- make sure things above are printed before
-- interactive output
diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs
index 1d577421fb..6b973e12e8 100644
--- a/utils/check-api-annotations/Main.hs
+++ b/utils/check-api-annotations/Main.hs
@@ -32,11 +32,11 @@ testOneFile libdir fileName = do
, targetContents = Nothing }
_ <- load LoadAllTargets
graph <- getModuleGraph
- let
- modSum = case filter modByFile graph of
- [x] -> x
- xs -> error $ "Can't find module, got:"
- ++ show (map (ml_hs_file . ms_location) xs)
+ let modSum =
+ case filter modByFile (mgModSummaries graph) of
+ [x] -> x
+ xs -> error $ "Can't find module, got:"
+ ++ show (map (ml_hs_file . ms_location) xs)
p <- parseModule modSum
return (pm_annotations p,p)
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index 47a95659ff..2fd44b2be0 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -77,7 +77,7 @@ parseOneFile libdir fileName = do
_ <- load LoadAllTargets
graph <- getModuleGraph
let
- modSum = case filter modByFile graph of
+ modSum = case filter modByFile (mgModSummaries graph) of
[x] -> x
xs -> error $ "Can't find module, got:"
++ show (map (ml_hs_file . ms_location) xs)
diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs
index 4842a0cbfb..c4db3ca212 100644
--- a/utils/ghctags/Main.hs
+++ b/utils/ghctags/Main.hs
@@ -222,9 +222,9 @@ fileTarget filename = Target (TargetFile filename Nothing) True Nothing
---------------------------------------------------------------
----- CRAWLING ABSTRACT SYNTAX TO SNAFFLE THE DEFINITIONS -----
-graphData :: ModuleGraph -> (Maybe Handle, Maybe Handle) -> Ghc ()
-graphData graph handles = do
- mapM_ foundthings graph
+graphData :: [ModSummary] -> (Maybe Handle, Maybe Handle) -> Ghc ()
+graphData mss handles = do
+ mapM_ foundthings mss
where foundthings ms =
let filename = msHsFilePath ms
modname = moduleName $ ms_mod ms