| otherwise = setIdSpecialisation id spec_env'
in
if not_in_scope then
- -- No need to clone
+ -- No need to clone, but we *must* zap any current substitution
+ -- for the variable. For example:
+ -- (\x.e) with id_subst = [x |-> e']
+ -- Here we must simply zap the substitution for x
let
- env' = setIdEnv env (new_in_scope_ids id2, id_subst)
+ env' = setIdEnv env (new_in_scope_ids id2,
+ delOneFromIdEnv id_subst id)
in
returnSmpl (env', id2)
else
\begin{code}
simplTyBinder :: SimplEnv -> TyVar -> SmplM (SimplEnv, TyVar)
simplTyBinder env tyvar
- | not (tyvar `elementOfTyVarSet` tyvars) -- No need to clone
- = let
- env' = setTyEnv env (tyvars `addOneToTyVarSet` tyvar, ty_subst)
+ | not (tyvar `elementOfTyVarSet` tyvars)
+ = -- No need to clone; but must zap any binding for tyvar
+ -- see comments with simplBinder above
+ let
+ env' = setTyEnv env (tyvars `addOneToTyVarSet` tyvar,
+ delFromTyVarEnv ty_subst tyvar)
in
returnSmpl (env', tyvar)
emptyTyVarSet, unitTyVarSet, unionTyVarSets, addOneToTyVarSet,
unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
- isEmptyTyVarSet
+ isEmptyTyVarSet, delOneFromTyVarSet
) where
#include "HsVersions.h"
-- others
import UniqSet -- nearly all of it
-import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM,
+import UniqFM ( emptyUFM, listToUFM, addToUFM, lookupUFM, delFromUFM,
plusUFM, sizeUFM, delFromUFM, isNullUFM, UniqFM
)
import BasicTypes ( Unused, unused )
isEmptyTyVarSet :: GenTyVarSet flexi -> Bool
mkTyVarSet :: [GenTyVar flexi] -> GenTyVarSet flexi
addOneToTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
+delOneFromTyVarSet :: GenTyVarSet flexi -> GenTyVar flexi -> GenTyVarSet flexi
emptyTyVarSet = emptyUniqSet
unitTyVarSet = unitUniqSet
addOneToTyVarSet = addOneToUniqSet
+delOneFromTyVarSet = delOneFromUniqSet
intersectTyVarSets= intersectUniqSets
unionTyVarSets = unionUniqSets
unionManyTyVarSets= unionManyUniqSets
UniqSet, -- abstract type: NOT
mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
- addOneToUniqSet, addListToUniqSet,
+ addOneToUniqSet, addListToUniqSet, delOneFromUniqSet,
unionUniqSets, unionManyUniqSets, minusUniqSet,
elementOfUniqSet, mapUniqSet, intersectUniqSets,
isEmptyUniqSet, filterUniqSet, sizeUniqSet
addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
+delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
+delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
+
addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])