[commit: ghc] master: Efficient checks for stable modules (8bfab43)
git at git.haskell.org
git at git.haskell.org
Tue May 30 11:49:26 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8bfab438bdaa29b82c5ad57814bd60dcd02aa1c6/ghc
>---------------------------------------------------------------
commit 8bfab438bdaa29b82c5ad57814bd60dcd02aa1c6
Author: Bartosz Nitka <niteria at gmail.com>
Date: Tue May 30 04:48:57 2017 -0700
Efficient checks for stable modules
With a large number of modules in a home package
(in my case 5000) the costs of linear lookups becomes significant.
This changes them to efficient IntMap lookups.
It reduces the cost of `:reload` on unchanged source
from 5.77s to 1.62s on my test case.
I could go further and make `Linker.unload` also take a set,
but I prefer to concentrate on one thing at a time.
Test Plan: harbormaster
Reviewers: simonmar, austin, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3611
>---------------------------------------------------------------
8bfab438bdaa29b82c5ad57814bd60dcd02aa1c6
compiler/main/GhcMake.hs | 56 ++++++++++++++++++++++++++++++++----------------
1 file changed, 37 insertions(+), 19 deletions(-)
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index a3b45e3..e11503b 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -305,7 +305,11 @@ load' how_much mHscMessage mod_graph = do
-- Unload any modules which are going to be re-linked this time around.
let stable_linkables = [ linkable
- | m <- stable_obj++stable_bco,
+ | m <- nonDetEltsUniqSet stable_obj ++
+ nonDetEltsUniqSet stable_bco,
+ -- It's OK to use nonDetEltsUniqSet here
+ -- because it only affects linking. Besides
+ -- this list only serves as a poor man's set.
Just hmi <- [lookupHpt pruned_hpt m],
Just linkable <- [hm_linkable hmi] ]
liftIO $ unload hsc_env stable_linkables
@@ -351,14 +355,18 @@ load' how_much mHscMessage mod_graph = do
stable_mg =
[ AcyclicSCC ms
| AcyclicSCC ms <- full_mg,
- ms_mod_name ms `elem` stable_obj++stable_bco ]
+ stable_mod_summary ms ]
+
+ stable_mod_summary ms =
+ ms_mod_name ms `elementOfUniqSet` stable_obj ||
+ ms_mod_name ms `elementOfUniqSet` stable_bco
-- the modules from partial_mg that are not also stable
-- NB. also keep cycles, we need to emit an error message later
unstable_mg = filter not_stable partial_mg
where not_stable (CyclicSCC _) = True
not_stable (AcyclicSCC ms)
- = ms_mod_name ms `notElem` stable_obj++stable_bco
+ = not $ stable_mod_summary ms
-- Load all the stable modules first, before attempting to load
-- an unstable module (#7231).
@@ -579,7 +587,7 @@ guessOutputFile = modifySession $ \env ->
-- compilation.
pruneHomePackageTable :: HomePackageTable
-> [ModSummary]
- -> ([ModuleName],[ModuleName])
+ -> StableModules
-> HomePackageTable
pruneHomePackageTable hpt summ (stable_obj, stable_bco)
= mapHpt prune hpt
@@ -596,7 +604,9 @@ pruneHomePackageTable hpt summ (stable_obj, stable_bco)
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 `elementOfUniqSet` stable_obj ||
+ m `elementOfUniqSet` stable_bco
-- -----------------------------------------------------------------------------
--
@@ -679,18 +689,26 @@ unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
has changed. The current code in GhcMake handles this case
fairly poorly, so be careful.
-}
+
+type StableModules =
+ ( UniqSet ModuleName -- stableObject
+ , UniqSet ModuleName -- stableBCO
+ )
+
+
checkStability
:: HomePackageTable -- HPT from last compilation
-> [SCC ModSummary] -- current module graph (cyclic)
-> UniqSet ModuleName -- all home modules
- -> ([ModuleName], -- stableObject
- [ModuleName]) -- stableBCO
+ -> StableModules
-checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
+checkStability hpt sccs all_home_mods =
+ foldl checkSCC (emptyUniqSet, emptyUniqSet) sccs
where
+ checkSCC :: StableModules -> SCC ModSummary -> StableModules
checkSCC (stable_obj, stable_bco) scc0
- | stableObjects = (scc_mods ++ stable_obj, stable_bco)
- | stableBCOs = (stable_obj, scc_mods ++ stable_bco)
+ | stableObjects = (addListToUniqSet stable_obj scc_mods, stable_bco)
+ | stableBCOs = (stable_obj, addListToUniqSet stable_bco scc_mods)
| otherwise = (stable_obj, stable_bco)
where
scc = flattenSCC scc0
@@ -701,8 +719,8 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
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
+ stable_obj_imps = map (`elementOfUniqSet` stable_obj) scc_allimps
+ stable_bco_imps = map (`elementOfUniqSet` stable_bco) scc_allimps
stableObjects =
and stable_obj_imps
@@ -816,7 +834,7 @@ parUpsweep
-- ^ The number of workers we wish to run in parallel
-> Maybe Messager
-> HomePackageTable
- -> ([ModuleName],[ModuleName])
+ -> StableModules
-> (HscEnv -> IO ())
-> [SCC ModSummary]
-> m (SuccessFlag,
@@ -1026,8 +1044,8 @@ parUpsweep_one
-- ^ The MVar that synchronizes updates to the global HscEnv
-> IORef HomePackageTable
-- ^ The old HPT
- -> ([ModuleName],[ModuleName])
- -- ^ Lists of stable objects and BCOs
+ -> StableModules
+ -- ^ Sets of stable objects and BCOs
-> Int
-- ^ The index of this module
-> Int
@@ -1203,7 +1221,7 @@ upsweep
:: GhcMonad m
=> Maybe Messager
-> HomePackageTable -- ^ HPT from last time round (pruned)
- -> ([ModuleName],[ModuleName]) -- ^ stable modules (see checkStability)
+ -> StableModules -- ^ stable modules (see checkStability)
-> (HscEnv -> IO ()) -- ^ How to clean up unwanted tmp files
-> [SCC ModSummary] -- ^ Mods to do (the worklist)
-> m (SuccessFlag,
@@ -1348,7 +1366,7 @@ maybeGetIfaceDate dflags location
upsweep_mod :: HscEnv
-> Maybe Messager
-> HomePackageTable
- -> ([ModuleName],[ModuleName])
+ -> StableModules
-> ModSummary
-> Int -- index of module
-> Int -- total number of modules
@@ -1362,8 +1380,8 @@ upsweep_mod hsc_env mHscMessage old_hpt (stable_obj, stable_bco) summary mod_ind
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 `elementOfUniqSet` stable_obj
+ is_stable_bco = this_mod_name `elementOfUniqSet` stable_bco
old_hmi = lookupHpt old_hpt this_mod_name
More information about the ghc-commits
mailing list