Commit 3c426b05 authored by niteria's avatar niteria

Add uniqSetAny and uniqSetAll and use them

There are couple of places where we do `foldUniqSet` just to
compute `any` or `all`. `foldUniqSet` is non-deterministic in the
general case and `any` and `all` also read nicer.

Test Plan: ./validate

Reviewers: simonmar, goldfire, simonpj, bgamari, austin

Reviewed By: simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2156

GHC Trac Issues: #4012
parent b0569e88
......@@ -13,6 +13,7 @@ module NameSet (
minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList,
delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
intersectsNameSet, intersectNameSet,
nameSetAny, nameSetAll,
-- * Free variables
FreeVars,
......@@ -85,6 +86,12 @@ delListFromNameSet set ns = foldl delFromNameSet set ns
intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
nameSetAny :: (Name -> Bool) -> NameSet -> Bool
nameSetAny = uniqSetAny
nameSetAll :: (Name -> Bool) -> NameSet -> Bool
nameSetAll = uniqSetAll
{-
************************************************************************
* *
......
......@@ -17,6 +17,7 @@ module VarSet (
intersectVarSet, intersectsVarSet, disjointVarSet,
isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
minusVarSet, foldVarSet, filterVarSet,
varSetAny, varSetAll,
transCloVarSet, fixVarSet,
lookupVarSet, lookupVarSetByName,
mapVarSet, sizeVarSet, seqVarSet,
......@@ -134,6 +135,12 @@ intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
disjointVarSet s1 s2 = disjointUFM s1 s2
subVarSet s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
varSetAny :: (Var -> Bool) -> VarSet -> Bool
varSetAny = uniqSetAny
varSetAll :: (Var -> Bool) -> VarSet -> Bool
varSetAll = uniqSetAll
fixVarSet :: (VarSet -> VarSet) -- Map the current set to a new set
-> VarSet -> VarSet
-- (fixVarSet f s) repeatedly applies f to the set s,
......
......@@ -1420,8 +1420,7 @@ addBootDeps ds_w_fvs
| otherwise = pr
has_local_imports fvs
= foldNameSet ((||) . nameIsHomePackageImport this_mod)
False fvs
= nameSetAny (nameIsHomePackageImport this_mod) fvs
; return (add_boot_deps ds_w_fvs) }
......
......@@ -855,7 +855,7 @@ match_alts _ _ _ _
------------------------------------------
okToFloat :: RnEnv2 -> VarSet -> Bool
okToFloat rn_env bind_fvs
= foldVarSet ((&&) . not_captured) True bind_fvs
= varSetAll not_captured bind_fvs
where
not_captured fv = not (inRnEnvR rn_env fv)
......
......@@ -1973,7 +1973,7 @@ isClosedBndrGroup binds = do
fvs _ = emptyNameSet
is_closed_ns :: TcTypeEnv -> NameSet -> Bool -> Bool
is_closed_ns type_env ns b = foldNameSet ((&&) . is_closed_id type_env) b ns
is_closed_ns type_env ns b = b && nameSetAll (is_closed_id type_env) ns
-- ns are the Names referred to from the RHS of this bind
is_closed_id :: TcTypeEnv -> Name -> Bool
......
......@@ -2328,7 +2328,7 @@ pprPotentials dflags sty herald insts
-- are lexically in scope; these instances are likely
-- to be more useful
inst_in_scope :: ClsInst -> Bool
inst_in_scope cls_inst = foldNameSet ((&&) . name_in_scope) True $
inst_in_scope cls_inst = nameSetAll name_in_scope $
orphNamesOfTypes (is_tys cls_inst)
name_in_scope name
......
......@@ -454,7 +454,7 @@ niFixTCvSubst tenv = f tenv
| not_fixpoint = f (mapVarEnv (substTy subst') tenv)
| otherwise = subst
where
not_fixpoint = foldVarSet ((||) . in_domain) False range_tvs
not_fixpoint = varSetAny in_domain range_tvs
in_domain tv = tv `elemVarEnv` tenv
range_tvs = foldVarEnv (unionVarSet . tyCoVarsOfType) emptyVarSet tenv
......@@ -1140,7 +1140,7 @@ ty_co_match menv subst ty co lkco rkco
= noneSet (\v -> elemVarEnv v env) set
noneSet :: (Var -> Bool) -> VarSet -> Bool
noneSet f = foldVarSet (\v rest -> rest && (not $ f v)) True
noneSet f = varSetAll (not . f)
ty_co_match menv subst ty co lkco rkco
| CastTy ty' co' <- ty
......
......@@ -56,7 +56,7 @@ module UniqFM (
intersectUFM,
intersectUFM_C,
disjointUFM,
foldUFM, foldUFM_Directly,
foldUFM, foldUFM_Directly, anyUFM, allUFM,
mapUFM, mapUFM_Directly,
elemUFM, elemUFM_Directly,
filterUFM, filterUFM_Directly, partitionUFM,
......@@ -275,6 +275,8 @@ intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
foldUFM k z (UFM m) = M.fold k z m
foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
mapUFM f (UFM m) = UFM (M.map f m)
mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
......@@ -298,6 +300,12 @@ eltsUFM (UFM m) = M.elems m
ufmToSet_Directly (UFM m) = M.keysSet m
ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
anyUFM p (UFM m) = M.fold ((||) . p) False m
allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
allUFM p (UFM m) = M.fold ((&&) . p) True m
ufmToIntMap :: UniqFM elt -> M.IntMap elt
ufmToIntMap (UFM m) = m
......
......@@ -22,7 +22,7 @@ module UniqSet (
unionUniqSets, unionManyUniqSets,
minusUniqSet,
intersectUniqSets,
foldUniqSet,
foldUniqSet, uniqSetAny, uniqSetAll,
mapUniqSet,
elementOfUniqSet,
elemUniqSet_Directly,
......@@ -113,3 +113,9 @@ sizeUniqSet = sizeUFM
isEmptyUniqSet = isNullUFM
lookupUniqSet = lookupUFM
uniqSetToList = eltsUFM
uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool
uniqSetAny = anyUFM
uniqSetAll :: (a -> Bool) -> UniqSet a -> Bool
uniqSetAll = allUFM
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