projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
f37e239
)
Add VarSet.disjointVarSet, and use it
author
simonpj@microsoft.com
<unknown>
Sat, 23 Sep 2006 03:58:29 +0000
(
03:58
+0000)
committer
simonpj@microsoft.com
<unknown>
Sat, 23 Sep 2006 03:58:29 +0000
(
03:58
+0000)
compiler/basicTypes/NameSet.lhs
patch
|
blob
|
history
compiler/basicTypes/VarSet.lhs
patch
|
blob
|
history
compiler/typecheck/TcSimplify.lhs
patch
|
blob
|
history
compiler/typecheck/TcUnify.lhs
patch
|
blob
|
history
compiler/types/InstEnv.lhs
patch
|
blob
|
history
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
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
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,
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,
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
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
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
unionVarSet = unionUniqSets
unionVarSets = unionManyUniqSets
@@
-94,8
+95,9
@@
elemVarSetByKey = elemUniqSet_Directly
\begin{code}
-- See comments with type signatures
\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}
\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
&& 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}
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
-- 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
&& 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
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
, 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
= 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
)
-- Unification will break badly if the variables overlap
-- They shouldn't because we allocate separate uniques for them