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 binds
397 = env { seFloats = seFloats env `addFlts` new_floats,
398 seInScope = extendInScopeSetList (seInScope env) bndrs }
400 bndrs = bindersOfBinds binds
401 new_floats = Floats (toOL binds)
402 (foldr (andFF . classifyFF) FltLifted binds)
404 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
405 -- Add the floats for env2 to env1;
406 -- *plus* the in-scope set for env2, which is bigger
407 -- than that for env1
409 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
410 seInScope = seInScope env2 }
412 addFlts :: Floats -> Floats -> Floats
413 addFlts (Floats bs1 l1) (Floats bs2 l2)
414 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
416 zapFloats :: SimplEnv -> SimplEnv
417 zapFloats env = env { seFloats = emptyFloats }
419 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
420 -- Flattens the floats from env2 into a single Rec group,
421 -- prepends the floats from env1, and puts the result back in env2
422 -- This is all very specific to the way recursive bindings are
423 -- handled; see Simplify.simplRecBind
424 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
425 = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
426 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
428 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
429 wrapFloats env expr = wrapFlts (seFloats env) expr
431 wrapFlts :: Floats -> OutExpr -> OutExpr
432 -- Wrap the floats around the expression, using case-binding where necessary
433 wrapFlts (Floats bs _) body = foldrOL wrap body bs
435 wrap (Rec prs) body = Let (Rec prs) body
436 wrap (NonRec b r) body = bindNonRec b r body
438 getFloats :: SimplEnv -> [CoreBind]
439 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
441 isEmptyFloats :: SimplEnv -> Bool
442 isEmptyFloats env = isEmptyFlts (seFloats env)
444 isEmptyFlts :: Floats -> Bool
445 isEmptyFlts (Floats bs _) = isNilOL bs
447 floatBinds :: Floats -> [OutBind]
448 floatBinds (Floats bs _) = fromOL bs
452 %************************************************************************
456 %************************************************************************
460 substId :: SimplEnv -> InId -> SimplSR
461 -- Returns DoneEx only on a non-Var expression
462 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
465 | otherwise -- A local Id
466 = case lookupVarEnv ids v of
467 Nothing -> DoneId (refine in_scope v)
468 Just (DoneId v) -> DoneId (refine in_scope v)
469 Just (DoneEx (Var v))
470 | isLocalId v -> DoneId (refine in_scope v)
471 | otherwise -> DoneId v
472 Just res -> res -- DoneEx non-var, or ContEx
475 -- Get the most up-to-date thing from the in-scope set
476 -- Even though it isn't in the substitution, it may be in
477 -- the in-scope set with better IdInfo
478 refine in_scope v = case lookupInScope in_scope v of
480 Nothing -> WARN( True, ppr v ) v -- This is an error!
482 lookupRecBndr :: SimplEnv -> InId -> OutId
483 -- Look up an Id which has been put into the envt by simplRecBndrs,
484 -- but where we have not yet done its RHS
485 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
486 = case lookupVarEnv ids v of
488 Just res -> pprPanic "lookupRecBndr" (ppr v)
489 Nothing -> refine in_scope v
493 %************************************************************************
495 \section{Substituting an Id binder}
497 %************************************************************************
500 These functions are in the monad only so that they can be made strict via seq.
503 simplBinders, simplLamBndrs
504 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
505 simplBinders env bndrs = mapAccumLM simplBinder env bndrs
506 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
509 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
510 -- Used for lambda and case-bound variables
511 -- Clone Id if necessary, substitute type
512 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
513 -- The substitution is extended only if the variable is cloned, because
514 -- we *don't* need to use it to track occurrence info.
516 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
517 ; seqTyVar tv `seq` return (env', tv) }
518 | otherwise = do { let (env', id) = substIdBndr env bndr
519 ; seqId id `seq` return (env', id) }
522 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
523 -- Used for lambda binders. These sometimes have unfoldings added by
524 -- the worker/wrapper pass that must be preserved, because they can't
525 -- be reconstructed from context. For example:
526 -- f x = case x of (a,b) -> fw a b x
527 -- fw a b x{=(a,b)} = ...
528 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
529 simplLamBndr env bndr
530 | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
531 | otherwise = simplBinder env bndr -- Normal case
533 old_unf = idUnfolding bndr
534 (env1, id1) = substIdBndr env bndr
535 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
536 env2 = modifyInScope env1 id1 id2
539 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
540 -- A non-recursive let binder
541 simplNonRecBndr env id
542 = do { let (env1, id1) = substIdBndr env id
543 ; seqId id1 `seq` return (env1, id1) }
546 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
547 -- Recursive let binders
548 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
549 = do { let (env1, ids1) = mapAccumL substIdBndr env ids
550 ; seqIds ids1 `seq` return env1 }
553 substIdBndr :: SimplEnv
554 -> InBndr -- Env and binder to transform
555 -> (SimplEnv, OutBndr)
556 -- Clone Id if necessary, substitute its type
557 -- Return an Id with its
558 -- * Type substituted
559 -- * UnfoldingInfo, Rules, WorkerInfo zapped
560 -- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
561 -- * Robust info, retained especially arity and demand info,
562 -- so that they are available to occurrences that occur in an
563 -- earlier binding of a letrec
565 -- For the robust info, see Note [Arity robustness]
567 -- Augment the substitution if the unique changed
568 -- Extend the in-scope set with the new Id
570 -- Similar to CoreSubst.substIdBndr, except that
571 -- the type of id_subst differs
572 -- all fragile info is zapped
574 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
576 = (env { seInScope = in_scope `extendInScopeSet` new_id,
577 seIdSubst = new_subst }, new_id)
579 id1 = uniqAway in_scope old_id
580 id2 = substIdType env id1
581 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
582 -- and fragile OccInfo
584 -- Extend the substitution if the unique has changed,
585 -- or there's some useful occurrence information
586 -- See the notes with substTyVarBndr for the delSubstEnv
587 new_subst | new_id /= old_id
588 = extendVarEnv id_subst old_id (DoneId new_id)
590 = delVarEnv id_subst old_id
594 ------------------------------------
595 seqTyVar :: TyVar -> ()
596 seqTyVar b = b `seq` ()
599 seqId id = seqType (idType id) `seq`
605 seqIds (id:ids) = seqId id `seq` seqIds ids
609 Note [Arity robustness]
610 ~~~~~~~~~~~~~~~~~~~~~~~
611 We *do* transfer the arity from from the in_id of a let binding to the
612 out_id. This is important, so that the arity of an Id is visible in
613 its own RHS. For example:
614 f = \x. ....g (\y. f y)....
615 We can eta-reduce the arg to g, becuase f is a value. But that
618 This interacts with the 'state hack' too:
623 Can we eta-expand f? Only if we see that f has arity 1, and then we
624 take advantage of the 'state hack' on the result of
625 (f y) :: State# -> (State#, Int) to expand the arity one more.
627 There is a disadvantage though. Making the arity visible in the RHS
628 allows us to eta-reduce
632 which technically is not sound. This is very much a corner case, so
633 I'm not worried about it. Another idea is to ensure that f's arity
634 never decreases; its arity started as 1, and we should never eta-reduce
638 Note [Robust OccInfo]
639 ~~~~~~~~~~~~~~~~~~~~~
640 It's important that we *do* retain the loop-breaker OccInfo, because
641 that's what stops the Id getting inlined infinitely, in the body of
645 Note [Rules in a letrec]
646 ~~~~~~~~~~~~~~~~~~~~~~~~
647 After creating fresh binders for the binders of a letrec, we
648 substitute the RULES and add them back onto the binders; this is done
649 *before* processing any of the RHSs. This is important. Manuel found
650 cases where he really, really wanted a RULE for a recursive function
651 to apply in that function's own right-hand side.
653 See Note [Loop breaking and RULES] in OccAnal.
657 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
658 -- Rules are added back in to to hte bin
659 addBndrRules env in_id out_id
660 | isEmptySpecInfo old_rules = (env, out_id)
661 | otherwise = (modifyInScope env out_id final_id, final_id)
663 subst = mkCoreSubst env
664 old_rules = idSpecialisation in_id
665 new_rules = CoreSubst.substSpec subst out_id old_rules
666 final_id = out_id `setIdSpecialisation` new_rules
669 substIdType :: SimplEnv -> Id -> Id
670 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
671 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
672 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
673 -- The tyVarsOfType is cheaper than it looks
674 -- because we cache the free tyvars of the type
675 -- in a Note in the id's type itself
680 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
681 substUnfolding env NoUnfolding = NoUnfolding
682 substUnfolding env (OtherCon cons) = OtherCon cons
683 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
684 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
687 substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
688 substWorker env NoWorker = NoWorker
689 substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
693 %************************************************************************
695 Impedence matching to type substitution
697 %************************************************************************
700 substTy :: SimplEnv -> Type -> Type
701 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
702 = Type.substTy (TvSubst in_scope tv_env) ty
704 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
705 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
706 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
707 (TvSubst in_scope' tv_env', tv')
708 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
710 -- When substituting in rules etc we can get CoreSubst to do the work
711 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
712 -- here. I think the this will not usually result in a lot of work;
713 -- the substitutions are typically small, and laziness will avoid work in many cases.
715 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
716 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
717 = mk_subst tv_env id_env
719 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
721 fiddle (DoneEx e) = e
722 fiddle (DoneId v) = Var v
723 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
725 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
727 | isEmptySimplSubst env = expr
728 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr