2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CoreUtils]{Utility functions on @Core@ syntax}
9 InScopeSet, emptyInScopeSet, mkInScopeSet,
10 extendInScopeSet, extendInScopeSetList,
11 lookupInScope, elemInScopeSet, uniqAway,
15 Subst, TyVarSubst, IdSubst,
16 emptySubst, mkSubst, substEnv, substInScope,
17 lookupSubst, lookupIdSubst, isEmptySubst, extendSubst, extendSubstList,
18 zapSubstEnv, setSubstEnv,
20 extendInScope, extendInScopeList, extendNewInScope, extendNewInScopeList,
21 isInScope, modifyInScope,
23 bindSubst, unBindSubst, bindSubstList, unBindSubstList,
26 substBndr, substBndrs, substTyVar, substId, substIds,
27 substAndCloneId, substAndCloneIds,
30 mkTyVarSubst, mkTopTyVarSubst,
31 substTy, substClasses, substTheta,
34 substExpr, substIdInfo
37 #include "HsVersions.h"
39 import CmdLineOpts ( opt_PprStyle_Debug )
40 import CoreSyn ( Expr(..), Bind(..), Note(..), CoreExpr,
41 CoreRules(..), CoreRule(..),
42 isEmptyCoreRules, seqRules
44 import CoreFVs ( exprFreeVars, mustHaveLocalBinding )
45 import TypeRep ( Type(..), TyNote(..),
47 import Type ( ThetaType, PredType(..), ClassContext,
48 tyVarsOfType, tyVarsOfTypes, mkAppTy
52 import Var ( setVarUnique, isId )
53 import Id ( idType, setIdType, idOccInfo, zapFragileIdInfo )
54 import IdInfo ( IdInfo, isFragileOcc,
55 specInfo, setSpecInfo,
56 WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
58 import Unique ( Uniquable(..), deriveUnique )
59 import UniqSet ( elemUniqSet_Directly )
60 import UniqSupply ( UniqSupply, uniqFromSupply, splitUniqSupply )
61 import Var ( Var, Id, TyVar, isTyVar )
63 import PprCore () -- Instances
64 import UniqFM ( ufmToList ) -- Yuk (add a new op to VarEnv)
65 import Util ( mapAccumL, foldl2, seqList, ($!) )
70 %************************************************************************
72 \subsection{The in-scope set}
74 %************************************************************************
77 data InScopeSet = InScope (VarEnv Var) FastInt
78 -- The Int# is a kind of hash-value used by uniqAway
79 -- For example, it might be the size of the set
80 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
82 emptyInScopeSet :: InScopeSet
83 emptyInScopeSet = InScope emptyVarSet 1#
85 mkInScopeSet :: VarEnv Var -> InScopeSet
86 mkInScopeSet in_scope = InScope in_scope 1#
88 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
89 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
91 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
92 extendInScopeSetList (InScope in_scope n) vs
93 = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
94 (n +# iUnbox (length vs))
96 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
97 -- Exploit the fact that the in-scope "set" is really a map
98 -- Make old_v map to new_v
99 modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
101 delInScopeSet :: InScopeSet -> Var -> InScopeSet
102 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
104 elemInScopeSet :: Var -> InScopeSet -> Bool
105 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
107 lookupInScope :: InScopeSet -> Var -> Var
108 -- It's important to look for a fixed point
109 -- When we see (case x of y { I# v -> ... })
110 -- we add [x -> y] to the in-scope set (Simplify.simplCaseBinder).
111 -- When we lookup up an occurrence of x, we map to y, but then
112 -- we want to look up y in case it has acquired more evaluation information by now.
113 lookupInScope (InScope in_scope n) v
116 go v = case lookupVarEnv in_scope v of
117 Just v' | v == v' -> v' -- Reached a fixed point
119 Nothing -> WARN( mustHaveLocalBinding v, ppr v )
124 uniqAway :: InScopeSet -> Var -> Var
125 -- (uniqAway in_scope v) finds a unique that is not used in the
126 -- in-scope set, and gives that to v. It starts with v's current unique, of course,
127 -- in the hope that it won't have to change it, nad thereafter uses a combination
128 -- of that and the hash-code found in the in-scope set
129 uniqAway (InScope set n) var
130 | not (var `elemVarSet` set) = var -- Nothing to do
133 orig_unique = getUnique var
137 = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
139 | uniq `elemUniqSet_Directly` set = try (k +# 1#)
141 | opt_PprStyle_Debug && k ># 3#
142 = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
143 setVarUnique var uniq
145 | otherwise = setVarUnique var uniq
147 uniq = deriveUnique orig_unique (iBox (n *# k))
151 %************************************************************************
153 \subsection{Substitutions}
155 %************************************************************************
158 data Subst = Subst InScopeSet -- In scope
159 SubstEnv -- Substitution itself
160 -- INVARIANT 1: The (domain of the) in-scope set is a superset
161 -- of the free vars of the range of the substitution
162 -- that might possibly clash with locally-bound variables
163 -- in the thing being substituted in.
164 -- This is what lets us deal with name capture properly
165 -- It's a hard invariant to check...
166 -- There are various ways of causing it to happen:
167 -- - arrange that the in-scope set really is all the things in scope
168 -- - arrange that it's the free vars of the range of the substitution
169 -- - make it empty because all the free vars of the subst are fresh,
170 -- and hence can't possibly clash.a
172 -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
173 -- Equivalently, the substitution is idempotent
174 -- [Sep 2000: Lies, all lies. The substitution now does contain
175 -- mappings x77 -> DoneId x77 occ
176 -- to record x's occurrence information.]
177 -- [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
178 -- Consider let x = case k of I# x77 -> ... in
179 -- let y = case k of I# x77 -> ... in ...
180 -- and suppose the body is strict in both x and y. Then the simplifier
181 -- will pull the first (case k) to the top; so the second (case k) will
182 -- cancel out, mapping x77 to, well, x77! But one is an in-Id and the
183 -- other is an out-Id. So the substitution is idempotent in the sense
184 -- that we *must not* repeatedly apply it.]
189 The general plan about the substitution and in-scope set for Ids is as follows
191 * substId always adds new_id to the in-scope set.
192 new_id has a correctly-substituted type, but all its fragile IdInfo has been zapped.
193 That is added back in later. So new_id is the minimal thing it's
194 correct to substitute.
196 * substId adds a binding (DoneId new_id occ) to the substitution if
197 EITHER the Id's unique has changed
198 OR the Id has interesting occurrence information
199 So in effect you can only get to interesting occurrence information
200 by looking up the *old* Id; it's not really attached to the new id
203 Note, though that the substitution isn't necessarily extended
204 if the type changes. Why not? Because of the next point:
206 * We *always, always* finish by looking up in the in-scope set
207 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
208 Reason: so that we never finish up with a "old" Id in the result.
209 An old Id might point to an old unfolding and so on... which gives a space leak.
211 [The DoneEx and DoneVar hits map to "new" stuff.]
213 * It follows that substExpr must not do a no-op if the substitution is empty.
214 substType is free to do so, however.
216 * When we come to a let-binding (say) we generate new IdInfo, including an
217 unfolding, attach it to the binder, and add this newly adorned binder to
218 the in-scope set. So all subsequent occurrences of the binder will get mapped
219 to the full-adorned binder, which is also the one put in the binding site.
221 * The in-scope "set" usually maps x->x; we use it simply for its domain.
222 But sometimes we have two in-scope Ids that are synomyms, and should
223 map to the same target: x->x, y->x. Notably:
225 That's why the "set" is actually a VarEnv Var
229 isEmptySubst :: Subst -> Bool
230 isEmptySubst (Subst _ env) = isEmptySubstEnv env
233 emptySubst = Subst emptyInScopeSet emptySubstEnv
235 mkSubst :: InScopeSet -> SubstEnv -> Subst
236 mkSubst in_scope env = Subst in_scope env
238 substEnv :: Subst -> SubstEnv
239 substEnv (Subst _ env) = env
241 substInScope :: Subst -> InScopeSet
242 substInScope (Subst in_scope _) = in_scope
244 zapSubstEnv :: Subst -> Subst
245 zapSubstEnv (Subst in_scope env) = Subst in_scope emptySubstEnv
247 extendSubst :: Subst -> Var -> SubstResult -> Subst
248 extendSubst (Subst in_scope env) v r = Subst in_scope (extendSubstEnv env v r)
250 extendSubstList :: Subst -> [Var] -> [SubstResult] -> Subst
251 extendSubstList (Subst in_scope env) v r = Subst in_scope (extendSubstEnvList env v r)
253 lookupSubst :: Subst -> Var -> Maybe SubstResult
254 lookupSubst (Subst _ env) v = lookupSubstEnv env v
256 lookupIdSubst :: Subst -> Id -> SubstResult
257 -- Does the lookup in the in-scope set too
258 lookupIdSubst (Subst in_scope env) v
259 = case lookupSubstEnv env v of
260 Just (DoneId v' occ) -> DoneId (lookupInScope in_scope v') occ
262 Nothing -> DoneId v' (idOccInfo v')
263 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
264 -- very important! If isFragileOcc returned True for
265 -- loop breakers we could avoid this call, but at the expense
266 -- of adding more to the substitution, and building new Ids
267 -- in substId a bit more often than really necessary
269 v' = lookupInScope in_scope v
271 isInScope :: Var -> Subst -> Bool
272 isInScope v (Subst in_scope _) = v `elemInScopeSet` in_scope
274 modifyInScope :: Subst -> Var -> Var -> Subst
275 modifyInScope (Subst in_scope env) old_v new_v = Subst (modifyInScopeSet in_scope old_v new_v) env
276 -- make old_v map to new_v
278 extendInScope :: Subst -> Var -> Subst
279 -- Add a new variable as in-scope
280 -- Remember to delete any existing binding in the substitution!
281 extendInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v)
282 (env `delSubstEnv` v)
284 extendInScopeList :: Subst -> [Var] -> Subst
285 extendInScopeList (Subst in_scope env) vs = Subst (extendInScopeSetList in_scope vs)
286 (delSubstEnvList env vs)
288 -- The "New" variants are guaranteed to be adding freshly-allocated variables
289 -- It's not clear that the gain (not needing to delete it from the substitution)
290 -- is worth the extra proof obligation
291 extendNewInScope :: Subst -> Var -> Subst
292 extendNewInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v) env
294 extendNewInScopeList :: Subst -> [Var] -> Subst
295 extendNewInScopeList (Subst in_scope env) vs = Subst (in_scope `extendInScopeSetList` vs) env
297 -------------------------------
298 bindSubst :: Subst -> Var -> Var -> Subst
299 -- Extend with a substitution, v1 -> Var v2
300 -- and extend the in-scopes with v2
301 bindSubst (Subst in_scope env) old_bndr new_bndr
302 = Subst (in_scope `extendInScopeSet` new_bndr)
303 (extendSubstEnv env old_bndr subst_result)
305 subst_result | isId old_bndr = DoneEx (Var new_bndr)
306 | otherwise = DoneTy (TyVarTy new_bndr)
308 unBindSubst :: Subst -> Var -> Var -> Subst
309 -- Reverse the effect of bindSubst
310 -- If old_bndr was already in the substitution, this doesn't quite work
311 unBindSubst (Subst in_scope env) old_bndr new_bndr
312 = Subst (in_scope `delInScopeSet` new_bndr) (delSubstEnv env old_bndr)
314 -- And the "List" forms
315 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
316 bindSubstList subst old_bndrs new_bndrs
317 = foldl2 bindSubst subst old_bndrs new_bndrs
319 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
320 unBindSubstList subst old_bndrs new_bndrs
321 = foldl2 unBindSubst subst old_bndrs new_bndrs
324 -------------------------------
325 setInScope :: Subst -- Take env part from here
328 setInScope (Subst in_scope1 env1) in_scope2
329 = Subst in_scope2 env1
331 setSubstEnv :: Subst -- Take in-scope part from here
332 -> SubstEnv -- ... and env part from here
334 setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2
337 Pretty printing, for debugging only
340 instance Outputable SubstResult where
341 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
342 ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
343 ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
344 ppr (DoneTy t) = ptext SLIT("DoneTy") <+> ppr t
346 instance Outputable SubstEnv where
347 ppr se = brackets (fsep (punctuate comma (map ppr_elt (ufmToList (substEnvEnv se)))))
349 ppr_elt (uniq,sr) = ppr uniq <+> ptext SLIT("->") <+> ppr sr
351 instance Outputable Subst where
352 ppr (Subst (InScope in_scope _) se)
353 = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (rngVarEnv in_scope)))
354 $$ ptext SLIT(" Subst =") <+> ppr se <> char '>'
357 %************************************************************************
359 \subsection{Type substitution}
361 %************************************************************************
364 type TyVarSubst = Subst -- TyVarSubst are expected to have range elements
365 -- (We could have a variant of Subst, but it doesn't seem worth it.)
367 -- mkTyVarSubst generates the in-scope set from
368 -- the types given; but it's just a thunk so with a bit of luck
369 -- it'll never be evaluated
370 mkTyVarSubst :: [TyVar] -> [Type] -> Subst
371 mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys)) (zip_ty_env tyvars tys emptySubstEnv)
373 -- mkTopTyVarSubst is called when doing top-level substitutions.
374 -- Here we expect that the free vars of the range of the
375 -- substitution will be empty.
376 mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
377 mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
379 zip_ty_env [] [] env = env
380 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
383 substTy works with general Substs, so that it can be called from substExpr too.
386 substTy :: Subst -> Type -> Type
387 substTy subst ty | isEmptySubst subst = ty
388 | otherwise = subst_ty subst ty
390 substClasses :: TyVarSubst -> ClassContext -> ClassContext
391 substClasses subst theta
392 | isEmptySubst subst = theta
393 | otherwise = [(clas, map (subst_ty subst) tys) | (clas, tys) <- theta]
395 substTheta :: TyVarSubst -> ThetaType -> ThetaType
396 substTheta subst theta
397 | isEmptySubst subst = theta
398 | otherwise = map (substPred subst) theta
400 substPred :: TyVarSubst -> PredType -> PredType
401 substPred subst (Class clas tys) = Class clas (map (subst_ty subst) tys)
402 substPred subst (IParam n ty) = IParam n (subst_ty subst ty)
407 go (TyConApp tc tys) = let args = map go tys
408 in args `seqList` TyConApp tc args
410 go (PredTy p) = PredTy $! (substPred subst p)
412 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2)
413 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
414 go (NoteTy (UsgNote usg) ty2) = (NoteTy $! UsgNote usg) $! go ty2 -- Keep usage annot
415 go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2 -- Keep uvar bdr
417 go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
418 go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
419 go ty@(TyVarTy tv) = case (lookupSubst subst tv) of
421 Just (DoneTy ty') -> ty'
423 go (ForAllTy tv ty) = case substTyVar subst tv of
424 (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
427 Here is where we invent a new binder if necessary.
430 substTyVar :: Subst -> TyVar -> (Subst, TyVar)
431 substTyVar subst@(Subst in_scope env) old_var
432 | old_var == new_var -- No need to clone
433 -- But we *must* zap any current substitution for the variable.
435 -- (\x.e) with id_subst = [x |-> e']
436 -- Here we must simply zap the substitution for x
438 -- The new_id isn't cloned, but it may have a different type
439 -- etc, so we must return it, not the old id
440 = (Subst (in_scope `extendInScopeSet` new_var)
441 (delSubstEnv env old_var),
444 | otherwise -- The new binder is in scope so
445 -- we'd better rename it away from the in-scope variables
446 -- Extending the substitution to do this renaming also
447 -- has the (correct) effect of discarding any existing
448 -- substitution for that variable
449 = (Subst (in_scope `extendInScopeSet` new_var)
450 (extendSubstEnv env old_var (DoneTy (TyVarTy new_var))),
453 new_var = uniqAway in_scope old_var
454 -- The uniqAway part makes sure the new variable is not already in scope
458 %************************************************************************
460 \section{Expression substitution}
462 %************************************************************************
464 This expression substituter deals correctly with name capture.
466 BUT NOTE that substExpr silently discards the
469 IdInfo attached to any binders in the expression. It's quite
470 tricky to do them 'right' in the case of mutually recursive bindings,
471 and so far has proved unnecessary.
474 substExpr :: Subst -> CoreExpr -> CoreExpr
476 -- NB: we do not do a no-op when the substitution is empty,
477 -- because we always want to substitute the variables in the
478 -- in-scope set for their occurrences. Why?
479 -- (a) because they may contain more information
480 -- (b) because leaving an un-substituted Id might cause
481 -- a space leak (its unfolding might point to an old version
482 -- of its right hand side).
486 go (Var v) = -- See the notes at the top, with the Subst data type declaration
487 case lookupIdSubst subst v of
489 ContEx env' e' -> substExpr (setSubstEnv subst env') e'
493 go (Type ty) = Type (go_ty ty)
494 go (Lit lit) = Lit lit
495 go (App fun arg) = App (go fun) (go arg)
496 go (Note note e) = Note (go_note note) (go e)
498 go (Lam bndr body) = Lam bndr' (substExpr subst' body)
500 (subst', bndr') = substBndr subst bndr
502 go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
504 (subst', bndr') = substBndr subst bndr
506 go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
508 (subst', bndrs') = substBndrs subst (map fst pairs)
509 pairs' = bndrs' `zip` rhss'
510 rhss' = map (substExpr subst' . snd) pairs
512 go (Case scrut bndr alts) = Case (go scrut) bndr' (map (go_alt subst') alts)
514 (subst', bndr') = substBndr subst bndr
516 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
518 (subst', bndrs') = substBndrs subst bndrs
520 go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
523 go_ty ty = substTy subst ty
527 Substituting in binders is a rather tricky part of the whole compiler.
529 When we hit a binder we may need to
530 (a) apply the the type envt (if non-empty) to its type
531 (c) give it a new unique to avoid name clashes
534 substBndr :: Subst -> Var -> (Subst, Var)
536 | isTyVar bndr = substTyVar subst bndr
537 | otherwise = substId subst bndr
539 substBndrs :: Subst -> [Var] -> (Subst, [Var])
540 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
543 substIds :: Subst -> [Id] -> (Subst, [Id])
544 substIds subst bndrs = mapAccumL substId subst bndrs
546 substId :: Subst -> Id -> (Subst, Id)
547 -- Returns an Id with empty IdInfo
548 -- See the notes with the Subst data type decl at the
549 -- top of this module
551 substId subst@(Subst in_scope env) old_id
552 = (Subst (in_scope `extendInScopeSet` new_id) new_env, new_id)
554 id_ty = idType old_id
555 occ_info = idOccInfo old_id
557 -- id1 has its type zapped
558 id1 | noTypeSubst env
559 || isEmptyVarSet (tyVarsOfType id_ty) = old_id
560 -- The tyVarsOfType is cheaper than it looks
561 -- because we cache the free tyvars of the type
562 -- in a Note in the id's type itself
563 | otherwise = setIdType old_id (substTy subst id_ty)
565 -- id2 has its IdInfo zapped
566 id2 = zapFragileIdInfo id1
568 -- new_id is cloned if necessary
569 new_id = uniqAway in_scope id2
571 -- Extend the substitution if the unique has changed,
572 -- or there's some useful occurrence information
573 -- See the notes with substTyVar for the delSubstEnv
574 new_env | new_id /= old_id || isFragileOcc occ_info
575 = extendSubstEnv env old_id (DoneId new_id occ_info)
577 = delSubstEnv env old_id
580 Now a variant that unconditionally allocates a new unique.
583 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, UniqSupply, [Id])
584 substAndCloneIds subst us [] = (subst, us, [])
585 substAndCloneIds subst us (b:bs) = case substAndCloneId subst us b of { (subst1, us1, b') ->
586 case substAndCloneIds subst1 us1 bs of { (subst2, us2, bs') ->
587 (subst2, us2, (b':bs')) }}
589 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, UniqSupply, Id)
590 substAndCloneId subst@(Subst in_scope env) us old_id
591 = (Subst (in_scope `extendInScopeSet` new_id)
592 (extendSubstEnv env old_id (DoneEx (Var new_id))),
596 id_ty = idType old_id
597 id1 | noTypeSubst env || isEmptyVarSet (tyVarsOfType id_ty) = old_id
598 | otherwise = setIdType old_id (substTy subst id_ty)
600 id2 = zapFragileIdInfo id1
601 new_id = setVarUnique id2 (uniqFromSupply us1)
602 (us1,new_us) = splitUniqSupply us
606 %************************************************************************
608 \section{IdInfo substitution}
610 %************************************************************************
614 -> IdInfo -- Get un-substituted ones from here
615 -> IdInfo -- Substitute it and add it to here
616 -> IdInfo -- To give this
617 -- Seq'ing on the returned IdInfo is enough to cause all the
618 -- substitutions to happen completely
620 substIdInfo subst old_info new_info
623 info1 | isEmptyCoreRules old_rules = new_info
624 | otherwise = new_info `setSpecInfo` new_rules
625 -- setSpecInfo does a seq
627 new_rules = substRules subst old_rules
629 info2 | not (workerExists old_wrkr) = info1
630 | otherwise = info1 `setWorkerInfo` new_wrkr
631 -- setWorkerInfo does a seq
633 new_wrkr = substWorker subst old_wrkr
635 old_rules = specInfo old_info
636 old_wrkr = workerInfo old_info
638 substWorker :: Subst -> WorkerInfo -> WorkerInfo
639 -- Seq'ing on the returned WorkerInfo is enough to cause all the
640 -- substitutions to happen completely
642 substWorker subst NoWorker
644 substWorker subst (HasWorker w a)
645 = case lookupIdSubst subst w of
646 (DoneId w1 _) -> HasWorker w1 a
647 (DoneEx (Var w1)) -> HasWorker w1 a
648 (DoneEx other) -> WARN( True, text "substWorker: DoneEx" <+> ppr w )
649 NoWorker -- Worker has got substituted away altogether
650 (ContEx se1 e) -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
653 substRules :: Subst -> CoreRules -> CoreRules
654 -- Seq'ing on the returned CoreRules is enough to cause all the
655 -- substitutions to happen completely
657 substRules subst rules
658 | isEmptySubst subst = rules
660 substRules subst (Rules rules rhs_fvs)
661 = seqRules new_rules `seq` new_rules
663 new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
665 do_subst rule@(BuiltinRule _) = rule
666 do_subst (Rule name tpl_vars lhs_args rhs)
667 = Rule name tpl_vars'
668 (map (substExpr subst') lhs_args)
669 (substExpr subst' rhs)
671 (subst', tpl_vars') = substBndrs subst tpl_vars
673 substVarSet subst fvs
674 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
676 subst_fv subst fv = case lookupIdSubst subst fv of
677 DoneId fv' _ -> unitVarSet fv'
678 DoneEx expr -> exprFreeVars expr
679 DoneTy ty -> tyVarsOfType ty
680 ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)