[commit: ghc] master: Make checkFamInstConsistency faster (18ceb14)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/18ceb14828b96a2d2f08e962111f41c46a962983/ghc

>---------------------------------------------------------------

commit 18ceb14828b96a2d2f08e962111f41c46a962983
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Mon Jan 23 04:56:21 2017 -0800

    Make checkFamInstConsistency faster
    
    We've noticed that `checkFamInstConsistency` takes 6% of
    overall build time on our codebase.
    I've poked around for a bit and most of type family
    instances are `Rep` from `Generics`. I think those are
    unavoidable, so I don't think we can have less of them.
    
    I also looked at the code and noticed a simple algorithmic
    improvement can be made. The algorithm is pretty simple:
    we take all the family instances from one module (`M1`)
    and test it against another module (`M2`).
    The cost of that is dominated by the size of `M1`, because
    for each instance in `M1` we look it up in the type family
    env from `M2`, and lookup is cheap.
    If `M1` is bigger than `M2`, that's suboptimal, so after
    my change we always iterate through the smaller set.
    
    This drives down the cost of `checkFamInstConsistency`
    to 2%.
    
    Test Plan: harbormaster
    
    Reviewers: simonmar, simonpj, goldfire, rwbarton, bgamari, ezyang, austin
    
    Reviewed By: rwbarton, ezyang
    
    Subscribers: ezyang, thomie
    
    Differential Revision: https://phabricator.haskell.org/D2833


>---------------------------------------------------------------

18ceb14828b96a2d2f08e962111f41c46a962983
 compiler/typecheck/FamInst.hs                          | 13 +++++++++++--
 compiler/types/FamInstEnv.hs                           |  7 ++++++-
 testsuite/tests/typecheck/should_fail/T6018fail.stderr |  4 ++--
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 0c1bdef..b9cf0af 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -233,8 +233,17 @@ checkFamInstConsistency famInstMods directlyImpMods
     allPairs (m:ms) = map (modulePair m) ms ++ allPairs ms
 
     check hpt_fam_insts (ModulePair m1 m2)
-      = do { env1 <- getFamInsts hpt_fam_insts m1
-           ; env2 <- getFamInsts hpt_fam_insts m2
+      = do { env1' <- getFamInsts hpt_fam_insts m1
+           ; env2' <- getFamInsts hpt_fam_insts m2
+           -- We're checking each element of env1 against env2.
+           -- The cost of that is dominated by the size of env1, because
+           -- for each instance in env1 we look it up in the type family
+           -- environment env2, and lookup is cheap.
+           -- The code below ensures that env1 is the smaller environment.
+           ; let sizeE1 = famInstEnvSize env1'
+                 sizeE2 = famInstEnvSize env2'
+                 (env1, env2) = if sizeE1 < sizeE2 then (env1', env2')
+                                                   else (env2', env1')
            -- Note [Don't check hs-boot type family instances too early]
            -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            -- Family instance consistency checking involves checking that
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 7abac11..40d2582 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -12,7 +12,7 @@ module FamInstEnv (
 
         FamInstEnvs, FamInstEnv, emptyFamInstEnv, emptyFamInstEnvs,
         extendFamInstEnv, deleteFromFamInstEnv, extendFamInstEnvList,
-        identicalFamInstHead, famInstEnvElts, familyInstances,
+        identicalFamInstHead, famInstEnvElts, famInstEnvSize, familyInstances,
 
         -- * CoAxioms
         mkCoAxBranch, mkBranchedCoAxiom, mkUnbranchedCoAxiom, mkSingleCoAxiom,
@@ -400,6 +400,11 @@ famInstEnvElts :: FamInstEnv -> [FamInst]
 famInstEnvElts fi = [elt | FamIE elts <- eltsUDFM fi, elt <- elts]
   -- See Note [FamInstEnv determinism]
 
+famInstEnvSize :: FamInstEnv -> Int
+famInstEnvSize = nonDetFoldUDFM (\(FamIE elt) sum -> sum + length elt) 0
+  -- It's OK to use nonDetFoldUDFM here since we're just computing the
+  -- size.
+
 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
 familyInstances (pkg_fie, home_fie) fam
   = get home_fie ++ get pkg_fie
diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr
index e40cb84..2525934 100644
--- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr
@@ -9,10 +9,10 @@ T6018Afail.hs:7:15: error:
       G Char Bool Int = Int -- Defined at T6018Afail.hs:7:15
       G Bool Int Char = Int -- Defined at T6018fail.hs:15:15
 
-T6018Dfail.hs:7:15: error:
+T6018Cfail.hs:8:15: error:
     Type family equations violate injectivity annotation:
-      T6018Bfail.H Bool Int Char = Int -- Defined at T6018Dfail.hs:7:15
       T6018Bfail.H Char Bool Int = Int -- Defined at T6018Cfail.hs:8:15
+      T6018Bfail.H Bool Int Char = Int -- Defined at T6018Dfail.hs:7:15
 
 T6018fail.hs:13:15: error:
     Type family equations violate injectivity annotation: