[commit: ghc] wip/ghc-8.0-det: Make checkFamInstConsistency less expensive (bab927c)
git at git.haskell.org
git at git.haskell.org
Mon Jul 25 14:59:29 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ghc-8.0-det
Link : http://ghc.haskell.org/trac/ghc/changeset/bab927c9f0cb094a3e59d46372125dfe2bf514bf/ghc
>---------------------------------------------------------------
commit bab927c9f0cb094a3e59d46372125dfe2bf514bf
Author: Bartosz Nitka <niteria at gmail.com>
Date: Tue Jun 21 15:54:00 2016 -0700
Make checkFamInstConsistency less expensive
Doing canonicalization on every comparison turned
out to be very expensive.
Caching the canonicalization through the smart `modulePair` constructor
gives `8%` reduction in allocations on `haddock.compiler` and
`8.5%` reduction in allocations on `haddock.Cabal`.
Possibly other things as well, but it's really visible in Haddock.
Test Plan: ./validate
Reviewers: jstolarek, simonpj, austin, simonmar, bgamari
Reviewed By: simonpj, simonmar
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2350
GHC Trac Issues: #12191
(cherry picked from commit 123062946dfdbcfc24abd468e24e358118b8e2eb)
>---------------------------------------------------------------
bab927c9f0cb094a3e59d46372125dfe2bf514bf
compiler/typecheck/FamInst.hs | 32 +++++++++++++++-----------------
testsuite/tests/perf/haddock/all.T | 10 ++++++++--
2 files changed, 23 insertions(+), 19 deletions(-)
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 1d9e1ce..784bc81 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -40,8 +40,8 @@ import Pair
import Panic
import VarSet
import Control.Monad
-import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
#if __GLASGOW_HASKELL__ < 709
import Prelude hiding ( and )
@@ -124,28 +124,25 @@ certain that the modules in our `HscTypes.dep_finsts' are consistent.)
-- whose family instances need to be checked for consistency.
--
data ModulePair = ModulePair Module Module
+ -- Invariant: first Module < second Module
+ -- use the smart constructor
+ deriving (Ord, Eq)
--- canonical order of the components of a module pair
---
-canon :: ModulePair -> (Module, Module)
-canon (ModulePair m1 m2) | m1 < m2 = (m1, m2)
- | otherwise = (m2, m1)
-
-instance Eq ModulePair where
- mp1 == mp2 = canon mp1 == canon mp2
-
-instance Ord ModulePair where
- mp1 `compare` mp2 = canon mp1 `compare` canon mp2
+-- | Smart constructor that establishes the invariant
+modulePair :: Module -> Module -> ModulePair
+modulePair a b
+ | a < b = ModulePair a b
+ | otherwise = ModulePair b a
instance Outputable ModulePair where
ppr (ModulePair m1 m2) = angleBrackets (ppr m1 <> comma <+> ppr m2)
-- Sets of module pairs
--
-type ModulePairSet = Map ModulePair ()
+type ModulePairSet = Set ModulePair
listToSet :: [ModulePair] -> ModulePairSet
-listToSet l = Map.fromList (zip l (repeat ()))
+listToSet l = Set.fromList l
checkFamInstConsistency :: [Module] -> [Module] -> TcM ()
checkFamInstConsistency famInstMods directlyImpMods
@@ -170,7 +167,8 @@ checkFamInstConsistency famInstMods directlyImpMods
-- instances of okPairs are consistent
; criticalPairs = listToSet $ allPairs famInstMods
-- all pairs that we need to consider
- ; toCheckPairs = Map.keys $ criticalPairs `Map.difference` okPairs
+ ; toCheckPairs =
+ Set.elems $ criticalPairs `Set.difference` okPairs
-- the difference gives us the pairs we need to check now
}
@@ -178,7 +176,7 @@ checkFamInstConsistency famInstMods directlyImpMods
}
where
allPairs [] = []
- allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms
+ allPairs (m:ms) = map (modulePair m) ms ++ allPairs ms
check hpt_fam_insts (ModulePair m1 m2)
= do { env1 <- getFamInsts hpt_fam_insts m1
diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T
index de45ea4..6ee448f 100644
--- a/testsuite/tests/perf/haddock/all.T
+++ b/testsuite/tests/perf/haddock/all.T
@@ -52,7 +52,7 @@ test('haddock.base',
test('haddock.Cabal',
[unless(in_tree_compiler(), skip), req_haddock
,stats_num_field('bytes allocated',
- [(wordsize(64), 10941742184, 5)
+ [(wordsize(64), 10070330520, 5)
# 2012-08-14: 3255435248 (amd64/Linux)
# 2012-08-29: 3324606664 (amd64/Linux, new codegen)
# 2012-10-08: 3373401360 (amd64/Linux)
@@ -78,6 +78,11 @@ test('haddock.Cabal',
# 2015-12-22: 10519532424 (amd64/Linux) - Lots of new Semigroup instances in Cabal
# 2016-03-29: 11517963232 (amd64/Linux) - not yet investigated
# 2016-03-30: 10941742184 (amd64/Linux) - defer inlining of Int* Ord methods
+ # 2016-04-06: 11542374816 (amd64/Linux) - CSE improvements and others
+ # 2016-04-07: 10963514352 (amd64/Linux) - Revert to what phabricator claims
+ # 2016-05-22: 11805238152 (amd64/Linux) - Make Generic1 poly-kinded
+ # 2016-06-05: 10997887320 (amd64/Linux) - Refactor derived Generic instances to reduce allocations
+ # 2016-06-21: 10070330520 (amd64/Linux) - D2350: Make checkFamInstConsistency less expensive
,(platform('i386-unknown-mingw32'), 3293415576, 5)
# 2012-10-30: 1733638168 (x86/Windows)
@@ -99,7 +104,7 @@ test('haddock.Cabal',
test('haddock.compiler',
[unless(in_tree_compiler(), skip), req_haddock
,stats_num_field('bytes allocated',
- [(wordsize(64), 58017214568, 10)
+ [(wordsize(64), 55314944264, 10)
# 2012P-08-14: 26070600504 (amd64/Linux)
# 2012-08-29: 26353100288 (amd64/Linux, new CG)
# 2012-09-18: 26882813032 (amd64/Linux)
@@ -113,6 +118,7 @@ test('haddock.compiler',
# 2015-12-03: 44721228752 (amd64/Linux) slow creep upwards
# 2015-12-15: 49395782136 (amd64/Linux) more creep, following kind-equalities
# 2015-12-17: 58017214568 (amd64/Linux) update Haddock to master
+ # 2016-06-21: 55314944264 (amd64/Linux) D2350: Make checkFamInstConsistency less expensive
,(platform('i386-unknown-mingw32'), 902576468, 10)
# 2012-10-30: 13773051312 (x86/Windows)
More information about the ghc-commits
mailing list