Commit bc86223d authored by simonpj's avatar simonpj

[project @ 1998-03-20 21:17:43 by simonpj]

Substitution bug in simplifier fixed
parent 54d11c27
......@@ -201,9 +201,13 @@ simplBinder env (id, occ_info)
| 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
......@@ -237,9 +241,12 @@ simplBinders env binders = mapAccumLSmpl simplBinder env binders
\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)
......
......@@ -21,7 +21,7 @@ module TyVar (
emptyTyVarSet, unitTyVarSet, unionTyVarSets, addOneToTyVarSet,
unionManyTyVarSets, intersectTyVarSets, mkTyVarSet,
tyVarSetToList, elementOfTyVarSet, minusTyVarSet,
isEmptyTyVarSet
isEmptyTyVarSet, delOneFromTyVarSet
) where
#include "HsVersions.h"
......@@ -31,7 +31,7 @@ import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
-- 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 )
......@@ -149,10 +149,12 @@ minusTyVarSet :: GenTyVarSet flexi -> GenTyVarSet flexi -> GenTyVarSet flexi
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
......
......@@ -12,7 +12,7 @@ module UniqSet (
UniqSet, -- abstract type: NOT
mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
addOneToUniqSet, addListToUniqSet,
addOneToUniqSet, addListToUniqSet, delOneFromUniqSet,
unionUniqSets, unionManyUniqSets, minusUniqSet,
elementOfUniqSet, mapUniqSet, intersectUniqSets,
isEmptyUniqSet, filterUniqSet, sizeUniqSet
......@@ -63,6 +63,9 @@ mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
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])
......
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