Commit 477f13bb authored by Simon Jakobi's avatar Simon Jakobi Committed by Marge Bot

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.
parent c05c0659
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
------------------------------------------------------
......
......@@ -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)
......
......@@ -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
{-
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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.*,
......
......@@ -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.
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment