2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CoreUtils]{Utility functions on @Core@ syntax}
9 Subst, SubstResult(..),
10 emptySubst, mkSubst, substInScope, substTy,
11 lookupIdSubst, lookupTvSubst, isEmptySubst,
12 extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
13 zapSubstEnv, setSubstEnv,
14 getTvSubst, getTvSubstEnv, setTvSubstEnv,
16 bindSubst, unBindSubst, bindSubstList, unBindSubstList,
19 simplBndr, simplBndrs, simplLetId, simplLamBndr, simplIdInfo,
20 substAndCloneId, substAndCloneIds, substAndCloneRecIds,
22 setInScope, setInScopeSet,
23 extendInScope, extendInScopeIds,
24 isInScope, modifyInScope,
27 substExpr, substRules, substId
30 #include "HsVersions.h"
32 import CoreSyn ( Expr(..), Bind(..), Note(..), CoreExpr,
33 CoreRules(..), CoreRule(..),
34 isEmptyCoreRules, seqRules, hasUnfolding, noUnfolding, hasSomeUnfolding,
37 import CoreFVs ( exprFreeVars )
38 import CoreUtils ( exprIsTrivial )
40 import qualified Type ( substTy )
41 import Type ( Type, tyVarsOfType, mkTyVarTy,
42 TvSubstEnv, TvSubst(..), substTyVar )
45 import Var ( setVarUnique, isId, mustHaveLocalBinding )
46 import Id ( idType, idInfo, setIdInfo, setIdType,
47 idUnfolding, setIdUnfolding,
48 idOccInfo, maybeModifyIdInfo )
49 import IdInfo ( IdInfo, vanillaIdInfo,
50 occInfo, isFragileOcc, setOccInfo,
51 specInfo, setSpecInfo,
52 setArityInfo, unknownArity, arityInfo,
53 unfoldingInfo, setUnfoldingInfo,
54 WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
56 import BasicTypes ( OccInfo(..) )
57 import Unique ( Unique )
58 import UniqSupply ( UniqSupply, uniqFromSupply, uniqsFromSupply )
59 import Var ( Var, Id, TyVar, isTyVar )
61 import PprCore () -- Instances
62 import Util ( mapAccumL, foldl2 )
67 %************************************************************************
69 \subsection{Substitutions}
71 %************************************************************************
75 = Subst InScopeSet -- Variables in in scope (both Ids and TyVars)
76 IdSubstEnv -- Substitution for Ids
77 TvSubstEnv -- Substitution for TyVars
79 -- INVARIANT 1: The (domain of the) in-scope set is a superset
80 -- of the free vars of the range of the substitution
81 -- that might possibly clash with locally-bound variables
82 -- in the thing being substituted in.
83 -- This is what lets us deal with name capture properly
84 -- It's a hard invariant to check...
85 -- There are various ways of causing it to happen:
86 -- - arrange that the in-scope set really is all the things in scope
87 -- - arrange that it's the free vars of the range of the substitution
88 -- - make it empty because all the free vars of the subst are fresh,
89 -- and hence can't possibly clash.a
91 -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
92 -- Equivalently, the substitution is idempotent
93 -- [Sep 2000: Lies, all lies. The substitution now does contain
94 -- mappings x77 -> DoneId x77 occ
95 -- to record x's occurrence information.]
96 -- [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
97 -- Consider let x = case k of I# x77 -> ... in
98 -- let y = case k of I# x77 -> ... in ...
99 -- and suppose the body is strict in both x and y. Then the simplifier
100 -- will pull the first (case k) to the top; so the second (case k) will
101 -- cancel out, mapping x77 to, well, x77! But one is an in-Id and the
102 -- other is an out-Id. So the substitution is idempotent in the sense
103 -- that we *must not* repeatedly apply it.]
106 type IdSubstEnv = IdEnv SubstResult
109 = DoneEx CoreExpr -- Completed term
110 | DoneId Id OccInfo -- Completed term variable, with occurrence info;
111 -- only used by the simplifier
112 | ContEx Subst CoreExpr -- A suspended substitution
115 The general plan about the substitution and in-scope set for Ids is as follows
117 * substId always adds new_id to the in-scope set.
118 new_id has a correctly-substituted type, occ info
120 * substId adds a binding (DoneId new_id occ) to the substitution if
121 EITHER the Id's unique has changed
122 OR the Id has interesting occurrence information
123 So in effect you can only get to interesting occurrence information
124 by looking up the *old* Id; it's not really attached to the new id
127 Note, though that the substitution isn't necessarily extended
128 if the type changes. Why not? Because of the next point:
130 * We *always, always* finish by looking up in the in-scope set
131 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
132 Reason: so that we never finish up with a "old" Id in the result.
133 An old Id might point to an old unfolding and so on... which gives a space leak.
135 [The DoneEx and DoneVar hits map to "new" stuff.]
137 * It follows that substExpr must not do a no-op if the substitution is empty.
138 substType is free to do so, however.
140 * When we come to a let-binding (say) we generate new IdInfo, including an
141 unfolding, attach it to the binder, and add this newly adorned binder to
142 the in-scope set. So all subsequent occurrences of the binder will get mapped
143 to the full-adorned binder, which is also the one put in the binding site.
145 * The in-scope "set" usually maps x->x; we use it simply for its domain.
146 But sometimes we have two in-scope Ids that are synomyms, and should
147 map to the same target: x->x, y->x. Notably:
149 That's why the "set" is actually a VarEnv Var
153 isEmptySubst :: Subst -> Bool
154 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
157 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
159 mkSubst :: InScopeSet -> Subst
160 mkSubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
162 getTvSubst :: Subst -> TvSubst
163 getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
165 getTvSubstEnv :: Subst -> TvSubstEnv
166 getTvSubstEnv (Subst _ _ tv_env) = tv_env
168 setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
169 setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
173 substInScope :: Subst -> InScopeSet
174 substInScope (Subst in_scope _ _) = in_scope
176 zapSubstEnv :: Subst -> Subst
177 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
179 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
180 extendIdSubst :: Subst -> Id -> SubstResult -> Subst
181 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
183 extendIdSubstList :: Subst -> [(Id, SubstResult)] -> Subst
184 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
186 extendTvSubst :: Subst -> TyVar -> Type -> Subst
187 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
189 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
190 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
192 lookupIdSubst :: Subst -> Id -> Maybe SubstResult
193 lookupIdSubst (Subst in_scope ids tvs) v = lookupVarEnv ids v
195 lookupTvSubst :: Subst -> TyVar -> Maybe Type
196 lookupTvSubst (Subst _ ids tvs) v = lookupVarEnv tvs v
198 ------------------------------
199 isInScope :: Var -> Subst -> Bool
200 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
202 modifyInScope :: Subst -> Var -> Var -> Subst
203 modifyInScope (Subst in_scope ids tvs) old_v new_v
204 = Subst (modifyInScopeSet in_scope old_v new_v) ids tvs
205 -- make old_v map to new_v
207 extendInScope :: Subst -> Var -> Subst
208 extendInScope (Subst in_scope ids tvs) v
209 = Subst (in_scope `extendInScopeSet` v)
210 (ids `delVarEnv` v) (tvs `delVarEnv` v)
212 extendInScopeIds :: Subst -> [Id] -> Subst
213 extendInScopeIds (Subst in_scope ids tvs) vs
214 = Subst (in_scope `extendInScopeSetList` vs)
215 (ids `delVarEnvList` vs) tvs
217 -------------------------------
218 bindSubst :: Subst -> Var -> Var -> Subst
219 -- Extend with a substitution, v1 -> Var v2
220 -- and extend the in-scopes with v2
221 bindSubst (Subst in_scope ids tvs) old_bndr new_bndr
223 = Subst (in_scope `extendInScopeSet` new_bndr)
224 (extendVarEnv ids old_bndr (DoneEx (Var new_bndr)))
227 = Subst (in_scope `extendInScopeSet` new_bndr)
229 (extendVarEnv tvs old_bndr (mkTyVarTy new_bndr))
231 unBindSubst :: Subst -> Var -> Var -> Subst
232 -- Reverse the effect of bindSubst
233 -- If old_bndr was already in the substitution, this doesn't quite work
234 unBindSubst (Subst in_scope ids tvs) old_bndr new_bndr
235 = Subst (in_scope `delInScopeSet` new_bndr)
236 (delVarEnv ids old_bndr)
237 (delVarEnv tvs old_bndr)
239 -- And the "List" forms
240 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
241 bindSubstList subst old_bndrs new_bndrs
242 = foldl2 bindSubst subst old_bndrs new_bndrs
244 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
245 unBindSubstList subst old_bndrs new_bndrs
246 = foldl2 unBindSubst subst old_bndrs new_bndrs
249 -------------------------------
250 setInScopeSet :: Subst -> InScopeSet -> Subst
251 setInScopeSet (Subst _ ids tvs) in_scope
252 = Subst in_scope ids tvs
254 setInScope :: Subst -- Take env part from here
255 -> Subst -- Take in-scope part from here
257 setInScope (Subst _ ids tvs) (Subst in_scope _ _)
258 = Subst in_scope ids tvs
260 setSubstEnv :: Subst -- Take in-scope part from here
261 -> Subst -- ... and env part from here
263 setSubstEnv s1 s2 = setInScope s2 s1
266 Pretty printing, for debugging only
269 instance Outputable SubstResult where
270 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
271 ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
272 ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
274 instance Outputable Subst where
275 ppr (Subst in_scope ids tvs)
276 = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
277 $$ ptext SLIT(" IdSubst =") <+> ppr ids
278 $$ ptext SLIT(" TvSubst =") <+> ppr tvs
283 %************************************************************************
285 \section{Expression substitution}
287 %************************************************************************
289 This expression substituter deals correctly with name capture.
291 BUT NOTE that substExpr silently discards the
294 IdInfo attached to any binders in the expression. It's quite
295 tricky to do them 'right' in the case of mutually recursive bindings,
296 and so far has proved unnecessary.
299 substExpr :: Subst -> CoreExpr -> CoreExpr
301 -- NB: we do not do a no-op when the substitution is empty,
302 -- because we always want to substitute the variables in the
303 -- in-scope set for their occurrences. Why?
304 -- (a) because they may contain more information
305 -- (b) because leaving an un-substituted Id might cause
306 -- a space leak (its unfolding might point to an old version
307 -- of its right hand side).
311 go (Var v) = case substId subst v of
312 ContEx env' e' -> substExpr (setSubstEnv subst env') e'
316 go (Type ty) = Type (go_ty ty)
317 go (Lit lit) = Lit lit
318 go (App fun arg) = App (go fun) (go arg)
319 go (Note note e) = Note (go_note note) (go e)
321 go (Lam bndr body) = Lam bndr' (substExpr subst' body)
323 (subst', bndr') = substBndr subst bndr
325 go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
327 (subst', bndr') = substBndr subst bndr
329 go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
331 (subst', bndrs') = substRecBndrs subst (map fst pairs)
332 pairs' = bndrs' `zip` rhss'
333 rhss' = map (substExpr subst' . snd) pairs
334 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (go_ty ty) (map (go_alt subst') alts)
336 (subst', bndr') = substBndr subst bndr
338 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
340 (subst', bndrs') = substBndrs subst bndrs
342 go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
345 go_ty ty = substTy subst ty
347 substId :: Subst -> Id -> SubstResult
348 substId (Subst in_scope ids tvs) v
349 = case lookupVarEnv ids v of
350 Just (DoneId v occ) -> DoneId (lookup v) occ
352 Nothing -> let v' = lookup v
353 in DoneId v' (idOccInfo v')
355 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
356 -- very important! If isFragileOcc returned True for
357 -- loop breakers we could avoid this call, but at the expense
358 -- of adding more to the substitution, and building new Ids
359 -- in substId a bit more often than really necessary
361 -- Get the most up-to-date thing from the in-scope set
362 -- Even though it isn't in the substitution, it may be in
363 -- the in-scope set with a different type (we only use the
364 -- substitution if the unique changes).
365 lookup v = case lookupInScope in_scope v of
367 Nothing -> WARN( mustHaveLocalBinding v, ppr v ) v
370 substTy :: Subst -> Type -> Type
371 substTy subst ty = Type.substTy (getTvSubst subst) ty
375 %************************************************************************
377 \section{Substituting an Id binder}
379 %************************************************************************
382 -- simplBndr and simplLetId are used by the simplifier
384 simplBndr :: Subst -> Var -> (Subst, Var)
385 -- Used for lambda and case-bound variables
386 -- Clone Id if necessary, substitute type
387 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
388 -- The substitution is extended only if the variable is cloned, because
389 -- we *don't* need to use it to track occurrence info.
391 | isTyVar bndr = subst_tv subst bndr
392 | otherwise = subst_id False subst subst bndr
394 simplBndrs :: Subst -> [Var] -> (Subst, [Var])
395 simplBndrs subst bndrs = mapAccumL simplBndr subst bndrs
397 simplLamBndr :: Subst -> Var -> (Subst, Var)
398 -- Used for lambda binders. These sometimes have unfoldings added by
399 -- the worker/wrapper pass that must be preserved, becuase they can't
400 -- be reconstructed from context. For example:
401 -- f x = case x of (a,b) -> fw a b x
402 -- fw a b x{=(a,b)} = ...
403 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
404 simplLamBndr subst bndr
405 | not (isId bndr && hasSomeUnfolding old_unf)
406 = simplBndr subst bndr -- Normal case
408 = (subst', bndr' `setIdUnfolding` substUnfolding subst old_unf)
410 old_unf = idUnfolding bndr
411 (subst', bndr') = subst_id False subst subst bndr
414 simplLetId :: Subst -> Id -> (Subst, Id)
415 -- Clone Id if necessary
416 -- Substitute its type
417 -- Return an Id with completely zapped IdInfo
418 -- [A subsequent substIdInfo will restore its IdInfo]
419 -- Augment the subtitution
420 -- if the unique changed, *or*
421 -- if there's interesting occurrence info
423 simplLetId subst@(Subst in_scope env tvs) old_id
424 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
426 old_info = idInfo old_id
427 id1 = uniqAway in_scope old_id
428 id2 = substIdType subst id1
429 new_id = setIdInfo id2 vanillaIdInfo
431 -- Extend the substitution if the unique has changed,
432 -- or there's some useful occurrence information
433 -- See the notes with substTyVar for the delSubstEnv
434 occ_info = occInfo old_info
435 new_env | new_id /= old_id || isFragileOcc occ_info
436 = extendVarEnv env old_id (DoneId new_id occ_info)
438 = delVarEnv env old_id
440 simplIdInfo :: Subst -> IdInfo -> IdInfo
441 -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
442 -- subsequent to simplLetId having zapped its IdInfo
443 simplIdInfo subst old_info
444 = case substIdInfo False subst old_info of
445 Just new_info -> new_info
450 -- substBndr and friends are used when doing expression substitution only
451 -- In this case we can *preserve* occurrence information, and indeed we *want*
452 -- to do so else lose useful occ info in rules.
454 substBndr :: Subst -> Var -> (Subst, Var)
456 | isTyVar bndr = subst_tv subst bndr
457 | otherwise = subst_id True {- keep fragile info -} subst subst bndr
459 substBndrs :: Subst -> [Var] -> (Subst, [Var])
460 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
462 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
463 -- Substitute a mutually recursive group
464 substRecBndrs subst bndrs
465 = (new_subst, new_bndrs)
467 -- Here's the reason we need to pass rec_subst to subst_id
468 (new_subst, new_bndrs) = mapAccumL (subst_id True {- keep fragile info -} new_subst)
474 subst_tv :: Subst -> TyVar -> (Subst, TyVar)
475 -- Unpackage and re-package for substTyVar
476 subst_tv (Subst in_scope id_env tv_env) tv
477 = case substTyVar (TvSubst in_scope tv_env) tv of
478 (TvSubst in_scope' tv_env', tv')
479 -> (Subst in_scope' id_env tv_env', tv')
481 subst_id :: Bool -- True <=> keep fragile info
482 -> Subst -- Substitution to use for the IdInfo
483 -> Subst -> Id -- Substitition and Id to transform
484 -> (Subst, Id) -- Transformed pair
487 -- * Unique changed if necessary
488 -- * Type substituted
489 -- * Unfolding zapped
490 -- * Rules, worker, lbvar info all substituted
491 -- * Occurrence info zapped if is_fragile_occ returns True
492 -- * The in-scope set extended with the returned Id
493 -- * The substitution extended with a DoneId if unique changed
494 -- In this case, the var in the DoneId is the same as the
497 subst_id keep_fragile rec_subst subst@(Subst in_scope env tvs) old_id
498 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
500 -- id1 is cloned if necessary
501 id1 = uniqAway in_scope old_id
503 -- id2 has its type zapped
504 id2 = substIdType subst id1
506 -- new_id has the right IdInfo
507 -- The lazy-set is because we're in a loop here, with
508 -- rec_subst, when dealing with a mutually-recursive group
509 new_id = maybeModifyIdInfo (substIdInfo keep_fragile rec_subst) id2
511 -- Extend the substitution if the unique has changed
512 -- See the notes with substTyVar for the delSubstEnv
513 new_env | new_id /= old_id
514 = extendVarEnv env old_id (DoneId new_id (idOccInfo old_id))
516 = delVarEnv env old_id
519 Now a variant that unconditionally allocates a new unique.
520 It also unconditionally zaps the OccInfo.
523 subst_clone_id :: Subst -- Substitution to use (lazily) for the rules and worker
524 -> Subst -> (Id, Unique) -- Substitition and Id to transform
525 -> (Subst, Id) -- Transformed pair
527 subst_clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
528 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
530 id1 = setVarUnique old_id uniq
531 id2 = substIdType subst id1
533 new_id = maybeModifyIdInfo (substIdInfo False rec_subst) id2
534 new_env = extendVarEnv env old_id (DoneId new_id NoOccInfo)
536 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
537 substAndCloneIds subst us ids
538 = mapAccumL (subst_clone_id subst) subst (ids `zip` uniqsFromSupply us)
540 substAndCloneRecIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
541 substAndCloneRecIds subst us ids
544 (subst', ids') = mapAccumL (subst_clone_id subst') subst
545 (ids `zip` uniqsFromSupply us)
547 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, Id)
548 substAndCloneId subst us old_id
549 = subst_clone_id subst subst (old_id, uniqFromSupply us)
553 %************************************************************************
555 \section{IdInfo substitution}
557 %************************************************************************
560 substIdInfo :: Bool -- True <=> keep even fragile info
564 -- The keep_fragile flag is True when we are running a simple expression
565 -- substitution that preserves all structure, so that arity and occurrence
566 -- info are unaffected. The False state is used more often.
572 -- If keep_fragile then
576 -- keep only 'robust' OccInfo
579 -- Seq'ing on the returned IdInfo is enough to cause all the
580 -- substitutions to happen completely
582 substIdInfo keep_fragile subst info
583 | nothing_to_do = Nothing
584 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
585 `setArityInfo` (if keep_arity then old_arity else unknownArity)
586 `setSpecInfo` substRules subst old_rules
587 `setWorkerInfo` substWorker subst old_wrkr
588 `setUnfoldingInfo` noUnfolding)
589 -- setSpecInfo does a seq
590 -- setWorkerInfo does a seq
592 nothing_to_do = keep_occ && keep_arity &&
593 isEmptyCoreRules old_rules &&
594 not (workerExists old_wrkr) &&
595 not (hasUnfolding (unfoldingInfo info))
597 keep_occ = keep_fragile || not (isFragileOcc old_occ)
598 keep_arity = keep_fragile || old_arity == unknownArity
599 old_arity = arityInfo info
600 old_occ = occInfo info
601 old_rules = specInfo info
602 old_wrkr = workerInfo info
605 substIdType :: Subst -> Id -> Id
606 substIdType subst@(Subst in_scope id_env tv_env) id
607 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
608 | otherwise = setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
609 -- The tyVarsOfType is cheaper than it looks
610 -- because we cache the free tyvars of the type
611 -- in a Note in the id's type itself
616 substWorker :: Subst -> WorkerInfo -> WorkerInfo
617 -- Seq'ing on the returned WorkerInfo is enough to cause all the
618 -- substitutions to happen completely
620 substWorker subst NoWorker
622 substWorker subst (HasWorker w a)
623 = case substId subst w of
624 DoneId w1 _ -> HasWorker w1 a
625 DoneEx (Var w1) -> HasWorker w1 a
626 DoneEx other -> WARN( not (exprIsTrivial other), text "substWorker: DoneEx" <+> ppr w )
627 NoWorker -- Worker has got substituted away altogether
628 -- This can happen if it's trivial,
629 -- via postInlineUnconditionally
630 ContEx se1 e -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
634 substUnfolding subst NoUnfolding = NoUnfolding
635 substUnfolding subst (OtherCon cons) = OtherCon cons
636 substUnfolding subst (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr subst rhs)
637 substUnfolding subst (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr subst rhs) t v w g
640 substRules :: Subst -> CoreRules -> CoreRules
641 -- Seq'ing on the returned CoreRules is enough to cause all the
642 -- substitutions to happen completely
644 substRules subst rules
645 | isEmptySubst subst = rules
647 substRules subst (Rules rules rhs_fvs)
648 = seqRules new_rules `seq` new_rules
650 new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
652 do_subst rule@(BuiltinRule _ _) = rule
653 do_subst (Rule name act tpl_vars lhs_args rhs)
654 = Rule name act tpl_vars'
655 (map (substExpr subst') lhs_args)
656 (substExpr subst' rhs)
658 (subst', tpl_vars') = substBndrs subst tpl_vars
661 substVarSet subst fvs
662 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
665 | isId fv = case substId subst fv of
666 DoneId fv' _ -> unitVarSet fv'
667 DoneEx expr -> exprFreeVars expr
668 ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
669 | otherwise = case lookupTvSubst subst fv of
670 Nothing -> unitVarSet fv
671 Just ty -> substVarSet subst (tyVarsOfType ty)