From 7745c6095145f1be0ca8fff76ef558ca7ad2ebed Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Sat, 23 Sep 2006 03:58:29 +0000
Subject: [PATCH] Add VarSet.disjointVarSet, and use it

---
 compiler/basicTypes/NameSet.lhs   |    2 +-
 compiler/basicTypes/VarSet.lhs    |   12 +++++++-----
 compiler/typecheck/TcSimplify.lhs |    4 ++--
 compiler/typecheck/TcUnify.lhs    |    2 +-
 compiler/types/InstEnv.lhs        |    6 +++---
 5 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index d0e55de..2100fc5 100644
--- 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
--- 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
--- 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
--- 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
--- 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
-- 
1.7.10.4