2 % (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[SimplMonad]{The simplifier Monad}
8 InId, InBind, InExpr, InAlt, InArg, InType, InBndr,
9 OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
10 InCoercion, OutCoercion,
12 -- The simplifier mode
16 SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
17 isAmongSimpl, intSwitchSet, switchIsOn,
19 setEnclosingCC, getEnclosingCC,
22 SimplEnv(..), pprSimplEnv, -- Temp not abstract
23 mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst,
24 zapSubstEnv, setSubstEnv,
25 getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
28 SimplSR(..), mkContEx, substId, lookupRecBndr,
30 simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
31 simplBinder, simplBinders, addBndrRules,
32 substExpr, substWorker, substTy,
35 Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
36 wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
37 doFloatFromRhs, getFloats
40 #include "HsVersions.h"
52 import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
53 import qualified Type ( substTy, substTyVarBndr )
54 import Type hiding ( substTy, substTyVarBndr )
65 %************************************************************************
67 \subsection[Simplify-types]{Type declarations}
69 %************************************************************************
72 type InBndr = CoreBndr
73 type InId = Id -- Not yet cloned
74 type InType = Type -- Ditto
75 type InBind = CoreBind
76 type InExpr = CoreExpr
79 type InCoercion = Coercion
81 type OutBndr = CoreBndr
82 type OutId = Id -- Cloned
83 type OutTyVar = TyVar -- Cloned
84 type OutType = Type -- Cloned
85 type OutCoercion = Coercion
86 type OutBind = CoreBind
87 type OutExpr = CoreExpr
92 %************************************************************************
94 \subsubsection{The @SimplEnv@ type}
96 %************************************************************************
102 seMode :: SimplifierMode,
103 seChkr :: SwitchChecker,
104 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
106 -- The current set of in-scope variables
107 -- They are all OutVars, and all bound in this module
108 seInScope :: InScopeSet, -- OutVars only
109 -- Includes all variables bound by seFloats
111 -- See Note [Simplifier floats]
113 -- The current substitution
114 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
115 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
119 pprSimplEnv :: SimplEnv -> SDoc
120 -- Used for debugging; selective
122 = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
123 ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
125 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
126 -- See Note [Extending the Subst] in CoreSubst
129 = DoneEx OutExpr -- Completed term
130 | DoneId OutId -- Completed term variable
131 | ContEx TvSubstEnv -- A suspended substitution
135 instance Outputable SimplSR where
136 ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
137 ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
138 ppr (ContEx _tv _id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
139 ppr (filter_env tv), ppr (filter_env id) -}]
141 -- fvs = exprFreeVars e
142 -- filter_env env = filterVarEnv_Directly keep env
143 -- keep uniq _ = uniq `elemUFM_Directly` fvs
148 The in-scope part of Subst includes *all* in-scope TyVars and Ids
149 The elements of the set may have better IdInfo than the
150 occurrences of in-scope Ids, and (more important) they will
151 have a correctly-substituted type. So we use a lookup in this
152 set to replace occurrences
154 The Ids in the InScopeSet are replete with their Rules,
155 and as we gather info about the unfolding of an Id, we replace
156 it in the in-scope set.
158 The in-scope set is actually a mapping OutVar -> OutVar, and
159 in case expressions we sometimes bind
162 The substitution is *apply-once* only, because InIds and OutIds can overlap.
163 For example, we generally omit mappings
165 from the substitution, when we decide not to clone a77, but it's quite
166 legitimate to put the mapping in the substitution anyway.
168 Furthermore, consider
169 let x = case k of I# x77 -> ... in
170 let y = case k of I# x77 -> ... in ...
171 and suppose the body is strict in both x and y. Then the simplifier
172 will pull the first (case k) to the top; so the second (case k) will
173 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
176 Of course, the substitution *must* applied! Things in its domain
177 simply aren't necessarily bound in the result.
179 * substId adds a binding (DoneId new_id) to the substitution if
180 the Id's unique has changed
183 Note, though that the substitution isn't necessarily extended
184 if the type changes. Why not? Because of the next point:
186 * We *always, always* finish by looking up in the in-scope set
187 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
188 Reason: so that we never finish up with a "old" Id in the result.
189 An old Id might point to an old unfolding and so on... which gives a space leak.
191 [The DoneEx and DoneVar hits map to "new" stuff.]
193 * It follows that substExpr must not do a no-op if the substitution is empty.
194 substType is free to do so, however.
196 * When we come to a let-binding (say) we generate new IdInfo, including an
197 unfolding, attach it to the binder, and add this newly adorned binder to
198 the in-scope set. So all subsequent occurrences of the binder will get mapped
199 to the full-adorned binder, which is also the one put in the binding site.
201 * The in-scope "set" usually maps x->x; we use it simply for its domain.
202 But sometimes we have two in-scope Ids that are synomyms, and should
203 map to the same target: x->x, y->x. Notably:
205 That's why the "set" is actually a VarEnv Var
209 mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
210 mkSimplEnv mode switches
211 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
212 seMode = mode, seInScope = emptyInScopeSet,
213 seFloats = emptyFloats,
214 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
215 -- The top level "enclosing CC" is "SUBSUMED".
217 ---------------------
218 getSwitchChecker :: SimplEnv -> SwitchChecker
219 getSwitchChecker env = seChkr env
221 ---------------------
222 getMode :: SimplEnv -> SimplifierMode
223 getMode env = seMode env
225 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
226 setMode mode env = env { seMode = mode }
228 ---------------------
229 getEnclosingCC :: SimplEnv -> CostCentreStack
230 getEnclosingCC env = seCC env
232 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
233 setEnclosingCC env cc = env {seCC = cc}
235 ---------------------
236 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
237 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
238 = env {seIdSubst = extendVarEnv subst var res}
240 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
241 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
242 = env {seTvSubst = extendVarEnv subst var res}
244 ---------------------
245 getInScope :: SimplEnv -> InScopeSet
246 getInScope env = seInScope env
248 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
249 setInScopeSet env in_scope = env {seInScope = in_scope}
251 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
252 -- Set the in-scope set, and *zap* the floats
253 setInScope env env_with_scope
254 = env { seInScope = seInScope env_with_scope,
255 seFloats = emptyFloats }
257 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
258 -- Set the in-scope set *and* the floats
259 setFloats env env_with_floats
260 = env { seInScope = seInScope env_with_floats,
261 seFloats = seFloats env_with_floats }
263 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
264 -- The new Ids are guaranteed to be freshly allocated
265 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
266 = env { seInScope = in_scope `extendInScopeSetList` vs,
267 seIdSubst = id_subst `delVarEnvList` vs }
268 -- Why delete? Consider
269 -- let x = a*b in (x, \x -> x+3)
270 -- We add [x |-> a*b] to the substitution, but we must
271 -- _delete_ it from the substitution when going inside
274 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
275 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
276 = env {seInScope = modifyInScopeSet in_scope v v'}
278 ---------------------
279 zapSubstEnv :: SimplEnv -> SimplEnv
280 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
282 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
283 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
285 mkContEx :: SimplEnv -> InExpr -> SimplSR
286 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
291 %************************************************************************
295 %************************************************************************
297 Note [Simplifier floats]
298 ~~~~~~~~~~~~~~~~~~~~~~~~~
299 The Floats is a bunch of bindings, classified by a FloatFlag.
301 NonRec x (y:ys) FltLifted
302 Rec [(x,rhs)] FltLifted
304 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
306 NonRec x# (a /# b) FltCareful
307 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
308 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
309 -- (where f :: Int -> Int#)
312 data Floats = Floats (OrdList OutBind) FloatFlag
313 -- See Note [Simplifier floats]
316 = FltLifted -- All bindings are lifted and lazy
317 -- Hence ok to float to top level, or recursive
319 | FltOkSpec -- All bindings are FltLifted *or*
320 -- strict (perhaps because unlifted,
321 -- perhaps because of a strict binder),
322 -- *and* ok-for-speculation
323 -- Hence ok to float out of the RHS
324 -- of a lazy non-recursive let binding
325 -- (but not to top level, or into a rec group)
327 | FltCareful -- At least one binding is strict (or unlifted)
328 -- and not guaranteed cheap
329 -- Do not float these bindings out of a lazy let
331 instance Outputable Floats where
332 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
334 instance Outputable FloatFlag where
335 ppr FltLifted = ptext (sLit "FltLifted")
336 ppr FltOkSpec = ptext (sLit "FltOkSpec")
337 ppr FltCareful = ptext (sLit "FltCareful")
339 andFF :: FloatFlag -> FloatFlag -> FloatFlag
340 andFF FltCareful _ = FltCareful
341 andFF FltOkSpec FltCareful = FltCareful
342 andFF FltOkSpec _ = FltOkSpec
343 andFF FltLifted flt = flt
345 classifyFF :: CoreBind -> FloatFlag
346 classifyFF (Rec _) = FltLifted
347 classifyFF (NonRec bndr rhs)
348 | not (isStrictId bndr) = FltLifted
349 | exprOkForSpeculation rhs = FltOkSpec
350 | otherwise = FltCareful
352 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
353 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
354 = not (isNilOL fs) && want_to_float && can_float
356 want_to_float = isTopLevel lvl || exprIsCheap rhs
357 can_float = case ff of
359 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
360 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
365 emptyFloats :: Floats
366 emptyFloats = Floats nilOL FltLifted
368 unitFloat :: OutBind -> Floats
369 -- A single-binding float
370 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
372 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
373 -- Add a non-recursive binding and extend the in-scope set
374 -- The latter is important; the binder may already be in the
375 -- in-scope set (although it might also have been created with newId)
376 -- but it may now have more IdInfo
378 = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
379 seInScope = extendInScopeSet (seInScope env) id }
381 extendFloats :: SimplEnv -> OutBind -> SimplEnv
382 -- Add these bindings to the floats, and extend the in-scope env too
383 extendFloats env bind
384 = env { seFloats = seFloats env `addFlts` unitFloat bind,
385 seInScope = extendInScopeSetList (seInScope env) bndrs }
387 bndrs = bindersOf bind
389 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
390 -- Add the floats for env2 to env1;
391 -- *plus* the in-scope set for env2, which is bigger
392 -- than that for env1
394 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
395 seInScope = seInScope env2 }
397 addFlts :: Floats -> Floats -> Floats
398 addFlts (Floats bs1 l1) (Floats bs2 l2)
399 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
401 zapFloats :: SimplEnv -> SimplEnv
402 zapFloats env = env { seFloats = emptyFloats }
404 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
405 -- Flattens the floats from env2 into a single Rec group,
406 -- prepends the floats from env1, and puts the result back in env2
407 -- This is all very specific to the way recursive bindings are
408 -- handled; see Simplify.simplRecBind
409 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
410 = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )
411 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
413 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
414 wrapFloats env expr = wrapFlts (seFloats env) expr
416 wrapFlts :: Floats -> OutExpr -> OutExpr
417 -- Wrap the floats around the expression, using case-binding where necessary
418 wrapFlts (Floats bs _) body = foldrOL wrap body bs
420 wrap (Rec prs) body = Let (Rec prs) body
421 wrap (NonRec b r) body = bindNonRec b r body
423 getFloats :: SimplEnv -> [CoreBind]
424 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
426 isEmptyFloats :: SimplEnv -> Bool
427 isEmptyFloats env = isEmptyFlts (seFloats env)
429 isEmptyFlts :: Floats -> Bool
430 isEmptyFlts (Floats bs _) = isNilOL bs
432 floatBinds :: Floats -> [OutBind]
433 floatBinds (Floats bs _) = fromOL bs
437 %************************************************************************
441 %************************************************************************
445 substId :: SimplEnv -> InId -> SimplSR
446 -- Returns DoneEx only on a non-Var expression
447 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
450 | otherwise -- A local Id
451 = case lookupVarEnv ids v of
452 Nothing -> DoneId (refine in_scope v)
453 Just (DoneId v) -> DoneId (refine in_scope v)
454 Just (DoneEx (Var v))
455 | isLocalId v -> DoneId (refine in_scope v)
456 | otherwise -> DoneId v
457 Just res -> res -- DoneEx non-var, or ContEx
460 -- Get the most up-to-date thing from the in-scope set
461 -- Even though it isn't in the substitution, it may be in
462 -- the in-scope set with better IdInfo
463 refine :: InScopeSet -> Var -> Var
464 refine in_scope v = case lookupInScope in_scope v of
466 Nothing -> WARN( True, ppr v ) v -- This is an error!
468 lookupRecBndr :: SimplEnv -> InId -> OutId
469 -- Look up an Id which has been put into the envt by simplRecBndrs,
470 -- but where we have not yet done its RHS
471 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
472 = case lookupVarEnv ids v of
474 Just _ -> pprPanic "lookupRecBndr" (ppr v)
475 Nothing -> refine in_scope v
479 %************************************************************************
481 \section{Substituting an Id binder}
483 %************************************************************************
486 These functions are in the monad only so that they can be made strict via seq.
489 simplBinders, simplLamBndrs
490 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
491 simplBinders env bndrs = mapAccumLM simplBinder env bndrs
492 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
495 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
496 -- Used for lambda and case-bound variables
497 -- Clone Id if necessary, substitute type
498 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
499 -- The substitution is extended only if the variable is cloned, because
500 -- we *don't* need to use it to track occurrence info.
502 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
503 ; seqTyVar tv `seq` return (env', tv) }
504 | otherwise = do { let (env', id) = substIdBndr env bndr
505 ; seqId id `seq` return (env', id) }
508 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
509 -- Used for lambda binders. These sometimes have unfoldings added by
510 -- the worker/wrapper pass that must be preserved, because they can't
511 -- be reconstructed from context. For example:
512 -- f x = case x of (a,b) -> fw a b x
513 -- fw a b x{=(a,b)} = ...
514 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
515 simplLamBndr env bndr
516 | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
517 | otherwise = simplBinder env bndr -- Normal case
519 old_unf = idUnfolding bndr
520 (env1, id1) = substIdBndr env bndr
521 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
522 env2 = modifyInScope env1 id1 id2
525 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
526 -- A non-recursive let binder
527 simplNonRecBndr env id
528 = do { let (env1, id1) = substIdBndr env id
529 ; seqId id1 `seq` return (env1, id1) }
532 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
533 -- Recursive let binders
534 simplRecBndrs env@(SimplEnv {}) ids
535 = do { let (env1, ids1) = mapAccumL substIdBndr env ids
536 ; seqIds ids1 `seq` return env1 }
539 substIdBndr :: SimplEnv
540 -> InBndr -- Env and binder to transform
541 -> (SimplEnv, OutBndr)
542 -- Clone Id if necessary, substitute its type
543 -- Return an Id with its
544 -- * Type substituted
545 -- * UnfoldingInfo, Rules, WorkerInfo zapped
546 -- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
547 -- * Robust info, retained especially arity and demand info,
548 -- so that they are available to occurrences that occur in an
549 -- earlier binding of a letrec
551 -- For the robust info, see Note [Arity robustness]
553 -- Augment the substitution if the unique changed
554 -- Extend the in-scope set with the new Id
556 -- Similar to CoreSubst.substIdBndr, except that
557 -- the type of id_subst differs
558 -- all fragile info is zapped
560 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
562 = (env { seInScope = in_scope `extendInScopeSet` new_id,
563 seIdSubst = new_subst }, new_id)
565 id1 = uniqAway in_scope old_id
566 id2 = substIdType env id1
567 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
568 -- and fragile OccInfo
570 -- Extend the substitution if the unique has changed,
571 -- or there's some useful occurrence information
572 -- See the notes with substTyVarBndr for the delSubstEnv
573 new_subst | new_id /= old_id
574 = extendVarEnv id_subst old_id (DoneId new_id)
576 = delVarEnv id_subst old_id
580 ------------------------------------
581 seqTyVar :: TyVar -> ()
582 seqTyVar b = b `seq` ()
585 seqId id = seqType (idType id) `seq`
591 seqIds (id:ids) = seqId id `seq` seqIds ids
595 Note [Arity robustness]
596 ~~~~~~~~~~~~~~~~~~~~~~~
597 We *do* transfer the arity from from the in_id of a let binding to the
598 out_id. This is important, so that the arity of an Id is visible in
599 its own RHS. For example:
600 f = \x. ....g (\y. f y)....
601 We can eta-reduce the arg to g, becuase f is a value. But that
604 This interacts with the 'state hack' too:
609 Can we eta-expand f? Only if we see that f has arity 1, and then we
610 take advantage of the 'state hack' on the result of
611 (f y) :: State# -> (State#, Int) to expand the arity one more.
613 There is a disadvantage though. Making the arity visible in the RHS
614 allows us to eta-reduce
618 which technically is not sound. This is very much a corner case, so
619 I'm not worried about it. Another idea is to ensure that f's arity
620 never decreases; its arity started as 1, and we should never eta-reduce
624 Note [Robust OccInfo]
625 ~~~~~~~~~~~~~~~~~~~~~
626 It's important that we *do* retain the loop-breaker OccInfo, because
627 that's what stops the Id getting inlined infinitely, in the body of
631 Note [Rules in a letrec]
632 ~~~~~~~~~~~~~~~~~~~~~~~~
633 After creating fresh binders for the binders of a letrec, we
634 substitute the RULES and add them back onto the binders; this is done
635 *before* processing any of the RHSs. This is important. Manuel found
636 cases where he really, really wanted a RULE for a recursive function
637 to apply in that function's own right-hand side.
639 See Note [Loop breaking and RULES] in OccAnal.
643 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
644 -- Rules are added back in to to the bin
645 addBndrRules env in_id out_id
646 | isEmptySpecInfo old_rules = (env, out_id)
647 | otherwise = (modifyInScope env out_id final_id, final_id)
649 subst = mkCoreSubst env
650 old_rules = idSpecialisation in_id
651 new_rules = CoreSubst.substSpec subst out_id old_rules
652 final_id = out_id `setIdSpecialisation` new_rules
655 substIdType :: SimplEnv -> Id -> Id
656 substIdType (SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
657 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
658 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
659 -- The tyVarsOfType is cheaper than it looks
660 -- because we cache the free tyvars of the type
661 -- in a Note in the id's type itself
666 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
667 substUnfolding _ NoUnfolding = NoUnfolding
668 substUnfolding _ (OtherCon cons) = OtherCon cons
669 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
670 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
673 substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
674 substWorker _ NoWorker = NoWorker
675 substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
679 %************************************************************************
681 Impedence matching to type substitution
683 %************************************************************************
686 substTy :: SimplEnv -> Type -> Type
687 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
688 = Type.substTy (TvSubst in_scope tv_env) ty
690 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
691 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
692 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
693 (TvSubst in_scope' tv_env', tv')
694 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
696 -- When substituting in rules etc we can get CoreSubst to do the work
697 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
698 -- here. I think the this will not usually result in a lot of work;
699 -- the substitutions are typically small, and laziness will avoid work in many cases.
701 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
702 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
703 = mk_subst tv_env id_env
705 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
707 fiddle (DoneEx e) = e
708 fiddle (DoneId v) = Var v
709 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
711 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
712 substExpr env expr = CoreSubst.substExpr (mkCoreSubst env) expr
713 -- Do *not* short-cut in the case of an empty substitution
714 -- See CoreSubst: Note [Extending the Subst]