Add uniqSetAny and uniqSetAll and use them
authorBartosz Nitka <niteria@gmail.com>
Thu, 28 Apr 2016 20:32:39 +0000 (13:32 -0700)
committerBartosz Nitka <niteria@gmail.com>
Thu, 28 Apr 2016 20:32:58 +0000 (13:32 -0700)
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

compiler/basicTypes/NameSet.hs
compiler/basicTypes/VarSet.hs
compiler/rename/RnSource.hs
compiler/specialise/Rules.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcErrors.hs
compiler/types/Unify.hs
compiler/utils/UniqFM.hs
compiler/utils/UniqSet.hs

index 574c3a4..b332fe2 100644 (file)
@@ -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
+
 {-
 ************************************************************************
 *                                                                      *
index f61bbbe..57369f3 100644 (file)
@@ -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,
index eb1494f..f92bae9 100644 (file)
@@ -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) }
 
 
index 3adad1c..f9f195f 100644 (file)
@@ -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)
 
index ac19061..aef80a8 100644 (file)
@@ -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
index b51a267..78320c4 100644 (file)
@@ -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
index dadb8e3..381f948 100644 (file)
@@ -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
index 10cc179..ed82fee 100644 (file)
@@ -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
 
index a3d503f..c1d19b3 100644 (file)
@@ -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