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, CoreBndr,
41 CoreRules(..), CoreRule(..),
42 emptyCoreRules, 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, ($!) )
69 %************************************************************************
71 \subsection{The in-scope set}
73 %************************************************************************
76 data InScopeSet = InScope (VarEnv Var) Int#
77 -- The Int# is a kind of hash-value used by uniqAway
78 -- For example, it might be the size of the set
79 -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
81 emptyInScopeSet :: InScopeSet
82 emptyInScopeSet = InScope emptyVarSet 1#
84 mkInScopeSet :: VarEnv Var -> InScopeSet
85 mkInScopeSet in_scope = InScope in_scope 1#
87 extendInScopeSet :: InScopeSet -> Var -> InScopeSet
88 extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
90 extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
91 extendInScopeSetList (InScope in_scope n) vs = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
92 (case length vs of { I# l -> n +# l })
94 modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
95 -- Exploit the fact that the in-scope "set" is really a map
96 -- Make old_v map to new_v
97 modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
99 delInScopeSet :: InScopeSet -> Var -> InScopeSet
100 delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
102 elemInScopeSet :: Var -> InScopeSet -> Bool
103 elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
105 lookupInScope :: InScopeSet -> Var -> Var
106 -- It's important to look for a fixed point
107 -- When we see (case x of y { I# v -> ... })
108 -- we add [x -> y] to the in-scope set (Simplify.simplCaseBinder).
109 -- When we lookup up an occurrence of x, we map to y, but then
110 -- we want to look up y in case it has acquired more evaluation information by now.
111 lookupInScope (InScope in_scope n) v
114 go v = case lookupVarEnv in_scope v of
115 Just v' | v == v' -> v' -- Reached a fixed point
117 Nothing -> WARN( mustHaveLocalBinding v, ppr v )
122 uniqAway :: InScopeSet -> Var -> Var
123 -- (uniqAway in_scope v) finds a unique that is not used in the
124 -- in-scope set, and gives that to v. It starts with v's current unique, of course,
125 -- in the hope that it won't have to change it, nad thereafter uses a combination
126 -- of that and the hash-code found in the in-scope set
127 uniqAway (InScope set n) var
128 | not (var `elemVarSet` set) = var -- Nothing to do
131 orig_unique = getUnique var
135 = pprPanic "uniqAway loop:" (ppr (I# k) <+> text "tries" <+> ppr var <+> int (I# n))
137 | uniq `elemUniqSet_Directly` set = try (k +# 1#)
139 | opt_PprStyle_Debug && k ># 3#
140 = pprTrace "uniqAway:" (ppr (I# k) <+> text "tries" <+> ppr var <+> int (I# n))
141 setVarUnique var uniq
143 | otherwise = setVarUnique var uniq
145 uniq = deriveUnique orig_unique (I# (n *# k))
149 %************************************************************************
151 \subsection{Substitutions}
153 %************************************************************************
156 data Subst = Subst InScopeSet -- In scope
157 SubstEnv -- Substitution itself
158 -- INVARIANT 1: The (domain of the) in-scope set is a superset
159 -- of the free vars of the range of the substitution
160 -- that might possibly clash with locally-bound variables
161 -- in the thing being substituted in.
162 -- This is what lets us deal with name capture properly
163 -- It's a hard invariant to check...
164 -- There are various ways of causing it to happen:
165 -- - arrange that the in-scope set really is all the things in scope
166 -- - arrange that it's the free vars of the range of the substitution
167 -- - make it empty because all the free vars of the subst are fresh,
168 -- and hence can't possibly clash.a
170 -- INVARIANT 2: No variable is both in scope and in the domain of the substitution
171 -- Equivalently, the substitution is idempotent
172 -- [Sep 2000: Lies, all lies. The substitution now does contain
173 -- mappings x77 -> DoneId x77 occ
174 -- to record x's occurrence information.]
175 -- [Also watch out: the substitution can contain x77 -> DoneEx (Var x77)
176 -- Consider let x = case k of I# x77 -> ... in
177 -- let y = case k of I# x77 -> ... in ...
178 -- and suppose the body is strict in both x and y. Then the simplifier
179 -- will pull the first (case k) to the top; so the second (case k) will
180 -- cancel out, mapping x77 to, well, x77! But one is an in-Id and the
181 -- other is an out-Id. So the substitution is idempotent in the sense
182 -- that we *must not* repeatedly apply it.]
187 The general plan about the substitution and in-scope set for Ids is as follows
189 * substId always adds new_id to the in-scope set.
190 new_id has a correctly-substituted type, but all its fragile IdInfo has been zapped.
191 That is added back in later. So new_id is the minimal thing it's
192 correct to substitute.
194 * substId adds a binding (DoneId new_id occ) to the substitution if
195 EITHER the Id's unique has changed
196 OR the Id has interesting occurrence information
197 So in effect you can only get to interesting occurrence information
198 by looking up the *old* Id; it's not really attached to the new id
201 Note, though that the substitution isn't necessarily extended
202 if the type changes. Why not? Because of the next point:
204 * We *always, always* finish by looking up in the in-scope set
205 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
206 Reason: so that we never finish up with a "old" Id in the result.
207 An old Id might point to an old unfolding and so on... which gives a space leak.
209 [The DoneEx and DoneVar hits map to "new" stuff.]
211 * It follows that substExpr must not do a no-op if the substitution is empty.
212 substType is free to do so, however.
214 * When we come to a let-binding (say) we generate new IdInfo, including an
215 unfolding, attach it to the binder, and add this newly adorned binder to
216 the in-scope set. So all subsequent occurrences of the binder will get mapped
217 to the full-adorned binder, which is also the one put in the binding site.
219 * The in-scope "set" usually maps x->x; we use it simply for its domain.
220 But sometimes we have two in-scope Ids that are synomyms, and should
221 map to the same target: x->x, y->x. Notably:
223 That's why the "set" is actually a VarEnv Var
227 isEmptySubst :: Subst -> Bool
228 isEmptySubst (Subst _ env) = isEmptySubstEnv env
231 emptySubst = Subst emptyInScopeSet emptySubstEnv
233 mkSubst :: InScopeSet -> SubstEnv -> Subst
234 mkSubst in_scope env = Subst in_scope env
236 substEnv :: Subst -> SubstEnv
237 substEnv (Subst _ env) = env
239 substInScope :: Subst -> InScopeSet
240 substInScope (Subst in_scope _) = in_scope
242 zapSubstEnv :: Subst -> Subst
243 zapSubstEnv (Subst in_scope env) = Subst in_scope emptySubstEnv
245 extendSubst :: Subst -> Var -> SubstResult -> Subst
246 extendSubst (Subst in_scope env) v r = Subst in_scope (extendSubstEnv env v r)
248 extendSubstList :: Subst -> [Var] -> [SubstResult] -> Subst
249 extendSubstList (Subst in_scope env) v r = Subst in_scope (extendSubstEnvList env v r)
251 lookupSubst :: Subst -> Var -> Maybe SubstResult
252 lookupSubst (Subst _ env) v = lookupSubstEnv env v
254 lookupIdSubst :: Subst -> Id -> SubstResult
255 -- Does the lookup in the in-scope set too
256 lookupIdSubst (Subst in_scope env) v
257 = case lookupSubstEnv env v of
258 Just (DoneId v' occ) -> DoneId (lookupInScope in_scope v') occ
260 Nothing -> DoneId v' (idOccInfo v')
261 -- We don't use DoneId for LoopBreakers, so the idOccInfo is
262 -- very important! If isFragileOcc returned True for
263 -- loop breakers we could avoid this call, but at the expense
264 -- of adding more to the substitution, and building new Ids
265 -- in substId a bit more often than really necessary
267 v' = lookupInScope in_scope v
269 isInScope :: Var -> Subst -> Bool
270 isInScope v (Subst in_scope _) = v `elemInScopeSet` in_scope
272 modifyInScope :: Subst -> Var -> Var -> Subst
273 modifyInScope (Subst in_scope env) old_v new_v = Subst (modifyInScopeSet in_scope old_v new_v) env
274 -- make old_v map to new_v
276 extendInScope :: Subst -> Var -> Subst
277 -- Add a new variable as in-scope
278 -- Remember to delete any existing binding in the substitution!
279 extendInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v)
280 (env `delSubstEnv` v)
282 extendInScopeList :: Subst -> [Var] -> Subst
283 extendInScopeList (Subst in_scope env) vs = Subst (extendInScopeSetList in_scope vs)
284 (delSubstEnvList env vs)
286 -- The "New" variants are guaranteed to be adding freshly-allocated variables
287 -- It's not clear that the gain (not needing to delete it from the substitution)
288 -- is worth the extra proof obligation
289 extendNewInScope :: Subst -> Var -> Subst
290 extendNewInScope (Subst in_scope env) v = Subst (in_scope `extendInScopeSet` v) env
292 extendNewInScopeList :: Subst -> [Var] -> Subst
293 extendNewInScopeList (Subst in_scope env) vs = Subst (in_scope `extendInScopeSetList` vs) env
295 -------------------------------
296 bindSubst :: Subst -> Var -> Var -> Subst
297 -- Extend with a substitution, v1 -> Var v2
298 -- and extend the in-scopes with v2
299 bindSubst (Subst in_scope env) old_bndr new_bndr
300 = Subst (in_scope `extendInScopeSet` new_bndr)
301 (extendSubstEnv env old_bndr subst_result)
303 subst_result | isId old_bndr = DoneEx (Var new_bndr)
304 | otherwise = DoneTy (TyVarTy new_bndr)
306 unBindSubst :: Subst -> Var -> Var -> Subst
307 -- Reverse the effect of bindSubst
308 -- If old_bndr was already in the substitution, this doesn't quite work
309 unBindSubst (Subst in_scope env) old_bndr new_bndr
310 = Subst (in_scope `delInScopeSet` new_bndr) (delSubstEnv env old_bndr)
312 -- And the "List" forms
313 bindSubstList :: Subst -> [Var] -> [Var] -> Subst
314 bindSubstList subst old_bndrs new_bndrs
315 = foldl2 bindSubst subst old_bndrs new_bndrs
317 unBindSubstList :: Subst -> [Var] -> [Var] -> Subst
318 unBindSubstList subst old_bndrs new_bndrs
319 = foldl2 unBindSubst subst old_bndrs new_bndrs
322 -------------------------------
323 setInScope :: Subst -- Take env part from here
326 setInScope (Subst in_scope1 env1) in_scope2
327 = Subst in_scope2 env1
329 setSubstEnv :: Subst -- Take in-scope part from here
330 -> SubstEnv -- ... and env part from here
332 setSubstEnv (Subst in_scope1 _) env2 = Subst in_scope1 env2
335 Pretty printing, for debugging only
338 instance Outputable SubstResult where
339 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
340 ppr (DoneId v _) = ptext SLIT("DoneId") <+> ppr v
341 ppr (ContEx _ e) = ptext SLIT("ContEx") <+> ppr e
342 ppr (DoneTy t) = ptext SLIT("DoneTy") <+> ppr t
344 instance Outputable SubstEnv where
345 ppr se = brackets (fsep (punctuate comma (map ppr_elt (ufmToList (substEnvEnv se)))))
347 ppr_elt (uniq,sr) = ppr uniq <+> ptext SLIT("->") <+> ppr sr
349 instance Outputable Subst where
350 ppr (Subst (InScope in_scope _) se)
351 = ptext SLIT("<InScope =") <+> braces (fsep (map ppr (rngVarEnv in_scope)))
352 $$ ptext SLIT(" Subst =") <+> ppr se <> char '>'
355 %************************************************************************
357 \subsection{Type substitution}
359 %************************************************************************
362 type TyVarSubst = Subst -- TyVarSubst are expected to have range elements
363 -- (We could have a variant of Subst, but it doesn't seem worth it.)
365 -- mkTyVarSubst generates the in-scope set from
366 -- the types given; but it's just a thunk so with a bit of luck
367 -- it'll never be evaluated
368 mkTyVarSubst :: [TyVar] -> [Type] -> Subst
369 mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys)) (zip_ty_env tyvars tys emptySubstEnv)
371 -- mkTopTyVarSubst is called when doing top-level substitutions.
372 -- Here we expect that the free vars of the range of the
373 -- substitution will be empty.
374 mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
375 mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
377 zip_ty_env [] [] env = env
378 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
381 substTy works with general Substs, so that it can be called from substExpr too.
384 substTy :: Subst -> Type -> Type
385 substTy subst ty | isEmptySubst subst = ty
386 | otherwise = subst_ty subst ty
388 substClasses :: TyVarSubst -> ClassContext -> ClassContext
389 substClasses subst theta
390 | isEmptySubst subst = theta
391 | otherwise = [(clas, map (subst_ty subst) tys) | (clas, tys) <- theta]
393 substTheta :: TyVarSubst -> ThetaType -> ThetaType
394 substTheta subst theta
395 | isEmptySubst subst = theta
396 | otherwise = map (substPred subst) theta
398 substPred :: TyVarSubst -> PredType -> PredType
399 substPred subst (Class clas tys) = Class clas (map (subst_ty subst) tys)
400 substPred subst (IParam n ty) = IParam n (subst_ty subst ty)
405 go (TyConApp tc tys) = let args = map go tys
406 in args `seqList` TyConApp tc args
408 go (PredTy p) = PredTy $! (substPred subst p)
410 go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2)
411 go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
412 go (NoteTy (UsgNote usg) ty2) = (NoteTy $! UsgNote usg) $! go ty2 -- Keep usage annot
413 go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2 -- Keep uvar bdr
415 go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
416 go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
417 go ty@(TyVarTy tv) = case (lookupSubst subst tv) of
419 Just (DoneTy ty') -> ty'
421 go (ForAllTy tv ty) = case substTyVar subst tv of
422 (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
425 Here is where we invent a new binder if necessary.
428 substTyVar :: Subst -> TyVar -> (Subst, TyVar)
429 substTyVar subst@(Subst in_scope env) old_var
430 | old_var == new_var -- No need to clone
431 -- But we *must* zap any current substitution for the variable.
433 -- (\x.e) with id_subst = [x |-> e']
434 -- Here we must simply zap the substitution for x
436 -- The new_id isn't cloned, but it may have a different type
437 -- etc, so we must return it, not the old id
438 = (Subst (in_scope `extendInScopeSet` new_var)
439 (delSubstEnv env old_var),
442 | otherwise -- The new binder is in scope so
443 -- we'd better rename it away from the in-scope variables
444 -- Extending the substitution to do this renaming also
445 -- has the (correct) effect of discarding any existing
446 -- substitution for that variable
447 = (Subst (in_scope `extendInScopeSet` new_var)
448 (extendSubstEnv env old_var (DoneTy (TyVarTy new_var))),
451 new_var = uniqAway in_scope old_var
452 -- The uniqAway part makes sure the new variable is not already in scope
456 %************************************************************************
458 \section{Expression substitution}
460 %************************************************************************
462 This expression substituter deals correctly with name capture.
464 BUT NOTE that substExpr silently discards the
467 IdInfo attached to any binders in the expression. It's quite
468 tricky to do them 'right' in the case of mutually recursive bindings,
469 and so far has proved unnecessary.
472 substExpr :: Subst -> CoreExpr -> CoreExpr
474 -- NB: we do not do a no-op when the substitution is empty,
475 -- because we always want to substitute the variables in the
476 -- in-scope set for their occurrences. Why?
477 -- (a) because they may contain more information
478 -- (b) because leaving an un-substituted Id might cause
479 -- a space leak (its unfolding might point to an old version
480 -- of its right hand side).
484 go (Var v) = -- See the notes at the top, with the Subst data type declaration
485 case lookupIdSubst subst v of
487 ContEx env' e' -> substExpr (setSubstEnv subst env') e'
491 go (Type ty) = Type (go_ty ty)
492 go (Lit lit) = Lit lit
493 go (App fun arg) = App (go fun) (go arg)
494 go (Note note e) = Note (go_note note) (go e)
496 go (Lam bndr body) = Lam bndr' (substExpr subst' body)
498 (subst', bndr') = substBndr subst bndr
500 go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
502 (subst', bndr') = substBndr subst bndr
504 go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
506 (subst', bndrs') = substBndrs subst (map fst pairs)
507 pairs' = bndrs' `zip` rhss'
508 rhss' = map (substExpr subst' . snd) pairs
510 go (Case scrut bndr alts) = Case (go scrut) bndr' (map (go_alt subst') alts)
512 (subst', bndr') = substBndr subst bndr
514 go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
516 (subst', bndrs') = substBndrs subst bndrs
518 go_note (Coerce ty1 ty2) = Coerce (go_ty ty1) (go_ty ty2)
521 go_ty ty = substTy subst ty
525 Substituting in binders is a rather tricky part of the whole compiler.
527 When we hit a binder we may need to
528 (a) apply the the type envt (if non-empty) to its type
529 (c) give it a new unique to avoid name clashes
532 substBndr :: Subst -> Var -> (Subst, Var)
534 | isTyVar bndr = substTyVar subst bndr
535 | otherwise = substId subst bndr
537 substBndrs :: Subst -> [Var] -> (Subst, [Var])
538 substBndrs subst bndrs = mapAccumL substBndr subst bndrs
541 substIds :: Subst -> [Id] -> (Subst, [Id])
542 substIds subst bndrs = mapAccumL substId subst bndrs
544 substId :: Subst -> Id -> (Subst, Id)
545 -- Returns an Id with empty IdInfo
546 -- See the notes with the Subst data type decl at the
547 -- top of this module
549 substId subst@(Subst in_scope env) old_id
550 = (Subst (in_scope `extendInScopeSet` new_id) new_env, new_id)
552 id_ty = idType old_id
553 occ_info = idOccInfo old_id
555 -- id1 has its type zapped
556 id1 | noTypeSubst env
557 || isEmptyVarSet (tyVarsOfType id_ty) = old_id
558 -- The tyVarsOfType is cheaper than it looks
559 -- because we cache the free tyvars of the type
560 -- in a Note in the id's type itself
561 | otherwise = setIdType old_id (substTy subst id_ty)
563 -- id2 has its IdInfo zapped
564 id2 = zapFragileIdInfo id1
566 -- new_id is cloned if necessary
567 new_id = uniqAway in_scope id2
569 -- Extend the substitution if the unique has changed,
570 -- or there's some useful occurrence information
571 -- See the notes with substTyVar for the delSubstEnv
572 new_env | new_id /= old_id || isFragileOcc occ_info
573 = extendSubstEnv env old_id (DoneId new_id occ_info)
575 = delSubstEnv env old_id
578 Now a variant that unconditionally allocates a new unique.
581 substAndCloneIds :: Subst -> UniqSupply -> [Id] -> (Subst, UniqSupply, [Id])
582 substAndCloneIds subst us [] = (subst, us, [])
583 substAndCloneIds subst us (b:bs) = case substAndCloneId subst us b of { (subst1, us1, b') ->
584 case substAndCloneIds subst1 us1 bs of { (subst2, us2, bs') ->
585 (subst2, us2, (b':bs')) }}
587 substAndCloneId :: Subst -> UniqSupply -> Id -> (Subst, UniqSupply, Id)
588 substAndCloneId subst@(Subst in_scope env) us old_id
589 = (Subst (in_scope `extendInScopeSet` new_id)
590 (extendSubstEnv env old_id (DoneEx (Var new_id))),
594 id_ty = idType old_id
595 id1 | noTypeSubst env || isEmptyVarSet (tyVarsOfType id_ty) = old_id
596 | otherwise = setIdType old_id (substTy subst id_ty)
598 id2 = zapFragileIdInfo id1
599 new_id = setVarUnique id2 (uniqFromSupply us1)
600 (us1,new_us) = splitUniqSupply us
604 %************************************************************************
606 \section{IdInfo substitution}
608 %************************************************************************
612 -> IdInfo -- Get un-substituted ones from here
613 -> IdInfo -- Substitute it and add it to here
614 -> IdInfo -- To give this
615 -- Seq'ing on the returned IdInfo is enough to cause all the
616 -- substitutions to happen completely
618 substIdInfo subst old_info new_info
621 info1 | isEmptyCoreRules old_rules = new_info
622 | otherwise = new_info `setSpecInfo` new_rules
623 -- setSpecInfo does a seq
625 new_rules = substRules subst old_rules
627 info2 | not (workerExists old_wrkr) = info1
628 | otherwise = info1 `setWorkerInfo` new_wrkr
629 -- setWorkerInfo does a seq
631 new_wrkr = substWorker subst old_wrkr
633 old_rules = specInfo old_info
634 old_wrkr = workerInfo old_info
636 substWorker :: Subst -> WorkerInfo -> WorkerInfo
637 -- Seq'ing on the returned WorkerInfo is enough to cause all the
638 -- substitutions to happen completely
640 substWorker subst NoWorker
642 substWorker subst (HasWorker w a)
643 = case lookupIdSubst subst w of
644 (DoneId w1 _) -> HasWorker w1 a
645 (DoneEx (Var w1)) -> HasWorker w1 a
646 (DoneEx other) -> WARN( True, text "substWorker: DoneEx" <+> ppr w )
647 NoWorker -- Worker has got substituted away altogether
648 (ContEx se1 e) -> WARN( True, text "substWorker: ContEx" <+> ppr w <+> ppr e)
651 substRules :: Subst -> CoreRules -> CoreRules
652 -- Seq'ing on the returned CoreRules is enough to cause all the
653 -- substitutions to happen completely
655 substRules subst rules
656 | isEmptySubst subst = rules
658 substRules subst (Rules rules rhs_fvs)
659 = seqRules new_rules `seq` new_rules
661 new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
663 do_subst rule@(BuiltinRule _) = rule
664 do_subst (Rule name tpl_vars lhs_args rhs)
665 = Rule name tpl_vars'
666 (map (substExpr subst') lhs_args)
667 (substExpr subst' rhs)
669 (subst', tpl_vars') = substBndrs subst tpl_vars
671 substVarSet subst fvs
672 = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
674 subst_fv subst fv = case lookupIdSubst subst fv of
675 DoneId fv' _ -> unitVarSet fv'
676 DoneEx expr -> exprFreeVars expr
677 DoneTy ty -> tyVarsOfType ty
678 ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)