Use Data.IntMap.disjoint

Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1.

This patch applies this function where appropriate in hopes of modest
compiler performance improvements.

Closes #16806.

compiler/GHC/Core/Opt/Specialise.hs

@@ -1141,7 +1141,7 @@ specCase env scrut' case_bndr [(con, args, rhs)]
     is_flt_sc_arg var =  isId var
                       && not (isDeadBinder var)
                       && isDictTy var_ty
-                      && not (tyCoVarsOfType var_ty `intersectsVarSet` arg_set)
+                      && tyCoVarsOfType var_ty `disjointVarSet` arg_set
        where
          var_ty = idType var
 
@@ -2745,7 +2745,7 @@ filterCalls (CIS fn call_bag) dbs
        = extendVarSetList so_far (bindersOf bind)
        | otherwise = so_far
 
-    ok_call (CI { ci_fvs = fvs }) = not (fvs `intersectsVarSet` dump_set)
+    ok_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` dump_set
 
 ----------------------
 splitDictBinds :: Bag DictBind -> IdSet -> (Bag DictBind, Bag DictBind, IdSet)
@@ -2776,7 +2776,7 @@ deleteCallsMentioning :: VarSet -> CallDetails -> CallDetails
 deleteCallsMentioning bs calls
   = mapDVarEnv (ciSetFilter keep_call) calls
   where
-    keep_call (CI { ci_fvs = fvs }) = not (fvs `intersectsVarSet` bs)
+    keep_call (CI { ci_fvs = fvs }) = fvs `disjointVarSet` bs
 
 deleteCallsFor :: [Id] -> CallDetails -> CallDetails
 -- Remove calls *for* bs

compiler/GHC/Core/TyCo/Subst.hs

@@ -383,8 +383,8 @@ extendTCvSubstList subst tvs tys
 unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
 -- Works when the ranges are disjoint
 unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)
-  = ASSERT( not (tenv1 `intersectsVarEnv` tenv2)
-         && not (cenv1 `intersectsVarEnv` cenv2) )
+  = ASSERT( tenv1 `disjointVarEnv` tenv2
+         && cenv1 `disjointVarEnv` cenv2 )
     TCvSubst (in_scope1 `unionInScope` in_scope2)
              (tenv1     `plusVarEnv`   tenv2)
              (cenv1     `plusVarEnv`   cenv2)

compiler/GHC/Core/Type.hs

@@ -2116,7 +2116,7 @@ isValidJoinPointType arity ty
   where
     valid_under tvs arity ty
       | arity == 0
-      = isEmptyVarSet (tvs `intersectVarSet` tyCoVarsOfType ty)
+      = tvs `disjointVarSet` tyCoVarsOfType ty
       | Just (t, ty') <- splitForAllTy_maybe ty
       = valid_under (tvs `extendVarSet` t) (arity-1) ty'
       | Just (_, res_ty) <- splitFunTy_maybe ty

compiler/GHC/Rename/Expr.hs

@@ -1335,7 +1335,7 @@ glomSegments ctxt ((defs,uses,fwds,stmt) : segs)
         = (reverse yeses, reverse noes)
         where
           (noes, yeses)           = span not_needed (reverse dus)
-          not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
+          not_needed (defs,_,_,_) = disjointNameSet defs uses
 
 ----------------------------------------------------
 segsToStmts :: Stmt GhcRn body
@@ -1889,7 +1889,7 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
   -- then we have actually done some splitting. Otherwise it will go into
   -- an infinite loop (#14163).
   go lets indep bndrs ((L loc (BindStmt xbs pat body), fvs): rest)
-    | isEmptyNameSet (bndrs `intersectNameSet` fvs) && not (isStrictPattern pat)
+    | disjointNameSet bndrs fvs && not (isStrictPattern pat)
     = go lets ((L loc (BindStmt xbs pat body), fvs) : indep)
          bndrs' rest
     where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat)
@@ -1899,7 +1899,7 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
   -- TODO: perhaps we shouldn't do this if there are any strict bindings,
   -- because we might be moving evaluation earlier.
   go lets indep bndrs ((L loc (LetStmt noExtField binds), fvs) : rest)
-    | isEmptyNameSet (bndrs `intersectNameSet` fvs)
+    | disjointNameSet bndrs fvs
     = go ((L loc (LetStmt noExtField binds), fvs) : lets) indep bndrs rest
   go _ []  _ _ = Nothing
   go _ [_] _ _ = Nothing

compiler/GHC/Tc/Errors/Hole.hs

@@ -648,8 +648,7 @@ findValidHoleFits tidy_env implics simples h@(Hole { hole_sort = ExprHole _
             ctFreeVarSet = fvVarSet . tyCoFVsOfType . ctPred
             hole_fv_set = fvVarSet hole_fvs
             anyFVMentioned :: Ct -> Bool
-            anyFVMentioned ct = not $ isEmptyVarSet $
-                                  ctFreeVarSet ct `intersectVarSet` hole_fv_set
+            anyFVMentioned ct = ctFreeVarSet ct `intersectsVarSet` hole_fv_set
             -- We filter out those constraints that have no variables (since
             -- they won't be solved by finding a type for the type variable
             -- representing the hole) and also other holes, since we're not

compiler/GHC/Tc/Solver.hs

@@ -2407,7 +2407,7 @@ floatEqualities skols given_ids ev_binds_var no_given_eqs
 
     is_floatable :: VarSet -> Ct -> Bool
     is_floatable skols ct
-      | isDerivedCt ct = not (tyCoVarsOfCt ct `intersectsVarSet` skols)
+      | isDerivedCt ct = tyCoVarsOfCt ct `disjointVarSet` skols
       | otherwise      = not (ctEvId ct `elemVarSet` skols)
 
     add_captured_ev_ids :: Cts -> VarSet -> VarSet

compiler/GHC/Tc/TyCl/Build.hs

@@ -164,8 +164,7 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
         -- stupid theta, taken from the TyCon
 
     arg_tyvars      = tyCoVarsOfTypes arg_tys
-    in_arg_tys pred = not $ isEmptyVarSet $
-                      tyCoVarsOfType pred `intersectVarSet` arg_tyvars
+    in_arg_tys pred = tyCoVarsOfType pred `intersectsVarSet` arg_tyvars
 
 
 ------------------------------------------------------

compiler/GHC/Types/Name/Env.hs

@@ -140,7 +140,7 @@ delFromNameEnv x y      = delFromUFM x y
 delListFromNameEnv x y  = delListFromUFM x y
 filterNameEnv x y       = filterUFM x y
 anyNameEnv f x          = foldUFM ((||) . f) False x
-disjointNameEnv x y     = isNullUFM (intersectUFM x y)
+disjointNameEnv x y     = disjointUFM x y
 
 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
 

compiler/GHC/Types/Name/Occurrence.hs

@@ -90,7 +90,7 @@ module GHC.Types.Name.Occurrence (
         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
         extendOccSetList,
         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,
-        isEmptyOccSet, intersectOccSet, intersectsOccSet,
+        isEmptyOccSet, intersectOccSet,
         filterOccSet,
 
         -- * Tidying up
@@ -449,7 +449,6 @@ minusOccSet       :: OccSet -> OccSet -> OccSet
 elemOccSet        :: OccName -> OccSet -> Bool
 isEmptyOccSet     :: OccSet -> Bool
 intersectOccSet   :: OccSet -> OccSet -> OccSet
-intersectsOccSet  :: OccSet -> OccSet -> Bool
 filterOccSet      :: (OccName -> Bool) -> OccSet -> OccSet
 
 emptyOccSet       = emptyUniqSet
@@ -463,7 +462,6 @@ minusOccSet       = minusUniqSet
 elemOccSet        = elementOfUniqSet
 isEmptyOccSet     = isEmptyUniqSet
 intersectOccSet   = intersectUniqSets
-intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
 filterOccSet      = filterUniqSet
 
 {-

compiler/GHC/Types/Name/Set.hs

@@ -13,7 +13,7 @@ module GHC.Types.Name.Set (
         emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
         minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
         delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
-        intersectsNameSet, intersectNameSet,
+        intersectsNameSet, disjointNameSet, intersectNameSet,
         nameSetAny, nameSetAll, nameSetElemsStable,
 
         -- * Free variables
@@ -69,6 +69,7 @@ delListFromNameSet :: NameSet -> [Name] -> NameSet
 filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet
 intersectNameSet   :: NameSet -> NameSet -> NameSet
 intersectsNameSet  :: NameSet -> NameSet -> Bool
+disjointNameSet    :: NameSet -> NameSet -> Bool
 -- ^ True if there is a non-empty intersection.
 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
 
@@ -85,10 +86,11 @@ elemNameSet       = elementOfUniqSet
 delFromNameSet    = delOneFromUniqSet
 filterNameSet     = filterUniqSet
 intersectNameSet  = intersectUniqSets
+disjointNameSet   = disjointUniqSets
 
 delListFromNameSet set ns = foldl' delFromNameSet set ns
 
-intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
+intersectsNameSet s1 s2 = not (s1 `disjointNameSet` s2)
 
 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
 nameSetAny = uniqSetAny

compiler/GHC/Types/Unique/DFM.hs

@@ -45,7 +45,6 @@ module GHC.Types.Unique.DFM (
         isNullUDFM,
         sizeUDFM,
         intersectUDFM, udfmIntersectUFM,
-        intersectsUDFM,
         disjointUDFM, disjointUdfmUfm,
         equalKeysUDFM,
         minusUDFM,
@@ -320,14 +319,11 @@ udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i
   -- M.intersection is left biased, that means the result will only have
   -- a subset of elements from the left set, so `i` is a good upper bound.
 
-intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
-intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)
-
 disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
-disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)
+disjointUDFM (UDFM x _i) (UDFM y _j) = M.disjoint x y
 
 disjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool
-disjointUdfmUfm (UDFM x _i) y = M.null (M.intersection x (ufmToIntMap y))
+disjointUdfmUfm (UDFM x _i) y = M.disjoint x (ufmToIntMap y)
 
 minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1
 minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i

compiler/GHC/Types/Unique/FM.hs

@@ -241,7 +241,7 @@ intersectUFM_C
 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
 
 disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
-disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
+disjointUFM (UFM x) (UFM y) = M.disjoint x y
 
 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
 foldUFM k z (UFM m) = M.foldr k z m

compiler/GHC/Types/Unique/Set.hs

@@ -27,6 +27,7 @@ module GHC.Types.Unique.Set (
         unionUniqSets, unionManyUniqSets,
         minusUniqSet, uniqSetMinusUFM, uniqSetMinusUDFM,
         intersectUniqSets,
+        disjointUniqSets,
         restrictUniqSetToUFM,
         uniqSetAny, uniqSetAll,
         elementOfUniqSet,
@@ -105,6 +106,9 @@ minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)
 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)
 
+disjointUniqSets :: UniqSet a -> UniqSet a -> Bool
+disjointUniqSets (UniqSet s) (UniqSet t) = disjointUFM s t
+
 restrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a
 restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
 

compiler/GHC/Types/Var/Env.hs

@@ -15,7 +15,7 @@ module GHC.Types.Var.Env (
         plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
         plusVarEnvList, alterVarEnv,
         delVarEnvList, delVarEnv,
-        minusVarEnv, intersectsVarEnv,
+        minusVarEnv,
         lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
         mapVarEnv, zipVarEnv,
         modifyVarEnv, modifyVarEnv_Directly,
@@ -472,7 +472,6 @@ restrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a
 delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
 delVarEnv         :: VarEnv a -> Var -> VarEnv a
 minusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a
-intersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool
 plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 plusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
 plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a
@@ -502,7 +501,6 @@ plusMaybeVarEnv_C = plusMaybeUFM_C
 delVarEnvList    = delListFromUFM
 delVarEnv        = delFromUFM
 minusVarEnv      = minusUFM
-intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
 plusVarEnv       = plusUFM
 plusVarEnvList   = plusUFMList
 lookupVarEnv     = lookupUFM

compiler/ghc.cabal.in

@@ -66,7 +66,7 @@ Library
                    bytestring >= 0.9 && < 0.11,
                    binary     == 0.8.*,
                    time       >= 1.4 && < 1.10,
-                   containers >= 0.5 && < 0.7,
+                   containers >= 0.6.2.1 && < 0.7,
                    array      >= 0.1 && < 0.6,
                    filepath   >= 1   && < 1.5,
                    template-haskell == 2.17.*,

hadrian/src/Rules/Documentation.hs

@@ -103,9 +103,8 @@ documentationRules = do
 
                       -- include toplevel html target unless we neither want
                       -- haddocks nor html pages produced by sphinx.
-                   ++ [ html | Set.size (doctargets `Set.intersection`
-                                         Set.fromList [Haddocks, SphinxHTML]
-                                        ) > 0 ]
+                   ++ [ html |    Haddocks   `Set.member` doctargets
+                               || SphinxHTML `Set.member` doctargets ]
 
                       -- include archives for whatever targets remain from
                       -- the --docs arguments we got.