Commit 7745c609 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Add VarSet.disjointVarSet, and use it

parent f37e239f
......@@ -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
......
......@@ -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}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
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