2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CoreUtils]{Utility functions on @Core@ syntax}
9 IdSubstEnv, SubstResult(..),
11 Subst, emptySubst, mkSubst, substInScope, substTy,
12 lookupIdSubst, lookupTvSubst, isEmptySubst,
13 extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
14 zapSubstEnv, setSubstEnv,
15 getTvSubst, getTvSubstEnv, setTvSubstEnv,
17 bindSubst, unBindSubst, bindSubstList, unBindSubstList,
20 simplBndr, simplBndrs, simplLetId, simplLamBndr, simplIdInfo,
21 substAndCloneId, substAndCloneIds, substAndCloneRecIds,
23 setInScope, setInScopeSet,
24 extendInScope, extendInScopeIds,
25 isInScope, modifyInScope,
28 substExpr, substRules, substId
31 #include "HsVersions.h"
33 import CoreSyn ( Expr(..), Bind(..), Note(..), CoreExpr,
34 CoreRules(..), CoreRule(..),
35 isEmptyCoreRules, seqRules, hasUnfolding, noUnfolding, hasSomeUnfolding,
38 import CoreFVs ( exprFreeVars )
39 import CoreUtils ( exprIsTrivial )
41 import qualified Type ( substTy )
42 import Type ( Type, tyVarsOfType, mkTyVarTy,
43 TvSubstEnv, TvSubst(..), substTyVarBndr )
46 import Var ( setVarUnique, isId, mustHaveLocalBinding )
47 import Id ( idType, idInfo, setIdInfo, setIdType,
48 idUnfolding, setIdUnfolding,
49 idOccInfo, maybeModifyIdInfo )
50 import IdInfo ( IdInfo, vanillaIdInfo,
51 occInfo, isFragileOcc, setOccInfo,
52 specInfo, setSpecInfo,
53 setArityInfo, unknownArity, arityInfo,
54 unfoldingInfo, setUnfoldingInfo,
55 WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
57 import BasicTypes ( OccInfo(..) )
58 import Unique ( Unique )
59 import UniqSupply ( UniqSupply, uniqFromSupply, uniqsFromSupply )
60 import Var ( Var, Id, TyVar, isTyVar )
62 import PprCore () -- Instances
63 import Util ( mapAccumL, foldl2 )
68 %************************************************************************
70 \subsection{Substitutions}
72 %************************************************************************
76 = Subst InScopeSet -- Variables in in scope (both Ids and TyVars)
77 IdSubstEnv -- Substitution for Ids
78 TvSubstEnv -- Substitution for TyVars
80 -- INVARIANT 1: The (domain of the) in-scope set is a superset
81 -- of the free vars of the range of the substitution
82 -- that might possibly clash with locally-bound variables
83 -- in the thing being substituted in.
84 -- This is what lets us deal with name capture properly
85 -- It's a hard invariant to check...
86 -- There are various ways of causing it to happen:
87 -- - arrange that the in-scope set really is all the things in scope
88 -- - arrange that it's the free vars of the range of the substitution
89 -- - make it empty because all the free vars of the subst are fresh,
90 -- and hence can't possibly clash.a
92 -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
93 -- Equivalently, the substitution is idempotent
94 -- [Sep 2000: Lies, all lies. The substitution now does contain
95 -- mappings x77 -> DoneId x77 occ
96 -- to record x's occurrence information.]
97 -- [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
98 -- Consider let x = case k of I# x77 -> ... in
99 -- let y = case k of I# x77 -> ... in ...
100 -- and suppose the body is strict in both x and y. Then the simplifier
101 -- will pull the first (case k) to the top; so the second (case k) will
102 -- cancel out, mapping x77 to, well, x77! But one is an in-Id and the
103 -- other is an out-Id. So the substitution is idempotent in the sense
104 -- that we *must not* repeatedly apply it.]
107 type IdSubstEnv = IdEnv SubstResult
110 = DoneEx CoreExpr -- Completed term
111 | DoneId Id OccInfo -- Completed term variable, with occurrence info;
112 -- only used by the simplifier
113 | ContEx Subst CoreExpr -- A suspended substitution
116 The general plan about the substitution and in-scope set for Ids is as follows
118 * substId always adds new_id to the in-scope set.
119 new_id has a correctly-substituted type, occ info
121 * substId adds a binding (DoneId new_id occ) to the substitution if
122 EITHER the Id's unique has changed
123 OR the Id has interesting occurrence information
124 So in effect you can only get to interesting occurrence information
125 by looking up the *old* Id; it's not really attached to the new id
128 Note, though that the substitution isn't necessarily extended
129 if the type changes. Why not? Because of the next point:
131 * We *always, always* finish by looking up in the in-scope set
132 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
133 Reason: so that we never finish up with a "old" Id in the result.
134 An old Id might point to an old unfolding and so on... which gives a space leak.
136 [The DoneEx and DoneVar hits map to "new" stuff.]
138 * It follows that substExpr must not do a no-op if the substitution is empty.
139 substType is free to do so, however.
141 * When we come to a let-binding (say) we generate new IdInfo, including an
142 unfolding, attach it to the binder, and add this newly adorned binder to
143 the in-scope set. So all subsequent occurrences of the binder will get mapped
144 to the full-adorned binder, which is also the one put in the binding site.
146 * The in-scope "set" usually maps x->x; we use it simply for its domain.
147 But sometimes we have two in-scope Ids that are synomyms, and should
148 map to the same target: x->x, y->x. Notably:
150 That's why the "set" is actually a VarEnv Var
154 isEmptySubst :: Subst -> Bool
155 isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
158 emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
160 mkSubst :: InScopeSet -> Subst
161 mkSubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
163 getTvSubst :: Subst -> TvSubst
164 getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
166 getTvSubstEnv :: Subst -> TvSubstEnv
167 getTvSubstEnv (Subst _ _ tv_env) = tv_env
169 setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
170 setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
174 substInScope :: Subst -> InScopeSet
175 substInScope (Subst in_scope _ _) = in_scope
177 zapSubstEnv :: Subst -> Subst
178 zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
180 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
181 extendIdSubst :: Subst -> Id -> SubstResult -> Subst
182 extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
184 extendIdSubstList :: Subst -> [(Id, SubstResult)] -> Subst
185 extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
187 extendTvSubst :: Subst -> TyVar -> Type -> Subst
188 extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r)
190 extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
191 extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
193 lookupIdSubst :: Subst -> Id -> Maybe SubstResult
194 lookupIdSubst (Subst in_scope ids tvs) v = lookupVarEnv ids v
196 lookupTvSubst :: Subst -> TyVar -> Maybe Type
197 lookupTvSubst (Subst _ ids tvs) v = lookupVarEnv tvs v
199 ------------------------------
200 isInScope :: Var -> Subst -> Bool
201 isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
203 modifyInScope :: Subst -> Var -> Var -> Subst
204 modifyInScope (Subst in_scope ids tvs) old_v new_v
205 = Subst (modifyInScopeSet in_scope old_v new_v) ids tvs
206 -- make old_v map to new_v
208 extendInScope :: Subst -> Var -> Subst
209 extendInScope (Subst in_scope ids tvs) v
210 = Subst (in_scope `extendInScopeSet` v)
211 (ids `delVarEnv` v) (tvs `delVarEnv` v)
213 extendInScopeIds :: Subst -> [Id] -> Subst
214 extendInScopeIds (Subst in_scope ids tvs) vs
215 = Subst (in_scope `extendInScopeSetList` vs)
216 (ids `delVarEnvList` vs) tvs
218 -------------------------------
219 bindSubst :: Subst -> Var -> Var -> Subst
220 -- Extend with a substitution, v1 -> Var v2
221 -- and extend the in-scopes with v2
222 bindSubst (Subst in_scope ids tvs) old_bndr new_bndr
224 = Subst (in_scope `extendInScopeSet` new_bndr)
225 (extendVarEnv ids old_bndr (DoneEx (Var new_bndr)))
228 = Subst (in_scope `extendInScopeSet` new_bndr)
230 (extendVarEnv tvs old_bndr (mkTyVarTy new_bndr))
232 unBindSubst :: Subst -> Var -> Var -> Subst
233 -- Reverse the effect of bindSubst
234 -- If old_bndr was already in the substitution, this doesn't quite work
235 unBindSubst (Subst in_scope ids tvs) old_bndr new_bndr
236 = Subst (in_scope `delInScopeSet` new_bndr)
237 (delVarEnv ids old_bndr)
238 (delVarEnv tvs old_bndr)
240 -- And the "List" forms
241 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
242 bindSubstList subst old_bndrs new_bndrs
243 = foldl2 bindSubst subst old_bndrs new_bndrs
245 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
246 unBindSubstList subst old_bndrs new_bndrs
247 = foldl2 unBindSubst subst old_bndrs new_bndrs
250 -------------------------------
251 setInScopeSet :: Subst -> InScopeSet -> Subst
252 setInScopeSet (Subst _ ids tvs) in_scope
253 = Subst in_scope ids tvs
255 setInScope :: Subst -- Take env part from here
256 -> Subst -- Take in-scope part from here
258 setInScope (Subst _ ids tvs) (Subst in_scope _ _)
259 = Subst in_scope ids tvs
261 setSubstEnv :: Subst -- Take in-scope part from here
262 -> Subst -- ... and env part from here
264 setSubstEnv s1 s2 = setInScope s2 s1
267 Pretty printing, for debugging only
270 instance Outputable SubstResult where
271 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
272 ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
273 ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
275 instance Outputable Subst where
276 ppr (Subst in_scope ids tvs)
277 = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
278 $$ ptext SLIT(" IdSubst =") <+> ppr ids
279 $$ ptext SLIT(" TvSubst =") <+> ppr tvs
284 %************************************************************************
286 \section{Expression substitution}
288 %************************************************************************
290 This expression substituter deals correctly with name capture.
292 BUT NOTE that substExpr silently discards the
295 IdInfo attached to any binders in the expression. It's quite
296 tricky to do them 'right' in the case of mutually recursive bindings,
297 and so far has proved unnecessary.
300 substExpr :: Subst -> CoreExpr -> CoreExpr
302 -- NB: we do not do a no-op when the substitution is empty,
303 -- because we always want to substitute the variables in the
304 -- in-scope set for their occurrences. Why?
305 -- (a) because they may contain more information
306 -- (b) because leaving an un-substituted Id might cause
307 -- a space leak (its unfolding might point to an old version
308 -- of its right hand side).
312 go (Var v) = case substId subst v of
313 ContEx env' e' -> substExpr (setSubstEnv subst env') e'
317 go (Type ty) = Type (go_ty ty)
318 go (Lit lit) = Lit lit
319 go (App fun arg) = App (go fun) (go arg)
320 go (Note note e) = Note (go_note note) (go e)
322 go (Lam bndr body) = Lam bndr' (substExpr subst' body)
324 (subst', bndr') = substBndr subst bndr
326 go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
328 (subst', bndr') = substBndr subst bndr
330 go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
332 (subst', bndrs') = substRecBndrs subst (map fst pairs)
333 pairs' = bndrs' `zip` rhss'
334 rhss' = map (substExpr subst' . snd) pairs
335 go (Case scrut bndr ty alts) = Case (go scrut) bndr' (go_ty ty) (map (go_alt subst') alts)
337 (subst', bndr') = substBndr subst bndr
339 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
341 (subst', bndrs') = substBndrs subst bndrs
343 go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
346 go_ty ty = substTy subst ty
348 substId :: Subst -> Id -> SubstResult
349 substId (Subst in_scope ids tvs) v
350 = case lookupVarEnv ids v of
351 Just (DoneId v occ) -> DoneId (lookup v) occ
353 Nothing -> let v' = lookup v
354 in DoneId v' (idOccInfo v')
356 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
357 -- very important! If isFragileOcc returned True for
358 -- loop breakers we could avoid this call, but at the expense
359 -- of adding more to the substitution, and building new Ids
360 -- in substId a bit more often than really necessary
362 -- Get the most up-to-date thing from the in-scope set
363 -- Even though it isn't in the substitution, it may be in
364 -- the in-scope set with a different type (we only use the
365 -- substitution if the unique changes).
366 lookup v = case lookupInScope in_scope v of
368 Nothing -> WARN( mustHaveLocalBinding v, ppr v ) v
371 substTy :: Subst -> Type -> Type
372 substTy subst ty = Type.substTy (getTvSubst subst) ty
376 %************************************************************************
378 \section{Substituting an Id binder}
380 %************************************************************************
383 -- simplBndr and simplLetId are used by the simplifier
385 simplBndr :: Subst -> Var -> (Subst, Var)
386 -- Used for lambda and case-bound variables
387 -- Clone Id if necessary, substitute type
388 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
389 -- The substitution is extended only if the variable is cloned, because
390 -- we *don't* need to use it to track occurrence info.
392 | isTyVar bndr = subst_tv subst bndr
393 | otherwise = subst_id False subst subst bndr
395 simplBndrs :: Subst -> [Var] -> (Subst, [Var])
396 simplBndrs subst bndrs = mapAccumL simplBndr subst bndrs
398 simplLamBndr :: Subst -> Var -> (Subst, Var)
399 -- Used for lambda binders. These sometimes have unfoldings added by
400 -- the worker/wrapper pass that must be preserved, becuase they can't
401 -- be reconstructed from context. For example:
402 -- f x = case x of (a,b) -> fw a b x
403 -- fw a b x{=(a,b)} = ...
404 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
405 simplLamBndr subst bndr
406 | not (isId bndr && hasSomeUnfolding old_unf)
407 = simplBndr subst bndr -- Normal case
409 = (subst', bndr' `setIdUnfolding` substUnfolding subst old_unf)
411 old_unf = idUnfolding bndr
412 (subst', bndr') = subst_id False subst subst bndr
415 simplLetId :: Subst -> Id -> (Subst, Id)
416 -- Clone Id if necessary
417 -- Substitute its type
418 -- Return an Id with completely zapped IdInfo
419 -- [A subsequent substIdInfo will restore its IdInfo]
420 -- Augment the subtitution
421 -- if the unique changed, *or*
422 -- if there's interesting occurrence info
424 simplLetId subst@(Subst in_scope env tvs) old_id
425 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
427 old_info = idInfo old_id
428 id1 = uniqAway in_scope old_id
429 id2 = substIdType subst id1
430 new_id = setIdInfo id2 vanillaIdInfo
432 -- Extend the substitution if the unique has changed,
433 -- or there's some useful occurrence information
434 -- See the notes with substTyVarBndr for the delSubstEnv
435 occ_info = occInfo old_info
436 new_env | new_id /= old_id || isFragileOcc occ_info
437 = extendVarEnv env old_id (DoneId new_id occ_info)
439 = delVarEnv env old_id
441 simplIdInfo :: Subst -> IdInfo -> IdInfo
442 -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
443 -- subsequent to simplLetId having zapped its IdInfo
444 simplIdInfo subst old_info
445 = case substIdInfo False subst old_info of
446 Just new_info -> new_info
451 -- substBndr and friends are used when doing expression substitution only
452 -- In this case we can *preserve* occurrence information, and indeed we *want*
453 -- to do so else lose useful occ info in rules.
455 substBndr :: Subst -> Var -> (Subst, Var)
457 | isTyVar bndr = subst_tv subst bndr
458 | otherwise = subst_id True {- keep fragile info -} subst subst bndr
460 substBndrs :: Subst -> [Var] -> (Subst, [Var])
461 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
463 substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
464 -- Substitute a mutually recursive group
465 substRecBndrs subst bndrs
466 = (new_subst, new_bndrs)
468 -- Here's the reason we need to pass rec_subst to subst_id
469 (new_subst, new_bndrs) = mapAccumL (subst_id True {- keep fragile info -} new_subst)
475 subst_tv :: Subst -> TyVar -> (Subst, TyVar)
476 -- Unpackage and re-package for substTyVarBndr
477 subst_tv (Subst in_scope id_env tv_env) tv
478 = case substTyVarBndr (TvSubst in_scope tv_env) tv of
479 (TvSubst in_scope' tv_env', tv')
480 -> (Subst in_scope' id_env tv_env', tv')
482 subst_id :: Bool -- True <=> keep fragile info
483 -> Subst -- Substitution to use for the IdInfo
484 -> Subst -> Id -- Substitition and Id to transform
485 -> (Subst, Id) -- Transformed pair
488 -- * Unique changed if necessary
489 -- * Type substituted
490 -- * Unfolding zapped
491 -- * Rules, worker, lbvar info all substituted
492 -- * Occurrence info zapped if is_fragile_occ returns True
493 -- * The in-scope set extended with the returned Id
494 -- * The substitution extended with a DoneId if unique changed
495 -- In this case, the var in the DoneId is the same as the
498 subst_id keep_fragile rec_subst subst@(Subst in_scope env tvs) old_id
499 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
501 -- id1 is cloned if necessary
502 id1 = uniqAway in_scope old_id
504 -- id2 has its type zapped
505 id2 = substIdType subst id1
507 -- new_id has the right IdInfo
508 -- The lazy-set is because we're in a loop here, with
509 -- rec_subst, when dealing with a mutually-recursive group
510 new_id = maybeModifyIdInfo (substIdInfo keep_fragile rec_subst) id2
512 -- Extend the substitution if the unique has changed
513 -- See the notes with substTyVarBndr for the delSubstEnv
514 new_env | new_id /= old_id
515 = extendVarEnv env old_id (DoneId new_id (idOccInfo old_id))
517 = delVarEnv env old_id
520 Now a variant that unconditionally allocates a new unique.
521 It also unconditionally zaps the OccInfo.
524 subst_clone_id :: Subst -- Substitution to use (lazily) for the rules and worker
525 -> Subst -> (Id, Unique) -- Substitition and Id to transform
526 -> (Subst, Id) -- Transformed pair
528 subst_clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
529 = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
531 id1 = setVarUnique old_id uniq
532 id2 = substIdType subst id1
534 new_id = maybeModifyIdInfo (substIdInfo False rec_subst) id2
535 new_env = extendVarEnv env old_id (DoneId new_id NoOccInfo)
537 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
538 substAndCloneIds subst us ids
539 = mapAccumL (subst_clone_id subst) subst (ids `zip` uniqsFromSupply us)
541 substAndCloneRecIds :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
542 substAndCloneRecIds subst us ids
545 (subst', ids') = mapAccumL (subst_clone_id subst') subst
546 (ids `zip` uniqsFromSupply us)
548 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, Id)
549 substAndCloneId subst us old_id
550 = subst_clone_id subst subst (old_id, uniqFromSupply us)
554 %************************************************************************
556 \section{IdInfo substitution}
558 %************************************************************************
561 substIdInfo :: Bool -- True <=> keep even fragile info
565 -- The keep_fragile flag is True when we are running a simple expression
566 -- substitution that preserves all structure, so that arity and occurrence
567 -- info are unaffected. The False state is used more often.
573 -- If keep_fragile then
577 -- keep only 'robust' OccInfo
580 -- Seq'ing on the returned IdInfo is enough to cause all the
581 -- substitutions to happen completely
583 substIdInfo keep_fragile subst info
584 | nothing_to_do = Nothing
585 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
586 `setArityInfo` (if keep_arity then old_arity else unknownArity)
587 `setSpecInfo` substRules subst old_rules
588 `setWorkerInfo` substWorker subst old_wrkr
589 `setUnfoldingInfo` noUnfolding)
590 -- setSpecInfo does a seq
591 -- setWorkerInfo does a seq
593 nothing_to_do = keep_occ && keep_arity &&
594 isEmptyCoreRules old_rules &&
595 not (workerExists old_wrkr) &&
596 not (hasUnfolding (unfoldingInfo info))
598 keep_occ = keep_fragile || not (isFragileOcc old_occ)
599 keep_arity = keep_fragile || old_arity == unknownArity
600 old_arity = arityInfo info
601 old_occ = occInfo info
602 old_rules = specInfo info
603 old_wrkr = workerInfo info
606 substIdType :: Subst -> Id -> Id
607 substIdType subst@(Subst in_scope id_env tv_env) id
608 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
609 | otherwise = setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
610 -- The tyVarsOfType is cheaper than it looks
611 -- because we cache the free tyvars of the type
612 -- in a Note in the id's type itself
617 substWorker :: Subst -> WorkerInfo -> WorkerInfo
618 -- Seq'ing on the returned WorkerInfo is enough to cause all the
619 -- substitutions to happen completely
621 substWorker subst NoWorker
623 substWorker subst (HasWorker w a)
624 = case substId subst w of
625 DoneId w1 _ -> HasWorker w1 a
626 DoneEx (Var w1) -> HasWorker w1 a
627 DoneEx other -> WARN( not (exprIsTrivial other), text "substWorker: DoneEx" <+> ppr w )
628 NoWorker -- Worker has got substituted away altogether
629 -- This can happen if it's trivial,
630 -- via postInlineUnconditionally
631 ContEx se1 e -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
635 substUnfolding subst NoUnfolding = NoUnfolding
636 substUnfolding subst (OtherCon cons) = OtherCon cons
637 substUnfolding subst (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr subst rhs)
638 substUnfolding subst (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr subst rhs) t v w g
641 substRules :: Subst -> CoreRules -> CoreRules
642 -- Seq'ing on the returned CoreRules is enough to cause all the
643 -- substitutions to happen completely
645 substRules subst rules
646 | isEmptySubst subst = rules
648 substRules subst (Rules rules rhs_fvs)
649 = seqRules new_rules `seq` new_rules
651 new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
653 do_subst rule@(BuiltinRule _ _) = rule
654 do_subst (Rule name act tpl_vars lhs_args rhs)
655 = Rule name act tpl_vars'
656 (map (substExpr subst') lhs_args)
657 (substExpr subst' rhs)
659 (subst', tpl_vars') = substBndrs subst tpl_vars
662 substVarSet subst fvs
663 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
666 | isId fv = case substId subst fv of
667 DoneId fv' _ -> unitVarSet fv'
668 DoneEx expr -> exprFreeVars expr
669 ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
670 | otherwise = case lookupTvSubst subst fv of
671 Nothing -> unitVarSet fv
672 Just ty -> substVarSet subst (tyVarsOfType ty)