Make checkFamInstConsistency faster
authorBartosz Nitka <niteria@gmail.com>
Mon, 23 Jan 2017 12:56:21 +0000 (04:56 -0800)
committerBartosz Nitka <niteria@gmail.com>
Mon, 23 Jan 2017 12:56:30 +0000 (04:56 -0800)
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

compiler/typecheck/FamInst.hs
compiler/types/FamInstEnv.hs
testsuite/tests/typecheck/should_fail/T6018fail.stderr

index 0c1bdef..b9cf0af 100644 (file)
@@ -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
index 7abac11..40d2582 100644 (file)
@@ -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
index e40cb84..2525934 100644 (file)
@@ -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: