[commit: ghc] wip/spj-early-inline: Add VarSet.anyDVarSet, allDVarSet (3f346ea)

git at git.haskell.org git at git.haskell.org
Fri Feb 17 16:28:33 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/spj-early-inline
Link       : http://ghc.haskell.org/trac/ghc/changeset/3f346eac06399a79adf48425018ee949cee245bf/ghc

>---------------------------------------------------------------

commit 3f346eac06399a79adf48425018ee949cee245bf
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Feb 17 12:17:08 2017 +0000

    Add VarSet.anyDVarSet, allDVarSet
    
    I need these in a later commit.
    
    Also rename
      varSetAny  -->  anyVarSet
      varSetAll  -->  allVarSet
    for consistency with other functions; eg filterVarSet


>---------------------------------------------------------------

3f346eac06399a79adf48425018ee949cee245bf
 compiler/basicTypes/VarSet.hs | 18 ++++++++++++------
 compiler/specialise/Rules.hs  |  2 +-
 compiler/typecheck/TcType.hs  |  2 +-
 compiler/types/Unify.hs       |  4 ++--
 4 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index a6e508a..a95e369 100644
--- a/compiler/basicTypes/VarSet.hs
+++ b/compiler/basicTypes/VarSet.hs
@@ -17,7 +17,7 @@ module VarSet (
         intersectVarSet, intersectsVarSet, disjointVarSet,
         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
         minusVarSet, filterVarSet,
-        varSetAny, varSetAll,
+        anyVarSet, allVarSet,
         transCloVarSet, fixVarSet,
         lookupVarSet, lookupVarSetByName,
         sizeVarSet, seqVarSet,
@@ -35,7 +35,7 @@ module VarSet (
         intersectDVarSet, intersectsDVarSet, disjointDVarSet,
         isEmptyDVarSet, delDVarSet, delDVarSetList,
         minusDVarSet, foldDVarSet, filterDVarSet,
-        dVarSetMinusVarSet,
+        dVarSetMinusVarSet, anyDVarSet, allDVarSet,
         transCloDVarSet,
         sizeDVarSet, seqDVarSet,
         partitionDVarSet,
@@ -139,11 +139,11 @@ 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
+anyVarSet :: (Var -> Bool) -> VarSet -> Bool
+anyVarSet = uniqSetAny
 
-varSetAll :: (Var -> Bool) -> VarSet -> Bool
-varSetAll = uniqSetAll
+allVarSet :: (Var -> Bool) -> VarSet -> Bool
+allVarSet = uniqSetAll
 
 -- There used to exist mapVarSet, see Note [Unsound mapUniqSet] in UniqSet for
 -- why it got removed.
@@ -282,6 +282,12 @@ dVarSetMinusVarSet = uniqDSetMinusUniqSet
 foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
 foldDVarSet = foldUniqDSet
 
+anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
+anyDVarSet p = foldDVarSet ((||) . p) False
+
+allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
+allDVarSet p = foldDVarSet ((&&) . p) True
+
 filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
 filterDVarSet = filterUniqDSet
 
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index 0bd9166..e95c5ff 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -858,7 +858,7 @@ match_alts _ _ _ _
 ------------------------------------------
 okToFloat :: RnEnv2 -> VarSet -> Bool
 okToFloat rn_env bind_fvs
-  = varSetAll not_captured bind_fvs
+  = allVarSet not_captured bind_fvs
   where
     not_captured fv = not (inRnEnvR rn_env fv)
 
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index a0ca0b2..97e5e15 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -909,7 +909,7 @@ anyRewritableTyVar ignore_cos pred ty
 
     go_co bound co
       | ignore_cos = False
-      | otherwise  = varSetAny (go_tv bound) (tyCoVarsOfCo co)
+      | otherwise  = anyVarSet (go_tv bound) (tyCoVarsOfCo co)
       -- We don't have an equivalent of anyRewritableTyVar for coercions
       -- (at least not yet) so take the free vars and test them
 
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 0ee895a..6061319 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -522,7 +522,7 @@ niFixTCvSubst tenv = f tenv
         | not_fixpoint = f (mapVarEnv (substTy subst') tenv)
         | otherwise    = subst
         where
-          not_fixpoint  = varSetAny in_domain range_tvs
+          not_fixpoint  = anyVarSet in_domain range_tvs
           in_domain tv  = tv `elemVarEnv` tenv
 
           range_tvs     = nonDetFoldUFM (unionVarSet . tyCoVarsOfType) emptyVarSet tenv
@@ -1223,7 +1223,7 @@ ty_co_match menv subst ty co lkco rkco
       = noneSet (\v -> elemVarEnv v env) set
 
     noneSet :: (Var -> Bool) -> VarSet -> Bool
-    noneSet f = varSetAll (not . f)
+    noneSet f = allVarSet (not . f)
 
 ty_co_match menv subst ty co lkco rkco
   | CastTy ty' co' <- ty



More information about the ghc-commits mailing list