Make checkFamInstConsistency less expensive
authorBartosz Nitka <niteria@gmail.com>
Tue, 21 Jun 2016 22:54:00 +0000 (15:54 -0700)
committerBartosz Nitka <niteria@gmail.com>
Mon, 25 Jul 2016 14:43:41 +0000 (07:43 -0700)
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)

compiler/typecheck/FamInst.hs
testsuite/tests/perf/haddock/all.T

index 1d9e1ce..784bc81 100644 (file)
@@ -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
index de45ea4..6ee448f 100644 (file)
@@ -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)