compiler: Introduce and use RoughMap for instance environments

Here we introduce a new data structure, RoughMap, inspired by the
previous `RoughTc` matching mechanism for checking instance matches.
This allows [Fam]InstEnv to be implemented as a trie indexed by these
RoughTc signatures, reducing the complexity of instance lookup and
FamInstEnv merging (done during the family instance conflict test)
from O(n) to O(log n).

The critical performance improvement currently realised by this patch is
in instance matching. In particular the RoughMap mechanism allows us to
discount many potential instances which will never match for constraints
involving type variables (see Note [Matching a RoughMap]). In realistic
code bases matchInstEnv was accounting for 50% of typechecker time due
to redundant work checking instances when simplifying instance contexts
when deriving instances. With this patch the cost is significantly
reduced.

The larger constants in InstEnv creation do mean that a few small
tests regress in allocations slightly. However, the runtime of T19703 is
reduced by a factor of 4. Moreover, the compilation time of the Cabal
library is slightly improved.

A couple of test cases are included which demonstrate significant
improvements in compile time with this patch.

This unfortunately does not fix the testcase provided in #19703 but does
fix #20933

-------------------------
Metric Decrease:
    T12425
Metric Increase:
    T13719
    T9872a
    T9872d
    hard_hole_fits
-------------------------

Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>

2 files changed, 9 insertions, 9 deletions

diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index 8222e96ce8..3ea5f2725c 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -27,7 +27,7 @@ import GHC.Unit
 import GHC.Unit.Env
 
 import GHC.Core.FamInstEnv
-import GHC.Core.InstEnv ( ClsInst, identicalClsInstHead )
+import GHC.Core.InstEnv
 import GHC.Core.Type
 
 import GHC.Types.Avail
@@ -43,7 +43,6 @@ import GHC.Types.Var
 import GHC.Builtin.Names ( ioTyConName, printName, mkInteractiveModule )
 
 import GHC.Utils.Outputable
-import GHC.Utils.Misc
 
 {-
 Note [The interactive package]
@@ -257,7 +256,7 @@ data InteractiveContext
              -- recalculation when the set of imports change.
              -- See Note [icReaderEnv recalculation]
 
-         ic_instances  :: ([ClsInst], [FamInst]),
+         ic_instances  :: (InstEnv, [FamInst]),
              -- ^ All instances and family instances created during
              -- this session.  These are grabbed en masse after each
              -- update to be sure that proper overlapping is retained.
@@ -314,7 +313,7 @@ emptyInteractiveContext dflags
        ic_gre_cache  = emptyIcGlobalRdrEnv,
        ic_mod_index  = 1,
        ic_tythings   = [],
-       ic_instances  = ([],[]),
+       ic_instances  = (emptyInstEnv,[]),
        ic_fix_env    = emptyNameEnv,
        ic_monad      = ioTyConName,  -- IO monad by default
        ic_int_print  = printName,    -- System.IO.print by default
@@ -360,7 +359,7 @@ icPrintUnqual unit_env ictxt = mkPrintUnqualified unit_env (icReaderEnv ictxt)
 -- still keeping the old names in scope in their qualified form (Ghci1.foo).
 extendInteractiveContext :: InteractiveContext
                          -> [TyThing]
-                         -> [ClsInst] -> [FamInst]
+                         -> InstEnv -> [FamInst]
                          -> Maybe [Type]
                          -> FixityEnv
                          -> InteractiveContext
@@ -369,8 +368,8 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
                             -- Always bump this; even instances should create
                             -- a new mod_index (#9426)
           , ic_tythings   = new_tythings ++ ic_tythings ictxt
-          , ic_gre_cache  = ic_gre_cache  ictxt `icExtendIcGblRdrEnv` new_tythings
-          , ic_instances  = ( new_cls_insts ++ old_cls_insts
+          , ic_gre_cache  = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
+          , ic_instances  = ( new_cls_insts `unionInstEnv` old_cls_insts
                             , new_fam_insts ++ fam_insts )
                             -- we don't shadow old family instances (#7102),
                             -- so don't need to remove them here
@@ -381,7 +380,7 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
     -- Discard old instances that have been fully overridden
     -- See Note [Override identical instances in GHCi]
     (cls_insts, fam_insts) = ic_instances ictxt
-    old_cls_insts = filterOut (\i -> any (identicalClsInstHead i) new_cls_insts) cls_insts
+    old_cls_insts = filterInstEnv (\i -> not $ anyInstEnv (identicalClsInstHead i) new_cls_insts) cls_insts
 
 extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveContext
 -- Just a specialised version
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index f95ef3a5d0..5c2f6ff6cc 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -105,6 +105,7 @@ import GHC.Types.Var.Env
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
+import GHC.Types.Unique.DSet
 import GHC.Types.TyThing
 import GHC.Types.BreakInfo
 
@@ -1077,7 +1078,7 @@ getDictionaryBindings theta = do
 findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])]
 findMatchingInstances ty = do
   ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs
-  let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local
+  let allClasses = uniqDSetToList $ instEnvClasses ie_global `unionUniqDSets` instEnvClasses ie_local
   return $ concatMap (try_cls ies) allClasses
   where
   {- Check that a class instance is well-kinded.