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

1 files changed, 11 insertions, 2 deletions

diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 0c1bdef29c..b9cf0af936 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