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 )
73 %************************************************************************
75 \subsection[Simplify-types]{Type declarations}
77 %************************************************************************
80 type InBndr = CoreBndr
81 type InId = Id -- Not yet cloned
82 type InType = Type -- Ditto
83 type InBind = CoreBind
84 type InExpr = CoreExpr
87 type InCoercion = Coercion
89 type OutBndr = CoreBndr
90 type OutId = Id -- Cloned
91 type OutTyVar = TyVar -- Cloned
92 type OutType = Type -- Cloned
93 type OutCoercion = Coercion
94 type OutBind = CoreBind
95 type OutExpr = CoreExpr
100 %************************************************************************
102 \subsubsection{The @SimplEnv@ type}
104 %************************************************************************
110 seMode :: SimplifierMode,
111 seChkr :: SwitchChecker,
112 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
114 -- The current set of in-scope variables
115 -- They are all OutVars, and all bound in this module
116 seInScope :: InScopeSet, -- OutVars only
117 -- Includes all variables bound by seFloats
119 -- See Note [Simplifier floats]
121 -- The current substitution
122 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
123 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
127 pprSimplEnv :: SimplEnv -> SDoc
128 -- Used for debugging; selective
130 = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
131 ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
133 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
134 -- See Note [Extending the Subst] in CoreSubst
137 = DoneEx OutExpr -- Completed term
138 | DoneId OutId -- Completed term variable
139 | ContEx TvSubstEnv -- A suspended substitution
143 instance Outputable SimplSR where
144 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
145 ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
146 ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
147 ppr (filter_env tv), ppr (filter_env id) -}]
149 -- fvs = exprFreeVars e
150 -- filter_env env = filterVarEnv_Directly keep env
151 -- keep uniq _ = uniq `elemUFM_Directly` fvs
156 The in-scope part of Subst includes *all* in-scope TyVars and Ids
157 The elements of the set may have better IdInfo than the
158 occurrences of in-scope Ids, and (more important) they will
159 have a correctly-substituted type. So we use a lookup in this
160 set to replace occurrences
162 The Ids in the InScopeSet are replete with their Rules,
163 and as we gather info about the unfolding of an Id, we replace
164 it in the in-scope set.
166 The in-scope set is actually a mapping OutVar -> OutVar, and
167 in case expressions we sometimes bind
170 The substitution is *apply-once* only, because InIds and OutIds can overlap.
171 For example, we generally omit mappings
173 from the substitution, when we decide not to clone a77, but it's quite
174 legitimate to put the mapping in the substitution anyway.
176 Furthermore, consider
177 let x = case k of I# x77 -> ... in
178 let y = case k of I# x77 -> ... in ...
179 and suppose the body is strict in both x and y. Then the simplifier
180 will pull the first (case k) to the top; so the second (case k) will
181 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
184 Of course, the substitution *must* applied! Things in its domain
185 simply aren't necessarily bound in the result.
187 * substId adds a binding (DoneId new_id) to the substitution if
188 the Id's unique has changed
191 Note, though that the substitution isn't necessarily extended
192 if the type changes. Why not? Because of the next point:
194 * We *always, always* finish by looking up in the in-scope set
195 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
196 Reason: so that we never finish up with a "old" Id in the result.
197 An old Id might point to an old unfolding and so on... which gives a space leak.
199 [The DoneEx and DoneVar hits map to "new" stuff.]
201 * It follows that substExpr must not do a no-op if the substitution is empty.
202 substType is free to do so, however.
204 * When we come to a let-binding (say) we generate new IdInfo, including an
205 unfolding, attach it to the binder, and add this newly adorned binder to
206 the in-scope set. So all subsequent occurrences of the binder will get mapped
207 to the full-adorned binder, which is also the one put in the binding site.
209 * The in-scope "set" usually maps x->x; we use it simply for its domain.
210 But sometimes we have two in-scope Ids that are synomyms, and should
211 map to the same target: x->x, y->x. Notably:
213 That's why the "set" is actually a VarEnv Var
217 mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
218 mkSimplEnv mode switches
219 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
220 seMode = mode, seInScope = emptyInScopeSet,
221 seFloats = emptyFloats,
222 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
223 -- The top level "enclosing CC" is "SUBSUMED".
225 ---------------------
226 getSwitchChecker :: SimplEnv -> SwitchChecker
227 getSwitchChecker env = seChkr env
229 ---------------------
230 getMode :: SimplEnv -> SimplifierMode
231 getMode env = seMode env
233 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
234 setMode mode env = env { seMode = mode }
236 ---------------------
237 getEnclosingCC :: SimplEnv -> CostCentreStack
238 getEnclosingCC env = seCC env
240 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
241 setEnclosingCC env cc = env {seCC = cc}
243 ---------------------
244 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
245 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
246 = env {seIdSubst = extendVarEnv subst var res}
248 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
249 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
250 = env {seTvSubst = extendVarEnv subst var res}
252 ---------------------
253 getInScope :: SimplEnv -> InScopeSet
254 getInScope env = seInScope env
256 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
257 setInScopeSet env in_scope = env {seInScope = in_scope}
259 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
260 -- Set the in-scope set, and *zap* the floats
261 setInScope env env_with_scope
262 = env { seInScope = seInScope env_with_scope,
263 seFloats = emptyFloats }
265 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
266 -- Set the in-scope set *and* the floats
267 setFloats env env_with_floats
268 = env { seInScope = seInScope env_with_floats,
269 seFloats = seFloats env_with_floats }
271 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
272 -- The new Ids are guaranteed to be freshly allocated
273 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
274 = env { seInScope = in_scope `extendInScopeSetList` vs,
275 seIdSubst = id_subst `delVarEnvList` vs }
276 -- Why delete? Consider
277 -- let x = a*b in (x, \x -> x+3)
278 -- We add [x |-> a*b] to the substitution, but we must
279 -- *delete* it from the substitution when going inside
282 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
283 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
284 = env {seInScope = modifyInScopeSet in_scope v v'}
286 ---------------------
287 zapSubstEnv :: SimplEnv -> SimplEnv
288 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
290 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
291 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
293 mkContEx :: SimplEnv -> InExpr -> SimplSR
294 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
296 isEmptySimplSubst :: SimplEnv -> Bool
297 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
298 = isEmptyVarEnv tvs && isEmptyVarEnv ids
303 %************************************************************************
307 %************************************************************************
309 Note [Simplifier floats]
310 ~~~~~~~~~~~~~~~~~~~~~~~~~
311 The Floats is a bunch of bindings, classified by a FloatFlag.
313 NonRec x (y:ys) FltLifted
314 Rec [(x,rhs)] FltLifted
316 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
318 NonRec x# (a /# b) FltCareful
319 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
320 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
321 -- (where f :: Int -> Int#)
324 data Floats = Floats (OrdList OutBind) FloatFlag
325 -- See Note [Simplifier floats]
328 = FltLifted -- All bindings are lifted and lazy
329 -- Hence ok to float to top level, or recursive
331 | FltOkSpec -- All bindings are FltLifted *or*
332 -- strict (perhaps because unlifted,
333 -- perhaps because of a strict binder),
334 -- *and* ok-for-speculation
335 -- Hence ok to float out of the RHS
336 -- of a lazy non-recursive let binding
337 -- (but not to top level, or into a rec group)
339 | FltCareful -- At least one binding is strict (or unlifted)
340 -- and not guaranteed cheap
341 -- Do not float these bindings out of a lazy let
343 instance Outputable Floats where
344 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
346 instance Outputable FloatFlag where
347 ppr FltLifted = ptext SLIT("FltLifted")
348 ppr FltOkSpec = ptext SLIT("FltOkSpec")
349 ppr FltCareful = ptext SLIT("FltCareful")
351 andFF :: FloatFlag -> FloatFlag -> FloatFlag
352 andFF FltCareful _ = FltCareful
353 andFF FltOkSpec FltCareful = FltCareful
354 andFF FltOkSpec flt = FltOkSpec
355 andFF FltLifted flt = flt
357 classifyFF :: CoreBind -> FloatFlag
358 classifyFF (Rec _) = FltLifted
359 classifyFF (NonRec bndr rhs)
360 | not (isStrictId bndr) = FltLifted
361 | exprOkForSpeculation rhs = FltOkSpec
362 | otherwise = FltCareful
364 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
365 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
366 = not (isNilOL fs) && want_to_float && can_float
368 want_to_float = isTopLevel lvl || exprIsCheap rhs
369 can_float = case ff of
371 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
372 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
377 emptyFloats :: Floats
378 emptyFloats = Floats nilOL FltLifted
380 unitFloat :: OutBind -> Floats
381 -- A single-binding float
382 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
384 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
385 -- Add a non-recursive binding and extend the in-scope set
386 -- The latter is important; the binder may already be in the
387 -- in-scope set (although it might also have been created with newId)
388 -- but it may now have more IdInfo
390 = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
391 seInScope = extendInScopeSet (seInScope env) id }
393 extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
394 -- Add these bindings to the floats, and extend the in-scope env too
395 extendFloats env binds
396 = env { seFloats = seFloats env `addFlts` new_floats,
397 seInScope = extendInScopeSetList (seInScope env) bndrs }
399 bndrs = bindersOfBinds binds
400 new_floats = Floats (toOL binds)
401 (foldr (andFF . classifyFF) FltLifted binds)
403 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
404 -- Add the floats for env2 to env1;
405 -- *plus* the in-scope set for env2, which is bigger
406 -- than that for env1
408 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
409 seInScope = seInScope env2 }
411 addFlts :: Floats -> Floats -> Floats
412 addFlts (Floats bs1 l1) (Floats bs2 l2)
413 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
415 zapFloats :: SimplEnv -> SimplEnv
416 zapFloats env = env { seFloats = emptyFloats }
418 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
419 -- Flattens the floats from env2 into a single Rec group,
420 -- prepends the floats from env1, and puts the result back in env2
421 -- This is all very specific to the way recursive bindings are
422 -- handled; see Simplify.simplRecBind
423 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
424 = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
425 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
427 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
428 wrapFloats env expr = wrapFlts (seFloats env) expr
430 wrapFlts :: Floats -> OutExpr -> OutExpr
431 -- Wrap the floats around the expression, using case-binding where necessary
432 wrapFlts (Floats bs _) body = foldrOL wrap body bs
434 wrap (Rec prs) body = Let (Rec prs) body
435 wrap (NonRec b r) body = bindNonRec b r body
437 getFloats :: SimplEnv -> [CoreBind]
438 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
440 isEmptyFloats :: SimplEnv -> Bool
441 isEmptyFloats env = isEmptyFlts (seFloats env)
443 isEmptyFlts :: Floats -> Bool
444 isEmptyFlts (Floats bs _) = isNilOL bs
446 floatBinds :: Floats -> [OutBind]
447 floatBinds (Floats bs _) = fromOL bs
451 %************************************************************************
455 %************************************************************************
459 substId :: SimplEnv -> InId -> SimplSR
460 -- Returns DoneEx only on a non-Var expression
461 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
464 | otherwise -- A local Id
465 = case lookupVarEnv ids v of
466 Nothing -> DoneId (refine in_scope v)
467 Just (DoneId v) -> DoneId (refine in_scope v)
468 Just (DoneEx (Var v))
469 | isLocalId v -> DoneId (refine in_scope v)
470 | otherwise -> DoneId v
471 Just res -> res -- DoneEx non-var, or ContEx
474 -- Get the most up-to-date thing from the in-scope set
475 -- Even though it isn't in the substitution, it may be in
476 -- the in-scope set with better IdInfo
477 refine in_scope v = case lookupInScope in_scope v of
479 Nothing -> WARN( True, ppr v ) v -- This is an error!
481 lookupRecBndr :: SimplEnv -> InId -> OutId
482 -- Look up an Id which has been put into the envt by simplRecBndrs,
483 -- but where we have not yet done its RHS
484 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
485 = case lookupVarEnv ids v of
487 Just res -> pprPanic "lookupRecBndr" (ppr v)
488 Nothing -> refine in_scope v
492 %************************************************************************
494 \section{Substituting an Id binder}
496 %************************************************************************
499 These functions are in the monad only so that they can be made strict via seq.
502 simplBinders, simplLamBndrs
503 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
504 simplBinders env bndrs = mapAccumLM simplBinder env bndrs
505 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
508 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
509 -- Used for lambda and case-bound variables
510 -- Clone Id if necessary, substitute type
511 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
512 -- The substitution is extended only if the variable is cloned, because
513 -- we *don't* need to use it to track occurrence info.
515 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
516 ; seqTyVar tv `seq` return (env', tv) }
517 | otherwise = do { let (env', id) = substIdBndr env bndr
518 ; seqId id `seq` return (env', id) }
521 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
522 -- Used for lambda binders. These sometimes have unfoldings added by
523 -- the worker/wrapper pass that must be preserved, because they can't
524 -- be reconstructed from context. For example:
525 -- f x = case x of (a,b) -> fw a b x
526 -- fw a b x{=(a,b)} = ...
527 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
528 simplLamBndr env bndr
529 | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
530 | otherwise = simplBinder env bndr -- Normal case
532 old_unf = idUnfolding bndr
533 (env1, id1) = substIdBndr env bndr
534 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
535 env2 = modifyInScope env1 id1 id2
538 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
539 -- A non-recursive let binder
540 simplNonRecBndr env id
541 = do { let (env1, id1) = substIdBndr env id
542 ; seqId id1 `seq` return (env1, id1) }
545 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
546 -- Recursive let binders
547 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
548 = do { let (env1, ids1) = mapAccumL substIdBndr env ids
549 ; seqIds ids1 `seq` return env1 }
552 substIdBndr :: SimplEnv
553 -> InBndr -- Env and binder to transform
554 -> (SimplEnv, OutBndr)
555 -- Clone Id if necessary, substitute its type
556 -- Return an Id with its
557 -- * Type substituted
558 -- * UnfoldingInfo, Rules, WorkerInfo zapped
559 -- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
560 -- * Robust info, retained especially arity and demand info,
561 -- so that they are available to occurrences that occur in an
562 -- earlier binding of a letrec
564 -- For the robust info, see Note [Arity robustness]
566 -- Augment the substitution if the unique changed
567 -- Extend the in-scope set with the new Id
569 -- Similar to CoreSubst.substIdBndr, except that
570 -- the type of id_subst differs
571 -- all fragile info is zapped
573 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
575 = (env { seInScope = in_scope `extendInScopeSet` new_id,
576 seIdSubst = new_subst }, new_id)
578 id1 = uniqAway in_scope old_id
579 id2 = substIdType env id1
580 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
581 -- and fragile OccInfo
583 -- Extend the substitution if the unique has changed,
584 -- or there's some useful occurrence information
585 -- See the notes with substTyVarBndr for the delSubstEnv
586 new_subst | new_id /= old_id
587 = extendVarEnv id_subst old_id (DoneId new_id)
589 = delVarEnv id_subst old_id
593 ------------------------------------
594 seqTyVar :: TyVar -> ()
595 seqTyVar b = b `seq` ()
598 seqId id = seqType (idType id) `seq`
604 seqIds (id:ids) = seqId id `seq` seqIds ids
608 Note [Arity robustness]
609 ~~~~~~~~~~~~~~~~~~~~~~~
610 We *do* transfer the arity from from the in_id of a let binding to the
611 out_id. This is important, so that the arity of an Id is visible in
612 its own RHS. For example:
613 f = \x. ....g (\y. f y)....
614 We can eta-reduce the arg to g, becuase f is a value. But that
617 This interacts with the 'state hack' too:
622 Can we eta-expand f? Only if we see that f has arity 1, and then we
623 take advantage of the 'state hack' on the result of
624 (f y) :: State# -> (State#, Int) to expand the arity one more.
626 There is a disadvantage though. Making the arity visible in the RHS
627 allows us to eta-reduce
631 which technically is not sound. This is very much a corner case, so
632 I'm not worried about it. Another idea is to ensure that f's arity
633 never decreases; its arity started as 1, and we should never eta-reduce
637 Note [Robust OccInfo]
638 ~~~~~~~~~~~~~~~~~~~~~
639 It's important that we *do* retain the loop-breaker OccInfo, because
640 that's what stops the Id getting inlined infinitely, in the body of
644 Note [Rules in a letrec]
645 ~~~~~~~~~~~~~~~~~~~~~~~~
646 After creating fresh binders for the binders of a letrec, we
647 substitute the RULES and add them back onto the binders; this is done
648 *before* processing any of the RHSs. This is important. Manuel found
649 cases where he really, really wanted a RULE for a recursive function
650 to apply in that function's own right-hand side.
652 See Note [Loop breaking and RULES] in OccAnal.
656 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
657 -- Rules are added back in to to hte bin
658 addBndrRules env in_id out_id
659 | isEmptySpecInfo old_rules = (env, out_id)
660 | otherwise = (modifyInScope env out_id final_id, final_id)
662 subst = mkCoreSubst env
663 old_rules = idSpecialisation in_id
664 new_rules = CoreSubst.substSpec subst out_id old_rules
665 final_id = out_id `setIdSpecialisation` new_rules
668 substIdType :: SimplEnv -> Id -> Id
669 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
670 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
671 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
672 -- The tyVarsOfType is cheaper than it looks
673 -- because we cache the free tyvars of the type
674 -- in a Note in the id's type itself
679 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
680 substUnfolding env NoUnfolding = NoUnfolding
681 substUnfolding env (OtherCon cons) = OtherCon cons
682 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
683 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
686 substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
687 substWorker env NoWorker = NoWorker
688 substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
692 %************************************************************************
694 Impedence matching to type substitution
696 %************************************************************************
699 substTy :: SimplEnv -> Type -> Type
700 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
701 = Type.substTy (TvSubst in_scope tv_env) ty
703 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
704 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
705 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
706 (TvSubst in_scope' tv_env', tv')
707 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
709 -- When substituting in rules etc we can get CoreSubst to do the work
710 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
711 -- here. I think the this will not usually result in a lot of work;
712 -- the substitutions are typically small, and laziness will avoid work in many cases.
714 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
715 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
716 = mk_subst tv_env id_env
718 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
720 fiddle (DoneEx e) = e
721 fiddle (DoneId v) = Var v
722 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
724 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
726 | isEmptySimplSubst env = expr
727 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr