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, addLetIdInfo,
35 Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
36 wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
37 doFloatFromRhs, getFloats
40 #include "HsVersions.h"
53 import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
54 import qualified Type ( substTy, substTyVarBndr )
55 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
288 isEmptySimplSubst :: SimplEnv -> Bool
289 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
290 = isEmptyVarEnv tvs && isEmptyVarEnv ids
295 %************************************************************************
299 %************************************************************************
301 Note [Simplifier floats]
302 ~~~~~~~~~~~~~~~~~~~~~~~~~
303 The Floats is a bunch of bindings, classified by a FloatFlag.
305 NonRec x (y:ys) FltLifted
306 Rec [(x,rhs)] FltLifted
308 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
310 NonRec x# (a /# b) FltCareful
311 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
312 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
313 -- (where f :: Int -> Int#)
316 data Floats = Floats (OrdList OutBind) FloatFlag
317 -- See Note [Simplifier floats]
320 = FltLifted -- All bindings are lifted and lazy
321 -- Hence ok to float to top level, or recursive
323 | FltOkSpec -- All bindings are FltLifted *or*
324 -- strict (perhaps because unlifted,
325 -- perhaps because of a strict binder),
326 -- *and* ok-for-speculation
327 -- Hence ok to float out of the RHS
328 -- of a lazy non-recursive let binding
329 -- (but not to top level, or into a rec group)
331 | FltCareful -- At least one binding is strict (or unlifted)
332 -- and not guaranteed cheap
333 -- Do not float these bindings out of a lazy let
335 instance Outputable Floats where
336 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
338 instance Outputable FloatFlag where
339 ppr FltLifted = ptext SLIT("FltLifted")
340 ppr FltOkSpec = ptext SLIT("FltOkSpec")
341 ppr FltCareful = ptext SLIT("FltCareful")
343 andFF :: FloatFlag -> FloatFlag -> FloatFlag
344 andFF FltCareful _ = FltCareful
345 andFF FltOkSpec FltCareful = FltCareful
346 andFF FltOkSpec flt = FltOkSpec
347 andFF FltLifted flt = flt
349 classifyFF :: CoreBind -> FloatFlag
350 classifyFF (Rec _) = FltLifted
351 classifyFF (NonRec bndr rhs)
352 | not (isStrictId bndr) = FltLifted
353 | exprOkForSpeculation rhs = FltOkSpec
354 | otherwise = FltCareful
356 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
357 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
358 = not (isNilOL fs) && want_to_float && can_float
360 want_to_float = isTopLevel lvl || exprIsCheap rhs
361 can_float = case ff of
363 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
364 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
369 emptyFloats :: Floats
370 emptyFloats = Floats nilOL FltLifted
372 unitFloat :: OutBind -> Floats
373 -- A single-binding float
374 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
376 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
377 -- Add a non-recursive binding and extend the in-scope set
378 -- The latter is important; the binder may already be in the
379 -- in-scope set (although it might also have been created with newId)
380 -- but it may now have more IdInfo
382 = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
383 seInScope = extendInScopeSet (seInScope env) id }
385 extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
386 -- Add these bindings to the floats, and extend the in-scope env too
387 extendFloats env binds
388 = env { seFloats = seFloats env `addFlts` new_floats,
389 seInScope = extendInScopeSetList (seInScope env) bndrs }
391 bndrs = bindersOfBinds binds
392 new_floats = Floats (toOL binds)
393 (foldr (andFF . classifyFF) FltLifted binds)
395 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
396 -- Add the floats for env2 to env1;
397 -- *plus* the in-scope set for env2, which is bigger
398 -- than that for env1
400 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
401 seInScope = seInScope env2 }
403 addFlts :: Floats -> Floats -> Floats
404 addFlts (Floats bs1 l1) (Floats bs2 l2)
405 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
407 zapFloats :: SimplEnv -> SimplEnv
408 zapFloats env = env { seFloats = emptyFloats }
410 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
411 -- Flattens the floats from env2 into a single Rec group,
412 -- prepends the floats from env1, and puts the result back in env2
413 -- This is all very specific to the way recursive bindings are
414 -- handled; see Simplify.simplRecBind
415 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
416 = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
417 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
419 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
420 wrapFloats env expr = wrapFlts (seFloats env) expr
422 wrapFlts :: Floats -> OutExpr -> OutExpr
423 -- Wrap the floats around the expression, using case-binding where necessary
424 wrapFlts (Floats bs _) body = foldrOL wrap body bs
426 wrap (Rec prs) body = Let (Rec prs) body
427 wrap (NonRec b r) body = bindNonRec b r body
429 getFloats :: SimplEnv -> [CoreBind]
430 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
432 isEmptyFloats :: SimplEnv -> Bool
433 isEmptyFloats env = isEmptyFlts (seFloats env)
435 isEmptyFlts :: Floats -> Bool
436 isEmptyFlts (Floats bs _) = isNilOL bs
438 floatBinds :: Floats -> [OutBind]
439 floatBinds (Floats bs _) = fromOL bs
443 %************************************************************************
447 %************************************************************************
451 substId :: SimplEnv -> Id -> SimplSR
452 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
455 | otherwise -- A local Id
456 = case lookupVarEnv ids v of
457 Just (DoneId v) -> DoneId (refine in_scope v)
459 Nothing -> DoneId (refine in_scope v)
462 -- Get the most up-to-date thing from the in-scope set
463 -- Even though it isn't in the substitution, it may be in
464 -- the in-scope set with better IdInfo
465 refine in_scope v = case lookupInScope in_scope v of
467 Nothing -> WARN( True, ppr v ) v -- This is an error!
469 lookupRecBndr :: SimplEnv -> Id -> Id
470 -- Look up an Id which has been put into the envt by simplRecBndrs,
471 -- but where we have not yet done its RHS
472 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
473 = case lookupVarEnv ids v of
475 Just res -> pprPanic "lookupRecBndr" (ppr v)
476 Nothing -> refine in_scope v
480 %************************************************************************
482 \section{Substituting an Id binder}
484 %************************************************************************
487 These functions are in the monad only so that they can be made strict via seq.
490 simplBinders, simplLamBndrs
491 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
492 simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
493 simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
496 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
497 -- Used for lambda and case-bound variables
498 -- Clone Id if necessary, substitute type
499 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
500 -- The substitution is extended only if the variable is cloned, because
501 -- we *don't* need to use it to track occurrence info.
503 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
504 ; seqTyVar tv `seq` return (env', tv) }
505 | otherwise = do { let (env', id) = substIdBndr env bndr
506 ; seqId id `seq` return (env', id) }
509 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
510 -- Used for lambda binders. These sometimes have unfoldings added by
511 -- the worker/wrapper pass that must be preserved, becuase they can't
512 -- be reconstructed from context. For example:
513 -- f x = case x of (a,b) -> fw a b x
514 -- fw a b x{=(a,b)} = ...
515 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
516 simplLamBndr env bndr
517 | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr -- Normal case
518 | otherwise = seqId id2 `seq` return (env', id2)
520 old_unf = idUnfolding bndr
521 (env', id1) = substIdBndr env bndr
522 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
525 substIdBndr :: SimplEnv -> Id -- Substitition and Id to transform
526 -> (SimplEnv, Id) -- Transformed pair
529 -- * Unique changed if necessary
530 -- * Type substituted
531 -- * Unfolding zapped
532 -- * Rules, worker, lbvar info all substituted
533 -- * Fragile occurrence info zapped
534 -- * The in-scope set extended with the returned Id
535 -- * The substitution extended with a DoneId if unique changed
536 -- In this case, the var in the DoneId is the same as the
539 -- Exactly like CoreSubst.substIdBndr, except that the type of id_subst differs
541 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
543 = (env { seInScope = in_scope `extendInScopeSet` new_id,
544 seIdSubst = new_subst }, new_id)
546 -- id1 is cloned if necessary
547 id1 = uniqAway in_scope old_id
549 -- id2 has its type zapped
550 id2 = substIdType env id1
552 -- new_id has the final IdInfo
553 subst = mkCoreSubst env
554 new_id = maybeModifyIdInfo (substIdInfo subst (idInfo old_id)) id2
556 -- Extend the substitution if the unique has changed
557 -- See the notes with substTyVarBndr for the delSubstEnv
558 -- Also see Note [Extending the Subst] in CoreSubst
559 new_subst | new_id /= old_id
560 = extendVarEnv id_subst old_id (DoneId new_id)
562 = delVarEnv id_subst old_id
566 ------------------------------------
567 seqTyVar :: TyVar -> ()
568 seqTyVar b = b `seq` ()
571 seqId id = seqType (idType id) `seq`
577 seqIds (id:ids) = seqId id `seq` seqIds ids
580 %************************************************************************
584 %************************************************************************
586 Simplifying let binders
587 ~~~~~~~~~~~~~~~~~~~~~~~
588 Rename the binders if necessary,
591 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
592 simplNonRecBndr env id
593 = do { let (env1, id1) = substLetIdBndr env id
594 ; seqId id1 `seq` return (env1, id1) }
597 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
598 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
599 = do { let (env1, ids1) = mapAccumL substLetIdBndr env ids
600 ; seqIds ids1 `seq` return env1 }
603 substLetIdBndr :: SimplEnv -> InBndr -- Env and binder to transform
604 -> (SimplEnv, OutBndr)
605 -- C.f. substIdBndr above
606 -- Clone Id if necessary, substitute its type
607 -- Return an Id with its fragile info zapped
608 -- namely, any info that depends on free variables
609 -- [addLetIdInfo, below, will restore its IdInfo]
610 -- We want to retain robust info, especially arity and demand info,
611 -- so that they are available to occurrences that occur in an
612 -- earlier binding of a letrec
613 -- Augment the subtitution
614 -- if the unique changed, *or*
615 -- if there's interesting occurrence info
617 substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
618 = (env { seInScope = in_scope `extendInScopeSet` new_id,
619 seIdSubst = new_subst }, new_id)
621 id1 = uniqAway in_scope old_id
622 id2 = substIdType env id1
624 -- We want to get rid of any info that's dependent on free variables,
625 -- but keep other info (like the arity).
626 new_id = zapFragileIdInfo id2
628 -- Extend the substitution if the unique has changed,
629 -- or there's some useful occurrence information
630 -- See the notes with substTyVarBndr for the delSubstEnv
631 new_subst | new_id /= old_id
632 = extendVarEnv id_subst old_id (DoneId new_id)
634 = delVarEnv id_subst old_id
637 Note [Add IdInfo back onto a let-bound Id]
638 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
639 We must transfer the IdInfo of the original binder to the new binder.
640 This is crucial, to preserve
644 etc. To do this we must apply the current substitution,
645 which incorporates earlier substitutions in this very letrec group.
647 NB 1. We do this *before* processing the RHS of the binder, so that
648 its substituted rules are visible in its own RHS.
649 This is important. Manuel found cases where he really, really
650 wanted a RULE for a recursive function to apply in that function's
653 NB 2: ARITY. We *do* transfer the arity. This is important, so that
654 the arity of an Id is visible in its own RHS. For example:
655 f = \x. ....g (\y. f y)....
656 We can eta-reduce the arg to g, becuase f is a value. But that
659 This interacts with the 'state hack' too:
664 Can we eta-expand f? Only if we see that f has arity 1, and then we
665 take advantage of the 'state hack' on the result of
666 (f y) :: State# -> (State#, Int) to expand the arity one more.
668 There is a disadvantage though. Making the arity visible in the RHA
669 allows us to eta-reduce
673 which technically is not sound. This is very much a corner case, so
674 I'm not worried about it. Another idea is to ensure that f's arity
675 never decreases; its arity started as 1, and we should never eta-reduce
678 NB 3: OccInfo. It's important that we *do* transer the loop-breaker
679 OccInfo, because that's what stops the Id getting inlined infinitely,
680 in the body of the letrec.
682 NB 4: does no harm for non-recursive bindings
684 NB 5: we can't do the addLetIdInfo part before *all* the RHSs because
689 Here, we'll do postInlineUnconditionally on f, and we must "see" that
690 when substituting in h's RULE.
693 addLetIdInfo :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
694 addLetIdInfo env in_id out_id
695 = (modifyInScope env out_id final_id, final_id)
697 final_id = out_id `setIdInfo` new_info
698 subst = mkCoreSubst env
699 old_info = idInfo in_id
700 new_info = case substIdInfo subst old_info of
702 Just new_info -> new_info
704 substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
709 -- Keep only 'robust' OccInfo
712 -- Seq'ing on the returned IdInfo is enough to cause all the
713 -- substitutions to happen completely
715 substIdInfo subst info
716 | nothing_to_do = Nothing
717 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
718 `setSpecInfo` CoreSubst.substSpec subst old_rules
719 `setWorkerInfo` CoreSubst.substWorker subst old_wrkr
720 `setUnfoldingInfo` noUnfolding)
721 -- setSpecInfo does a seq
722 -- setWorkerInfo does a seq
724 nothing_to_do = keep_occ &&
725 isEmptySpecInfo old_rules &&
726 not (workerExists old_wrkr) &&
727 not (hasUnfolding (unfoldingInfo info))
729 keep_occ = not (isFragileOcc old_occ)
730 old_occ = occInfo info
731 old_rules = specInfo info
732 old_wrkr = workerInfo info
735 substIdType :: SimplEnv -> Id -> Id
736 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
737 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
738 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
739 -- The tyVarsOfType is cheaper than it looks
740 -- because we cache the free tyvars of the type
741 -- in a Note in the id's type itself
746 substUnfolding env NoUnfolding = NoUnfolding
747 substUnfolding env (OtherCon cons) = OtherCon cons
748 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
749 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
753 %************************************************************************
755 Impedence matching to type substitution
757 %************************************************************************
760 substTy :: SimplEnv -> Type -> Type
761 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
762 = Type.substTy (TvSubst in_scope tv_env) ty
764 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
765 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
766 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
767 (TvSubst in_scope' tv_env', tv')
768 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
770 -- When substituting in rules etc we can get CoreSubst to do the work
771 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
772 -- here. I think the this will not usually result in a lot of work;
773 -- the substitutions are typically small, and laziness will avoid work in many cases.
775 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
776 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
777 = mk_subst tv_env id_env
779 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
781 fiddle (DoneEx e) = e
782 fiddle (DoneId v) = Var v
783 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
785 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
787 | isEmptySimplSubst env = expr
788 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr