Add VarSet.disjointVarSet, and use it

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index d0e55de..2100fc5 100644 (file)
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -54,7 +54,7 @@ foldNameSet      :: (Name -> b -> b) -> b -> NameSet -> b
 filterNameSet     :: (Name -> Bool) -> NameSet -> NameSet
 intersectNameSet   :: NameSet -> NameSet -> NameSet
 intersectsNameSet  :: NameSet -> NameSet -> Bool       -- True if non-empty intersection
-       -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
+       -- (s1 `intersectsNameSet` s2) doesn't compute s2 if s1 is empty
 
 isEmptyNameSet    = isEmptyUniqSet
 emptyNameSet     = emptyUniqSet

diff --git a/compiler/basicTypes/VarSet.lhs b/compiler/basicTypes/VarSet.lhs
index 55e82a8..812213d 100644 (file)
--- a/compiler/basicTypes/VarSet.lhs
+++ b/compiler/basicTypes/VarSet.lhs
@@ -10,7 +10,7 @@ module VarSet (
        extendVarSet, extendVarSetList, extendVarSet_C,
        elemVarSet, varSetElems, subVarSet,
        unionVarSet, unionVarSets,
-       intersectVarSet, intersectsVarSet,
+       intersectVarSet, intersectsVarSet, disjointVarSet,
        isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
        minusVarSet, foldVarSet, filterVarSet,
        lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
@@ -69,9 +69,10 @@ extendVarSetList= addListToUniqSet
 intersectVarSet        = intersectUniqSets
 
 intersectsVarSet:: VarSet -> VarSet -> Bool    -- True if non-empty intersection
-       -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
+disjointVarSet  :: VarSet -> VarSet -> Bool    -- True if empty intersection
 subVarSet      :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second
-       -- (s1 `subVarSet` s2) doesn't compute s2 if s1 is empty
+       -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty; 
+       -- ditto disjointVarSet, subVarSet
 
 unionVarSet    = unionUniqSets
 unionVarSets   = unionManyUniqSets
@@ -94,8 +95,9 @@ elemVarSetByKey       = elemUniqSet_Directly
 
 \begin{code}
 -- See comments with type signatures
-intersectsVarSet s1 s2 = not (isEmptyVarSet (s1 `intersectVarSet` s2))
-a `subVarSet` b = isEmptyVarSet (a `minusVarSet` b)
+intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
+disjointVarSet   s1 s2 = isEmptyVarSet (s1 `intersectVarSet` s2)
+subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
 \end{code}
 
 \begin{code}

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 98fdaf9..c592652 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -773,7 +773,7 @@ isFreeWhenChecking qtvs ips inst
   =  isFreeWrtTyVars qtvs inst
   && isFreeWrtIPs    ips inst
 
-isFreeWrtTyVars qtvs inst = not (tyVarsOfInst inst `intersectsVarSet` qtvs)
+isFreeWrtTyVars qtvs inst = tyVarsOfInst inst `disjointVarSet` qtvs
 isFreeWrtIPs     ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
 \end{code}
 
@@ -2070,7 +2070,7 @@ tc_simplify_top doc use_extended_defaulting want_scs wanteds
                -- up with one of the non-tyvar classes
            (default_gps, non_default_gps) = partition defaultable_group tv_groups
            defaultable_group ds
-               =  not (bad_tyvars `intersectsVarSet` tyVarsOfInst (head ds))
+               =  (bad_tyvars `disjointVarSet` tyVarsOfInst (head ds))
                && defaultable_classes (map get_clas ds)
            defaultable_classes clss 
                | use_extended_defaulting = any isInteractiveClass clss

diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs
index 7872c59..ed6007b 100644 (file)
--- a/compiler/typecheck/TcUnify.lhs
+++ b/compiler/typecheck/TcUnify.lhs
@@ -513,7 +513,7 @@ boxy_match tmpl_tvs orig_tmpl_ty boxy_tvs orig_boxy_ty subst
 
     go (TyVarTy tv) b_ty
        | tv `elemVarSet` tmpl_tvs      -- Template type variable in the template
-       , not (intersectsVarSet boxy_tvs (tyVarsOfType orig_boxy_ty))
+       , boxy_tvs `disjointVarSet` tyVarsOfType orig_boxy_ty
        , typeKind b_ty `isSubKind` tyVarKind tv  -- See Note [Matching kinds]
        = extendTvSubst subst tv boxy_ty'
        | otherwise

diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs
index 7aaf6dd..f4559e7 100644 (file)
--- a/compiler/types/InstEnv.lhs
+++ b/compiler/types/InstEnv.lhs
@@ -475,9 +475,9 @@ lookupInstEnv (pkg_ie, home_ie) cls tys
       = find ms us rest
 
       | otherwise
-      = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs),
-                      (ppr cls <+> ppr tys <+> ppr all_tvs) $$
-                      (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
+      = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
+                (ppr cls <+> ppr tys <+> ppr all_tvs) $$
+                (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
                )
                -- Unification will break badly if the variables overlap
                -- They shouldn't because we allocate separate uniques for them