2 % (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[SimplMonad]{The simplifier Monad}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
15 InId, InBind, InExpr, InAlt, InArg, InType, InBndr,
16 OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
17 InCoercion, OutCoercion,
19 -- The simplifier mode
23 SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
24 isAmongSimpl, intSwitchSet, switchIsOn,
26 setEnclosingCC, getEnclosingCC,
29 SimplEnv(..), pprSimplEnv, -- Temp not abstract
30 mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
31 zapSubstEnv, setSubstEnv,
32 getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
35 SimplSR(..), mkContEx, substId, lookupRecBndr,
37 simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
38 simplBinder, simplBinders, addBndrRules,
39 substExpr, substWorker, substTy,
42 Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
43 wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
44 doFloatFromRhs, getFloats
47 #include "HsVersions.h"
60 import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
61 import qualified Type ( substTy, substTyVarBndr )
62 import Type hiding ( substTy, substTyVarBndr )
74 %************************************************************************
76 \subsection[Simplify-types]{Type declarations}
78 %************************************************************************
81 type InBndr = CoreBndr
82 type InId = Id -- Not yet cloned
83 type InType = Type -- Ditto
84 type InBind = CoreBind
85 type InExpr = CoreExpr
88 type InCoercion = Coercion
90 type OutBndr = CoreBndr
91 type OutId = Id -- Cloned
92 type OutTyVar = TyVar -- Cloned
93 type OutType = Type -- Cloned
94 type OutCoercion = Coercion
95 type OutBind = CoreBind
96 type OutExpr = CoreExpr
101 %************************************************************************
103 \subsubsection{The @SimplEnv@ type}
105 %************************************************************************
111 seMode :: SimplifierMode,
112 seChkr :: SwitchChecker,
113 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
115 -- The current set of in-scope variables
116 -- They are all OutVars, and all bound in this module
117 seInScope :: InScopeSet, -- OutVars only
118 -- Includes all variables bound by seFloats
120 -- See Note [Simplifier floats]
122 -- The current substitution
123 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
124 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
128 pprSimplEnv :: SimplEnv -> SDoc
129 -- Used for debugging; selective
131 = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
132 ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
134 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
135 -- See Note [Extending the Subst] in CoreSubst
138 = DoneEx OutExpr -- Completed term
139 | DoneId OutId -- Completed term variable
140 | ContEx TvSubstEnv -- A suspended substitution
144 instance Outputable SimplSR where
145 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
146 ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
147 ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
148 ppr (filter_env tv), ppr (filter_env id) -}]
150 -- fvs = exprFreeVars e
151 -- filter_env env = filterVarEnv_Directly keep env
152 -- keep uniq _ = uniq `elemUFM_Directly` fvs
157 The in-scope part of Subst includes *all* in-scope TyVars and Ids
158 The elements of the set may have better IdInfo than the
159 occurrences of in-scope Ids, and (more important) they will
160 have a correctly-substituted type. So we use a lookup in this
161 set to replace occurrences
163 The Ids in the InScopeSet are replete with their Rules,
164 and as we gather info about the unfolding of an Id, we replace
165 it in the in-scope set.
167 The in-scope set is actually a mapping OutVar -> OutVar, and
168 in case expressions we sometimes bind
171 The substitution is *apply-once* only, because InIds and OutIds can overlap.
172 For example, we generally omit mappings
174 from the substitution, when we decide not to clone a77, but it's quite
175 legitimate to put the mapping in the substitution anyway.
177 Furthermore, consider
178 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
185 Of course, the substitution *must* applied! Things in its domain
186 simply aren't necessarily bound in the result.
188 * substId adds a binding (DoneId new_id) to the substitution if
189 the Id's unique has changed
192 Note, though that the substitution isn't necessarily extended
193 if the type changes. Why not? Because of the next point:
195 * We *always, always* finish by looking up in the in-scope set
196 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
197 Reason: so that we never finish up with a "old" Id in the result.
198 An old Id might point to an old unfolding and so on... which gives a space leak.
200 [The DoneEx and DoneVar hits map to "new" stuff.]
202 * It follows that substExpr must not do a no-op if the substitution is empty.
203 substType is free to do so, however.
205 * When we come to a let-binding (say) we generate new IdInfo, including an
206 unfolding, attach it to the binder, and add this newly adorned binder to
207 the in-scope set. So all subsequent occurrences of the binder will get mapped
208 to the full-adorned binder, which is also the one put in the binding site.
210 * The in-scope "set" usually maps x->x; we use it simply for its domain.
211 But sometimes we have two in-scope Ids that are synomyms, and should
212 map to the same target: x->x, y->x. Notably:
214 That's why the "set" is actually a VarEnv Var
218 mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
219 mkSimplEnv mode switches
220 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
221 seMode = mode, seInScope = emptyInScopeSet,
222 seFloats = emptyFloats,
223 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
224 -- The top level "enclosing CC" is "SUBSUMED".
226 ---------------------
227 getSwitchChecker :: SimplEnv -> SwitchChecker
228 getSwitchChecker env = seChkr env
230 ---------------------
231 getMode :: SimplEnv -> SimplifierMode
232 getMode env = seMode env
234 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
235 setMode mode env = env { seMode = mode }
237 ---------------------
238 getEnclosingCC :: SimplEnv -> CostCentreStack
239 getEnclosingCC env = seCC env
241 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
242 setEnclosingCC env cc = env {seCC = cc}
244 ---------------------
245 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
246 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
247 = env {seIdSubst = extendVarEnv subst var res}
249 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
250 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
251 = env {seTvSubst = extendVarEnv subst var res}
253 ---------------------
254 getInScope :: SimplEnv -> InScopeSet
255 getInScope env = seInScope env
257 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
258 setInScopeSet env in_scope = env {seInScope = in_scope}
260 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
261 -- Set the in-scope set, and *zap* the floats
262 setInScope env env_with_scope
263 = env { seInScope = seInScope env_with_scope,
264 seFloats = emptyFloats }
266 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
267 -- Set the in-scope set *and* the floats
268 setFloats env env_with_floats
269 = env { seInScope = seInScope env_with_floats,
270 seFloats = seFloats env_with_floats }
272 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
273 -- The new Ids are guaranteed to be freshly allocated
274 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
275 = env { seInScope = in_scope `extendInScopeSetList` vs,
276 seIdSubst = id_subst `delVarEnvList` vs }
277 -- Why delete? Consider
278 -- let x = a*b in (x, \x -> x+3)
279 -- We add [x |-> a*b] to the substitution, but we must
280 -- *delete* it from the substitution when going inside
283 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
284 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
285 = env {seInScope = modifyInScopeSet in_scope v v'}
287 ---------------------
288 zapSubstEnv :: SimplEnv -> SimplEnv
289 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
291 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
292 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
294 mkContEx :: SimplEnv -> InExpr -> SimplSR
295 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
297 isEmptySimplSubst :: SimplEnv -> Bool
298 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
299 = isEmptyVarEnv tvs && isEmptyVarEnv ids
304 %************************************************************************
308 %************************************************************************
310 Note [Simplifier floats]
311 ~~~~~~~~~~~~~~~~~~~~~~~~~
312 The Floats is a bunch of bindings, classified by a FloatFlag.
314 NonRec x (y:ys) FltLifted
315 Rec [(x,rhs)] FltLifted
317 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
319 NonRec x# (a /# b) FltCareful
320 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
321 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
322 -- (where f :: Int -> Int#)
325 data Floats = Floats (OrdList OutBind) FloatFlag
326 -- See Note [Simplifier floats]
329 = FltLifted -- All bindings are lifted and lazy
330 -- Hence ok to float to top level, or recursive
332 | FltOkSpec -- All bindings are FltLifted *or*
333 -- strict (perhaps because unlifted,
334 -- perhaps because of a strict binder),
335 -- *and* ok-for-speculation
336 -- Hence ok to float out of the RHS
337 -- of a lazy non-recursive let binding
338 -- (but not to top level, or into a rec group)
340 | FltCareful -- At least one binding is strict (or unlifted)
341 -- and not guaranteed cheap
342 -- Do not float these bindings out of a lazy let
344 instance Outputable Floats where
345 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
347 instance Outputable FloatFlag where
348 ppr FltLifted = ptext SLIT("FltLifted")
349 ppr FltOkSpec = ptext SLIT("FltOkSpec")
350 ppr FltCareful = ptext SLIT("FltCareful")
352 andFF :: FloatFlag -> FloatFlag -> FloatFlag
353 andFF FltCareful _ = FltCareful
354 andFF FltOkSpec FltCareful = FltCareful
355 andFF FltOkSpec flt = FltOkSpec
356 andFF FltLifted flt = flt
358 classifyFF :: CoreBind -> FloatFlag
359 classifyFF (Rec _) = FltLifted
360 classifyFF (NonRec bndr rhs)
361 | not (isStrictId bndr) = FltLifted
362 | exprOkForSpeculation rhs = FltOkSpec
363 | otherwise = FltCareful
365 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
366 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
367 = not (isNilOL fs) && want_to_float && can_float
369 want_to_float = isTopLevel lvl || exprIsCheap rhs
370 can_float = case ff of
372 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
373 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
378 emptyFloats :: Floats
379 emptyFloats = Floats nilOL FltLifted
381 unitFloat :: OutBind -> Floats
382 -- A single-binding float
383 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
385 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
386 -- Add a non-recursive binding and extend the in-scope set
387 -- The latter is important; the binder may already be in the
388 -- in-scope set (although it might also have been created with newId)
389 -- but it may now have more IdInfo
391 = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
392 seInScope = extendInScopeSet (seInScope env) id }
394 extendFloats :: SimplEnv -> OutBind -> SimplEnv
395 -- Add these bindings to the floats, and extend the in-scope env too
396 extendFloats env bind
397 = env { seFloats = seFloats env `addFlts` unitFloat bind,
398 seInScope = extendInScopeSetList (seInScope env) bndrs }
400 bndrs = bindersOf bind
402 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
403 -- Add the floats for env2 to env1;
404 -- *plus* the in-scope set for env2, which is bigger
405 -- than that for env1
407 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
408 seInScope = seInScope env2 }
410 addFlts :: Floats -> Floats -> Floats
411 addFlts (Floats bs1 l1) (Floats bs2 l2)
412 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
414 zapFloats :: SimplEnv -> SimplEnv
415 zapFloats env = env { seFloats = emptyFloats }
417 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
418 -- Flattens the floats from env2 into a single Rec group,
419 -- prepends the floats from env1, and puts the result back in env2
420 -- This is all very specific to the way recursive bindings are
421 -- handled; see Simplify.simplRecBind
422 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
423 = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
424 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
426 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
427 wrapFloats env expr = wrapFlts (seFloats env) expr
429 wrapFlts :: Floats -> OutExpr -> OutExpr
430 -- Wrap the floats around the expression, using case-binding where necessary
431 wrapFlts (Floats bs _) body = foldrOL wrap body bs
433 wrap (Rec prs) body = Let (Rec prs) body
434 wrap (NonRec b r) body = bindNonRec b r body
436 getFloats :: SimplEnv -> [CoreBind]
437 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
439 isEmptyFloats :: SimplEnv -> Bool
440 isEmptyFloats env = isEmptyFlts (seFloats env)
442 isEmptyFlts :: Floats -> Bool
443 isEmptyFlts (Floats bs _) = isNilOL bs
445 floatBinds :: Floats -> [OutBind]
446 floatBinds (Floats bs _) = fromOL bs
450 %************************************************************************
454 %************************************************************************
458 substId :: SimplEnv -> InId -> SimplSR
459 -- Returns DoneEx only on a non-Var expression
460 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
463 | otherwise -- A local Id
464 = case lookupVarEnv ids v of
465 Nothing -> DoneId (refine in_scope v)
466 Just (DoneId v) -> DoneId (refine in_scope v)
467 Just (DoneEx (Var v))
468 | isLocalId v -> DoneId (refine in_scope v)
469 | otherwise -> DoneId v
470 Just res -> res -- DoneEx non-var, or ContEx
473 -- Get the most up-to-date thing from the in-scope set
474 -- Even though it isn't in the substitution, it may be in
475 -- the in-scope set with better IdInfo
476 refine in_scope v = case lookupInScope in_scope v of
478 Nothing -> WARN( True, ppr v ) v -- This is an error!
480 lookupRecBndr :: SimplEnv -> InId -> OutId
481 -- Look up an Id which has been put into the envt by simplRecBndrs,
482 -- but where we have not yet done its RHS
483 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
484 = case lookupVarEnv ids v of
486 Just res -> pprPanic "lookupRecBndr" (ppr v)
487 Nothing -> refine in_scope v
491 %************************************************************************
493 \section{Substituting an Id binder}
495 %************************************************************************
498 These functions are in the monad only so that they can be made strict via seq.
501 simplBinders, simplLamBndrs
502 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
503 simplBinders env bndrs = mapAccumLM simplBinder env bndrs
504 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
507 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
508 -- Used for lambda and case-bound variables
509 -- Clone Id if necessary, substitute type
510 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
511 -- The substitution is extended only if the variable is cloned, because
512 -- we *don't* need to use it to track occurrence info.
514 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
515 ; seqTyVar tv `seq` return (env', tv) }
516 | otherwise = do { let (env', id) = substIdBndr env bndr
517 ; seqId id `seq` return (env', id) }
520 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
521 -- Used for lambda binders. These sometimes have unfoldings added by
522 -- the worker/wrapper pass that must be preserved, because they can't
523 -- be reconstructed from context. For example:
524 -- f x = case x of (a,b) -> fw a b x
525 -- fw a b x{=(a,b)} = ...
526 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
527 simplLamBndr env bndr
528 | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
529 | otherwise = simplBinder env bndr -- Normal case
531 old_unf = idUnfolding bndr
532 (env1, id1) = substIdBndr env bndr
533 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
534 env2 = modifyInScope env1 id1 id2
537 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
538 -- A non-recursive let binder
539 simplNonRecBndr env id
540 = do { let (env1, id1) = substIdBndr env id
541 ; seqId id1 `seq` return (env1, id1) }
544 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
545 -- Recursive let binders
546 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
547 = do { let (env1, ids1) = mapAccumL substIdBndr env ids
548 ; seqIds ids1 `seq` return env1 }
551 substIdBndr :: SimplEnv
552 -> InBndr -- Env and binder to transform
553 -> (SimplEnv, OutBndr)
554 -- Clone Id if necessary, substitute its type
555 -- Return an Id with its
556 -- * Type substituted
557 -- * UnfoldingInfo, Rules, WorkerInfo zapped
558 -- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
559 -- * Robust info, retained especially arity and demand info,
560 -- so that they are available to occurrences that occur in an
561 -- earlier binding of a letrec
563 -- For the robust info, see Note [Arity robustness]
565 -- Augment the substitution if the unique changed
566 -- Extend the in-scope set with the new Id
568 -- Similar to CoreSubst.substIdBndr, except that
569 -- the type of id_subst differs
570 -- all fragile info is zapped
572 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
574 = (env { seInScope = in_scope `extendInScopeSet` new_id,
575 seIdSubst = new_subst }, new_id)
577 id1 = uniqAway in_scope old_id
578 id2 = substIdType env id1
579 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
580 -- and fragile OccInfo
582 -- Extend the substitution if the unique has changed,
583 -- or there's some useful occurrence information
584 -- See the notes with substTyVarBndr for the delSubstEnv
585 new_subst | new_id /= old_id
586 = extendVarEnv id_subst old_id (DoneId new_id)
588 = delVarEnv id_subst old_id
592 ------------------------------------
593 seqTyVar :: TyVar -> ()
594 seqTyVar b = b `seq` ()
597 seqId id = seqType (idType id) `seq`
603 seqIds (id:ids) = seqId id `seq` seqIds ids
607 Note [Arity robustness]
608 ~~~~~~~~~~~~~~~~~~~~~~~
609 We *do* transfer the arity from from the in_id of a let binding to the
610 out_id. This is important, so that the arity of an Id is visible in
611 its own RHS. For example:
612 f = \x. ....g (\y. f y)....
613 We can eta-reduce the arg to g, becuase f is a value. But that
616 This interacts with the 'state hack' too:
621 Can we eta-expand f? Only if we see that f has arity 1, and then we
622 take advantage of the 'state hack' on the result of
623 (f y) :: State# -> (State#, Int) to expand the arity one more.
625 There is a disadvantage though. Making the arity visible in the RHS
626 allows us to eta-reduce
630 which technically is not sound. This is very much a corner case, so
631 I'm not worried about it. Another idea is to ensure that f's arity
632 never decreases; its arity started as 1, and we should never eta-reduce
636 Note [Robust OccInfo]
637 ~~~~~~~~~~~~~~~~~~~~~
638 It's important that we *do* retain the loop-breaker OccInfo, because
639 that's what stops the Id getting inlined infinitely, in the body of
643 Note [Rules in a letrec]
644 ~~~~~~~~~~~~~~~~~~~~~~~~
645 After creating fresh binders for the binders of a letrec, we
646 substitute the RULES and add them back onto the binders; this is done
647 *before* processing any of the RHSs. This is important. Manuel found
648 cases where he really, really wanted a RULE for a recursive function
649 to apply in that function's own right-hand side.
651 See Note [Loop breaking and RULES] in OccAnal.
655 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
656 -- Rules are added back in to to hte bin
657 addBndrRules env in_id out_id
658 | isEmptySpecInfo old_rules = (env, out_id)
659 | otherwise = (modifyInScope env out_id final_id, final_id)
661 subst = mkCoreSubst env
662 old_rules = idSpecialisation in_id
663 new_rules = CoreSubst.substSpec subst out_id old_rules
664 final_id = out_id `setIdSpecialisation` new_rules
667 substIdType :: SimplEnv -> Id -> Id
668 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
669 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
670 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
671 -- The tyVarsOfType is cheaper than it looks
672 -- because we cache the free tyvars of the type
673 -- in a Note in the id's type itself
678 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
679 substUnfolding env NoUnfolding = NoUnfolding
680 substUnfolding env (OtherCon cons) = OtherCon cons
681 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
682 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
685 substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
686 substWorker env NoWorker = NoWorker
687 substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
691 %************************************************************************
693 Impedence matching to type substitution
695 %************************************************************************
698 substTy :: SimplEnv -> Type -> Type
699 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
700 = Type.substTy (TvSubst in_scope tv_env) ty
702 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
703 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
704 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
705 (TvSubst in_scope' tv_env', tv')
706 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
708 -- When substituting in rules etc we can get CoreSubst to do the work
709 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
710 -- here. I think the this will not usually result in a lot of work;
711 -- the substitutions are typically small, and laziness will avoid work in many cases.
713 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
714 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
715 = mk_subst tv_env id_env
717 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
719 fiddle (DoneEx e) = e
720 fiddle (DoneId v) = Var v
721 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
723 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
725 | isEmptySimplSubst env = expr
726 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr