X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FSubst.lhs;h=186695684c38da26ecaae6f1260537b46e50812b;hb=cc7a860218aba326cfcc0503e31329e06f97d60b;hp=cc473cd0635f28435207232f7b23820535f11486;hpb=266fadd93461d4317967df08cd641e965cd8769a;p=ghc-hetmet.git diff --git a/ghc/compiler/coreSyn/Subst.lhs b/ghc/compiler/coreSyn/Subst.lhs index cc473cd..1866956 100644 --- a/ghc/compiler/coreSyn/Subst.lhs +++ b/ghc/compiler/coreSyn/Subst.lhs @@ -6,14 +6,19 @@ \begin{code} module Subst ( -- In-scope set - InScopeSet, emptyInScopeSet, - lookupInScope, setInScope, extendInScope, extendInScopes, isInScope, modifyInScope, + InScopeSet, emptyInScopeSet, mkInScopeSet, + extendInScopeSet, extendInScopeSetList, + lookupInScope, elemInScopeSet, uniqAway, + -- Substitution stuff Subst, TyVarSubst, IdSubst, emptySubst, mkSubst, substEnv, substInScope, lookupSubst, lookupIdSubst, isEmptySubst, extendSubst, extendSubstList, zapSubstEnv, setSubstEnv, + setInScope, + extendInScope, extendInScopeList, extendNewInScope, extendNewInScopeList, + isInScope, modifyInScope, bindSubst, unBindSubst, bindSubstList, unBindSubstList, @@ -31,40 +36,125 @@ module Subst ( #include "HsVersions.h" -import CoreSyn ( Expr(..), Bind(..), Note(..), CoreExpr, CoreBndr, +import CmdLineOpts ( opt_PprStyle_Debug ) +import CoreSyn ( Expr(..), Bind(..), Note(..), CoreExpr, CoreRules(..), CoreRule(..), - emptyCoreRules, isEmptyCoreRules, seqRules + isEmptyCoreRules, seqRules ) -import CoreFVs ( exprFreeVars ) -import TypeRep ( Type(..), TyNote(..), - ) -- friend +import CoreFVs ( exprFreeVars, mustHaveLocalBinding ) +import TypeRep ( Type(..), TyNote(..) ) -- friend import Type ( ThetaType, PredType(..), ClassContext, - tyVarsOfType, tyVarsOfTypes, mkAppTy + tyVarsOfType, tyVarsOfTypes, mkAppTy, mkUTy, isUTy ) import VarSet import VarEnv import Var ( setVarUnique, isId ) -import Id ( idType, setIdType, getIdOccInfo, zapFragileIdInfo ) -import Name ( isLocallyDefined ) -import IdInfo ( IdInfo, isFragileOccInfo, +import Id ( idType, setIdType, idOccInfo, zapFragileIdInfo, maybeModifyIdInfo ) +import IdInfo ( IdInfo, isFragileOcc, specInfo, setSpecInfo, - workerExists, workerInfo, setWorkerInfo, WorkerInfo + WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo, + lbvarInfo, LBVarInfo(..), setLBVarInfo ) +import Unique ( Uniquable(..), deriveUnique ) +import UniqSet ( elemUniqSet_Directly ) import UniqSupply ( UniqSupply, uniqFromSupply, splitUniqSupply ) -import Var ( Var, IdOrTyVar, Id, TyVar, isTyVar ) +import Var ( Var, Id, TyVar, isTyVar ) import Outputable +import PprCore () -- Instances +import UniqFM ( ufmToList ) -- Yuk (add a new op to VarEnv) import Util ( mapAccumL, foldl2, seqList, ($!) ) +import FastTypes \end{code} + %************************************************************************ %* * -\subsection{Substitutions} +\subsection{The in-scope set} %* * %************************************************************************ \begin{code} -type InScopeSet = VarEnv Var +data InScopeSet = InScope (VarEnv Var) FastInt + -- The Int# is a kind of hash-value used by uniqAway + -- For example, it might be the size of the set + -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway + +emptyInScopeSet :: InScopeSet +emptyInScopeSet = InScope emptyVarSet 1# + +mkInScopeSet :: VarEnv Var -> InScopeSet +mkInScopeSet in_scope = InScope in_scope 1# + +extendInScopeSet :: InScopeSet -> Var -> InScopeSet +extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#) + +extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet +extendInScopeSetList (InScope in_scope n) vs + = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs) + (n +# iUnbox (length vs)) + +modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet +-- Exploit the fact that the in-scope "set" is really a map +-- Make old_v map to new_v +modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#) + +delInScopeSet :: InScopeSet -> Var -> InScopeSet +delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n + +elemInScopeSet :: Var -> InScopeSet -> Bool +elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope + +lookupInScope :: InScopeSet -> Var -> Var +-- It's important to look for a fixed point +-- When we see (case x of y { I# v -> ... }) +-- we add [x -> y] to the in-scope set (Simplify.simplCaseBinder). +-- When we lookup up an occurrence of x, we map to y, but then +-- we want to look up y in case it has acquired more evaluation information by now. +lookupInScope (InScope in_scope n) v + = go v + where + go v = case lookupVarEnv in_scope v of + Just v' | v == v' -> v' -- Reached a fixed point + | otherwise -> go v' + Nothing -> WARN( mustHaveLocalBinding v, ppr v ) + v +\end{code} + +\begin{code} +uniqAway :: InScopeSet -> Var -> Var +-- (uniqAway in_scope v) finds a unique that is not used in the +-- in-scope set, and gives that to v. It starts with v's current unique, of course, +-- in the hope that it won't have to change it, nad thereafter uses a combination +-- of that and the hash-code found in the in-scope set +uniqAway (InScope set n) var + | not (var `elemVarSet` set) = var -- Nothing to do + | otherwise = try 1# + where + orig_unique = getUnique var + try k +#ifdef DEBUG + | k ># 1000# + = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) +#endif + | uniq `elemUniqSet_Directly` set = try (k +# 1#) +#ifdef DEBUG + | opt_PprStyle_Debug && k ># 3# + = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) + setVarUnique var uniq +#endif + | otherwise = setVarUnique var uniq + where + uniq = deriveUnique orig_unique (iBox (n *# k)) +\end{code} + +%************************************************************************ +%* * +\subsection{Substitutions} +%* * +%************************************************************************ + +\begin{code} data Subst = Subst InScopeSet -- In scope SubstEnv -- Substitution itself -- INVARIANT 1: The (domain of the) in-scope set is a superset @@ -81,7 +171,17 @@ data Subst = Subst InScopeSet -- In scope -- -- INVARIANT 2: No variable is both in scope and in the domain of the substitution -- Equivalently, the substitution is idempotent - -- + -- [Sep 2000: Lies, all lies. The substitution now does contain + -- mappings x77 -> DoneId x77 occ + -- to record x's occurrence information.] + -- [Also watch out: the substitution can contain x77 -> DoneEx (Var x77) + -- Consider let x = case k of I# x77 -> ... in + -- let y = case k of I# x77 -> ... in ... + -- and suppose the body is strict in both x and y. Then the simplifier + -- will pull the first (case k) to the top; so the second (case k) will + -- cancel out, mapping x77 to, well, x77! But one is an in-Id and the + -- other is an out-Id. So the substitution is idempotent in the sense + -- that we *must not* repeatedly apply it.] type IdSubst = Subst \end{code} @@ -93,9 +193,13 @@ The general plan about the substitution and in-scope set for Ids is as follows That is added back in later. So new_id is the minimal thing it's correct to substitute. -* substId adds a binding (DoneVar new_id occ) to the substitution if +* substId adds a binding (DoneId new_id occ) to the substitution if EITHER the Id's unique has changed OR the Id has interesting occurrence information + So in effect you can only get to interesting occurrence information + by looking up the *old* Id; it's not really attached to the new id + at all. + Note, though that the substitution isn't necessarily extended if the type changes. Why not? Because of the next point: @@ -120,15 +224,6 @@ The general plan about the substitution and in-scope set for Ids is as follows case y of x { ... } That's why the "set" is actually a VarEnv Var -\begin{code} -emptyInScopeSet :: InScopeSet -emptyInScopeSet = emptyVarSet - -add_in_scope :: InScopeSet -> Var -> InScopeSet -add_in_scope in_scope v = extendVarEnv in_scope v v -\end{code} - - \begin{code} isEmptySubst :: Subst -> Bool @@ -150,10 +245,12 @@ zapSubstEnv :: Subst -> Subst zapSubstEnv (Subst in_scope env) = Subst in_scope emptySubstEnv extendSubst :: Subst -> Var -> SubstResult -> Subst -extendSubst (Subst in_scope env) v r = Subst in_scope (extendSubstEnv env v r) +extendSubst (Subst in_scope env) v r = UASSERT( case r of { DoneTy ty -> not (isUTy ty) ; _ -> True } ) + Subst in_scope (extendSubstEnv env v r) extendSubstList :: Subst -> [Var] -> [SubstResult] -> Subst -extendSubstList (Subst in_scope env) v r = Subst in_scope (extendSubstEnvList env v r) +extendSubstList (Subst in_scope env) v r = UASSERT( all (\ r1 -> case r1 of { DoneTy ty -> not (isUTy ty) ; _ -> True }) r ) + Subst in_scope (extendSubstEnvList env v r) lookupSubst :: Subst -> Var -> Maybe SubstResult lookupSubst (Subst _ env) v = lookupSubstEnv env v @@ -162,38 +259,49 @@ lookupIdSubst :: Subst -> Id -> SubstResult -- Does the lookup in the in-scope set too lookupIdSubst (Subst in_scope env) v = case lookupSubstEnv env v of - Just (DoneId v' occ) -> case lookupVarEnv in_scope v' of - Just v'' -> DoneId v'' occ - Nothing -> DoneId v' occ + Just (DoneId v' occ) -> DoneId (lookupInScope in_scope v') occ Just res -> res - Nothing -> DoneId v' (getIdOccInfo v') + Nothing -> DoneId v' (idOccInfo v') + -- We don't use DoneId for LoopBreakers, so the idOccInfo is + -- very important! If isFragileOcc returned True for + -- loop breakers we could avoid this call, but at the expense + -- of adding more to the substitution, and building new Ids + -- in substId a bit more often than really necessary where - v' = case lookupVarEnv in_scope v of - Just v' -> v' - Nothing -> v - -lookupInScope :: Subst -> Var -> Maybe Var -lookupInScope (Subst in_scope _) v = lookupVarEnv in_scope v + v' = lookupInScope in_scope v isInScope :: Var -> Subst -> Bool -isInScope v (Subst in_scope _) = v `elemVarEnv` in_scope - -extendInScope :: Subst -> Var -> Subst -extendInScope (Subst in_scope env) v = Subst (in_scope `add_in_scope` v) env +isInScope v (Subst in_scope _) = v `elemInScopeSet` in_scope modifyInScope :: Subst -> Var -> Var -> Subst -modifyInScope (Subst in_scope env) old_v new_v = Subst (extendVarEnv in_scope old_v new_v) env +modifyInScope (Subst in_scope env) old_v new_v = Subst (modifyInScopeSet in_scope old_v new_v) env -- make old_v map to new_v -extendInScopes :: Subst -> [Var] -> Subst -extendInScopes (Subst in_scope env) vs = Subst (foldl add_in_scope in_scope vs) env +extendInScope :: Subst -> Var -> Subst + -- Add a new variable as in-scope + -- Remember to delete any existing binding in the substitution! +extendInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v) + (env `delSubstEnv` v) + +extendInScopeList :: Subst -> [Var] -> Subst +extendInScopeList (Subst in_scope env) vs = Subst (extendInScopeSetList in_scope vs) + (delSubstEnvList env vs) + +-- The "New" variants are guaranteed to be adding freshly-allocated variables +-- It's not clear that the gain (not needing to delete it from the substitution) +-- is worth the extra proof obligation +extendNewInScope :: Subst -> Var -> Subst +extendNewInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v) env + +extendNewInScopeList :: Subst -> [Var] -> Subst +extendNewInScopeList (Subst in_scope env) vs = Subst (in_scope `extendInScopeSetList` vs) env ------------------------------- bindSubst :: Subst -> Var -> Var -> Subst -- Extend with a substitution, v1 -> Var v2 -- and extend the in-scopes with v2 bindSubst (Subst in_scope env) old_bndr new_bndr - = Subst (in_scope `add_in_scope` new_bndr) + = Subst (in_scope `extendInScopeSet` new_bndr) (extendSubstEnv env old_bndr subst_result) where subst_result | isId old_bndr = DoneEx (Var new_bndr) @@ -203,7 +311,7 @@ unBindSubst :: Subst -> Var -> Var -> Subst -- Reverse the effect of bindSubst -- If old_bndr was already in the substitution, this doesn't quite work unBindSubst (Subst in_scope env) old_bndr new_bndr - = Subst (in_scope `delVarEnv` new_bndr) (delSubstEnv env old_bndr) + = Subst (in_scope `delInScopeSet` new_bndr) (delSubstEnv env old_bndr) -- And the "List" forms bindSubstList :: Subst -> [Var] -> [Var] -> Subst @@ -228,6 +336,25 @@ setSubstEnv :: Subst -- Take in-scope part from here setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2 \end{code} +Pretty printing, for debugging only + +\begin{code} +instance Outputable SubstResult where + ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e + ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v + ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e + ppr (DoneTy t) = ptext SLIT("DoneTy") <+> ppr t + +instance Outputable SubstEnv where + ppr se = brackets (fsep (punctuate comma (map ppr_elt (ufmToList (substEnvEnv se))))) + where + ppr_elt (uniq,sr) = ppr uniq <+> ptext SLIT("->") <+> ppr sr + +instance Outputable Subst where + ppr (Subst (InScope in_scope _) se) + = ptext SLIT(" braces (fsep (map ppr (rngVarEnv in_scope))) + $$ ptext SLIT(" Subst =") <+> ppr se <> char '>' +\end{code} %************************************************************************ %* * @@ -236,14 +363,14 @@ setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2 %************************************************************************ \begin{code} -type TyVarSubst = Subst -- TyVarSubst are expected to have range elements +type TyVarSubst = Subst -- TyVarSubst are expected to have range elements -- (We could have a variant of Subst, but it doesn't seem worth it.) -- mkTyVarSubst generates the in-scope set from -- the types given; but it's just a thunk so with a bit of luck -- it'll never be evaluated mkTyVarSubst :: [TyVar] -> [Type] -> Subst -mkTyVarSubst tyvars tys = Subst (tyVarsOfTypes tys) (zip_ty_env tyvars tys emptySubstEnv) +mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys)) (zip_ty_env tyvars tys emptySubstEnv) -- mkTopTyVarSubst is called when doing top-level substitutions. -- Here we expect that the free vars of the range of the @@ -252,7 +379,8 @@ mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv) zip_ty_env [] [] env = env -zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty)) +zip_ty_env (tv:tvs) (ty:tys) env = UASSERT( not (isUTy ty) ) + zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty)) \end{code} substTy works with general Substs, so that it can be called from substExpr too. @@ -279,21 +407,24 @@ substPred subst (IParam n ty) = IParam n (subst_ty subst ty) subst_ty subst ty = go ty where - go (TyConApp tc tys) = let args = map go tys - in args `seqList` TyConApp tc args - go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2) - go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note - go (FunTy arg res) = (FunTy $! (go arg)) $! (go res) - go (NoteTy (UsgNote usg) ty2) = (NoteTy $! UsgNote usg) $! go ty2 -- Keep usage annot - go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2 -- Keep uvar bdr - go (NoteTy (IPNote nm) ty2) = (NoteTy $! IPNote nm) $! go ty2 -- Keep ip note - go (AppTy fun arg) = mkAppTy (go fun) $! (go arg) - go ty@(TyVarTy tv) = case (lookupSubst subst tv) of + go (TyConApp tc tys) = let args = map go tys + in args `seqList` TyConApp tc args + + go (PredTy p) = PredTy $! (substPred subst p) + + go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2) + go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note + + go (FunTy arg res) = (FunTy $! (go arg)) $! (go res) + go (AppTy fun arg) = mkAppTy (go fun) $! (go arg) + go ty@(TyVarTy tv) = case (lookupSubst subst tv) of Nothing -> ty Just (DoneTy ty') -> ty' - go (ForAllTy tv ty) = case substTyVar subst tv of + go (ForAllTy tv ty) = case substTyVar subst tv of (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty) + + go (UsageTy u ty) = mkUTy (go u) $! (go ty) \end{code} Here is where we invent a new binder if necessary. @@ -309,7 +440,7 @@ substTyVar subst@(Subst in_scope env) old_var -- -- The new_id isn't cloned, but it may have a different type -- etc, so we must return it, not the old id - = (Subst (in_scope `add_in_scope` new_var) + = (Subst (in_scope `extendInScopeSet` new_var) (delSubstEnv env old_var), new_var) @@ -318,7 +449,7 @@ substTyVar subst@(Subst in_scope env) old_var -- Extending the substitution to do this renaming also -- has the (correct) effect of discarding any existing -- substitution for that variable - = (Subst (in_scope `add_in_scope` new_var) + = (Subst (in_scope `extendInScopeSet` new_var) (extendSubstEnv env old_var (DoneTy (TyVarTy new_var))), new_var) where @@ -363,7 +494,7 @@ substExpr subst expr DoneEx e' -> e' go (Type ty) = Type (go_ty ty) - go (Con con args) = Con con (map go args) + go (Lit lit) = Lit lit go (App fun arg) = App (go fun) (go arg) go (Note note e) = Note (go_note note) (go e) @@ -403,12 +534,12 @@ When we hit a binder we may need to (c) give it a new unique to avoid name clashes \begin{code} -substBndr :: Subst -> IdOrTyVar -> (Subst, IdOrTyVar) +substBndr :: Subst -> Var -> (Subst, Var) substBndr subst bndr | isTyVar bndr = substTyVar subst bndr | otherwise = substId subst bndr -substBndrs :: Subst -> [IdOrTyVar] -> (Subst, [IdOrTyVar]) +substBndrs :: Subst -> [Var] -> (Subst, [Var]) substBndrs subst bndrs = mapAccumL substBndr subst bndrs @@ -421,10 +552,10 @@ substId :: Subst -> Id -> (Subst, Id) -- top of this module substId subst@(Subst in_scope env) old_id - = (Subst (in_scope `add_in_scope` new_id) new_env, new_id) + = (Subst (in_scope `extendInScopeSet` new_id) new_env, new_id) where id_ty = idType old_id - occ_info = getIdOccInfo old_id + occ_info = idOccInfo old_id -- id1 has its type zapped id1 | noTypeSubst env @@ -437,13 +568,18 @@ substId subst@(Subst in_scope env) old_id -- id2 has its IdInfo zapped id2 = zapFragileIdInfo id1 - -- new_id is cloned if necessary - new_id = uniqAway in_scope id2 + -- id3 has its LBVarInfo zapped + id3 = maybeModifyIdInfo (\ info -> go info (lbvarInfo info)) id2 + where go info (LBVarInfo u@(TyVarTy _)) = Just $ setLBVarInfo info $ + LBVarInfo (subst_ty subst u) + go info _ = Nothing + -- new_id is cloned if necessary + new_id = uniqAway in_scope id3 -- Extend the substitution if the unique has changed, -- or there's some useful occurrence information -- See the notes with substTyVar for the delSubstEnv - new_env | new_id /= old_id || isFragileOccInfo occ_info + new_env | new_id /= old_id || isFragileOcc occ_info = extendSubstEnv env old_id (DoneId new_id occ_info) | otherwise = delSubstEnv env old_id @@ -460,7 +596,7 @@ substAndCloneIds subst us (b:bs) = case substAndCloneId subst us b of { (sub substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, UniqSupply, Id) substAndCloneId subst@(Subst in_scope env) us old_id - = (Subst (in_scope `add_in_scope` new_id) + = (Subst (in_scope `extendInScopeSet` new_id) (extendSubstEnv env old_id (DoneEx (Var new_id))), new_us, new_id) @@ -511,17 +647,16 @@ substWorker :: Subst -> WorkerInfo -> WorkerInfo -- Seq'ing on the returned WorkerInfo is enough to cause all the -- substitutions to happen completely -substWorker subst Nothing - = Nothing -substWorker subst (Just w) - = case lookupSubst subst w of - Nothing -> Just w - Just (DoneId w1 _) -> Just w1 - Just (DoneEx (Var w1)) -> Just w1 - Just (DoneEx other) -> WARN( True, text "substWorker: DoneEx" <+> ppr w ) - Nothing -- Worker has got substituted away altogether - Just (ContEx se1 e) -> WARN( True, text "substWorker: ContEx" <+> ppr w ) - Nothing -- Ditto +substWorker subst NoWorker + = NoWorker +substWorker subst (HasWorker w a) + = case lookupIdSubst subst w of + (DoneId w1 _) -> HasWorker w1 a + (DoneEx (Var w1)) -> HasWorker w1 a + (DoneEx other) -> WARN( True, text "substWorker: DoneEx" <+> ppr w ) + NoWorker -- Worker has got substituted away altogether + (ContEx se1 e) -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e) + NoWorker -- Ditto substRules :: Subst -> CoreRules -> CoreRules -- Seq'ing on the returned CoreRules is enough to cause all the @@ -533,8 +668,7 @@ substRules subst rules substRules subst (Rules rules rhs_fvs) = seqRules new_rules `seq` new_rules where - new_rules = Rules (map do_subst rules) - (subst_fvs (substEnv subst) rhs_fvs) + new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs) do_subst rule@(BuiltinRule _) = rule do_subst (Rule name tpl_vars lhs_args rhs) @@ -544,13 +678,12 @@ substRules subst (Rules rules rhs_fvs) where (subst', tpl_vars') = substBndrs subst tpl_vars - subst_fvs se fvs - = foldVarSet (unionVarSet . subst_fv) emptyVarSet rhs_fvs - where - subst_fv fv = case lookupSubstEnv se fv of - Nothing -> unitVarSet fv - Just (DoneId fv' _) -> unitVarSet fv' - Just (DoneEx expr) -> exprFreeVars expr - Just (DoneTy ty) -> tyVarsOfType ty - Just (ContEx se' expr) -> subst_fvs se' (exprFreeVars expr) +substVarSet subst fvs + = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs + where + subst_fv subst fv = case lookupIdSubst subst fv of + DoneId fv' _ -> unitVarSet fv' + DoneEx expr -> exprFreeVars expr + DoneTy ty -> tyVarsOfType ty + ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr) \end{code}