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 )
63 %************************************************************************
65 \subsection[Simplify-types]{Type declarations}
67 %************************************************************************
70 type InBndr = CoreBndr
71 type InId = Id -- Not yet cloned
72 type InType = Type -- Ditto
73 type InBind = CoreBind
74 type InExpr = CoreExpr
77 type InCoercion = Coercion
79 type OutBndr = CoreBndr
80 type OutId = Id -- Cloned
81 type OutTyVar = TyVar -- Cloned
82 type OutType = Type -- Cloned
83 type OutCoercion = Coercion
84 type OutBind = CoreBind
85 type OutExpr = CoreExpr
90 %************************************************************************
92 \subsubsection{The @SimplEnv@ type}
94 %************************************************************************
100 seMode :: SimplifierMode,
101 seChkr :: SwitchChecker,
102 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
104 -- The current set of in-scope variables
105 -- They are all OutVars, and all bound in this module
106 seInScope :: InScopeSet, -- OutVars only
107 -- Includes all variables bound by seFloats
109 -- See Note [Simplifier floats]
111 -- The current substitution
112 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
113 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
117 pprSimplEnv :: SimplEnv -> SDoc
118 -- Used for debugging; selective
120 = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
121 ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
123 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
124 -- See Note [Extending the Subst] in CoreSubst
127 = DoneEx OutExpr -- Completed term
128 | DoneId OutId -- Completed term variable
129 | ContEx TvSubstEnv -- A suspended substitution
133 instance Outputable SimplSR where
134 ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
135 ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
136 ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
137 ppr (filter_env tv), ppr (filter_env id) -}]
139 -- fvs = exprFreeVars e
140 -- filter_env env = filterVarEnv_Directly keep env
141 -- keep uniq _ = uniq `elemUFM_Directly` fvs
146 The in-scope part of Subst includes *all* in-scope TyVars and Ids
147 The elements of the set may have better IdInfo than the
148 occurrences of in-scope Ids, and (more important) they will
149 have a correctly-substituted type. So we use a lookup in this
150 set to replace occurrences
152 The Ids in the InScopeSet are replete with their Rules,
153 and as we gather info about the unfolding of an Id, we replace
154 it in the in-scope set.
156 The in-scope set is actually a mapping OutVar -> OutVar, and
157 in case expressions we sometimes bind
160 The substitution is *apply-once* only, because InIds and OutIds can overlap.
161 For example, we generally omit mappings
163 from the substitution, when we decide not to clone a77, but it's quite
164 legitimate to put the mapping in the substitution anyway.
166 Furthermore, consider
167 let x = case k of I# x77 -> ... in
168 let y = case k of I# x77 -> ... in ...
169 and suppose the body is strict in both x and y. Then the simplifier
170 will pull the first (case k) to the top; so the second (case k) will
171 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
174 Of course, the substitution *must* applied! Things in its domain
175 simply aren't necessarily bound in the result.
177 * substId adds a binding (DoneId new_id) to the substitution if
178 the Id's unique has changed
181 Note, though that the substitution isn't necessarily extended
182 if the type changes. Why not? Because of the next point:
184 * We *always, always* finish by looking up in the in-scope set
185 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
186 Reason: so that we never finish up with a "old" Id in the result.
187 An old Id might point to an old unfolding and so on... which gives a space leak.
189 [The DoneEx and DoneVar hits map to "new" stuff.]
191 * It follows that substExpr must not do a no-op if the substitution is empty.
192 substType is free to do so, however.
194 * When we come to a let-binding (say) we generate new IdInfo, including an
195 unfolding, attach it to the binder, and add this newly adorned binder to
196 the in-scope set. So all subsequent occurrences of the binder will get mapped
197 to the full-adorned binder, which is also the one put in the binding site.
199 * The in-scope "set" usually maps x->x; we use it simply for its domain.
200 But sometimes we have two in-scope Ids that are synomyms, and should
201 map to the same target: x->x, y->x. Notably:
203 That's why the "set" is actually a VarEnv Var
207 mkSimplEnv :: SimplifierMode -> SwitchChecker -> SimplEnv
208 mkSimplEnv mode switches
209 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
210 seMode = mode, seInScope = emptyInScopeSet,
211 seFloats = emptyFloats,
212 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
213 -- The top level "enclosing CC" is "SUBSUMED".
215 ---------------------
216 getSwitchChecker :: SimplEnv -> SwitchChecker
217 getSwitchChecker env = seChkr env
219 ---------------------
220 getMode :: SimplEnv -> SimplifierMode
221 getMode env = seMode env
223 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
224 setMode mode env = env { seMode = mode }
226 ---------------------
227 getEnclosingCC :: SimplEnv -> CostCentreStack
228 getEnclosingCC env = seCC env
230 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
231 setEnclosingCC env cc = env {seCC = cc}
233 ---------------------
234 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
235 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
236 = env {seIdSubst = extendVarEnv subst var res}
238 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
239 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
240 = env {seTvSubst = extendVarEnv subst var res}
242 ---------------------
243 getInScope :: SimplEnv -> InScopeSet
244 getInScope env = seInScope env
246 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
247 setInScopeSet env in_scope = env {seInScope = in_scope}
249 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
250 -- Set the in-scope set, and *zap* the floats
251 setInScope env env_with_scope
252 = env { seInScope = seInScope env_with_scope,
253 seFloats = emptyFloats }
255 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
256 -- Set the in-scope set *and* the floats
257 setFloats env env_with_floats
258 = env { seInScope = seInScope env_with_floats,
259 seFloats = seFloats env_with_floats }
261 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
262 -- The new Ids are guaranteed to be freshly allocated
263 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
264 = env { seInScope = in_scope `extendInScopeSetList` vs,
265 seIdSubst = id_subst `delVarEnvList` vs }
266 -- Why delete? Consider
267 -- let x = a*b in (x, \x -> x+3)
268 -- We add [x |-> a*b] to the substitution, but we must
269 -- *delete* it from the substitution when going inside
272 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
273 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
274 = env {seInScope = modifyInScopeSet in_scope v v'}
276 ---------------------
277 zapSubstEnv :: SimplEnv -> SimplEnv
278 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
280 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
281 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
283 mkContEx :: SimplEnv -> InExpr -> SimplSR
284 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
286 isEmptySimplSubst :: SimplEnv -> Bool
287 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
288 = isEmptyVarEnv tvs && isEmptyVarEnv ids
293 %************************************************************************
297 %************************************************************************
299 Note [Simplifier floats]
300 ~~~~~~~~~~~~~~~~~~~~~~~~~
301 The Floats is a bunch of bindings, classified by a FloatFlag.
303 NonRec x (y:ys) FltLifted
304 Rec [(x,rhs)] FltLifted
306 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
308 NonRec x# (a /# b) FltCareful
309 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
310 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
311 -- (where f :: Int -> Int#)
314 data Floats = Floats (OrdList OutBind) FloatFlag
315 -- See Note [Simplifier floats]
318 = FltLifted -- All bindings are lifted and lazy
319 -- Hence ok to float to top level, or recursive
321 | FltOkSpec -- All bindings are FltLifted *or*
322 -- strict (perhaps because unlifted,
323 -- perhaps because of a strict binder),
324 -- *and* ok-for-speculation
325 -- Hence ok to float out of the RHS
326 -- of a lazy non-recursive let binding
327 -- (but not to top level, or into a rec group)
329 | FltCareful -- At least one binding is strict (or unlifted)
330 -- and not guaranteed cheap
331 -- Do not float these bindings out of a lazy let
333 instance Outputable Floats where
334 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
336 instance Outputable FloatFlag where
337 ppr FltLifted = ptext SLIT("FltLifted")
338 ppr FltOkSpec = ptext SLIT("FltOkSpec")
339 ppr FltCareful = ptext SLIT("FltCareful")
341 andFF :: FloatFlag -> FloatFlag -> FloatFlag
342 andFF FltCareful _ = FltCareful
343 andFF FltOkSpec FltCareful = FltCareful
344 andFF FltOkSpec flt = FltOkSpec
345 andFF FltLifted flt = flt
347 classifyFF :: CoreBind -> FloatFlag
348 classifyFF (Rec _) = FltLifted
349 classifyFF (NonRec bndr rhs)
350 | not (isStrictId bndr) = FltLifted
351 | exprOkForSpeculation rhs = FltOkSpec
352 | otherwise = FltCareful
354 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
355 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
356 = not (isNilOL fs) && want_to_float && can_float
358 want_to_float = isTopLevel lvl || exprIsCheap rhs
359 can_float = case ff of
361 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
362 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
367 emptyFloats :: Floats
368 emptyFloats = Floats nilOL FltLifted
370 unitFloat :: OutBind -> Floats
371 -- A single-binding float
372 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
374 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
375 -- Add a non-recursive binding and extend the in-scope set
376 -- The latter is important; the binder may already be in the
377 -- in-scope set (although it might also have been created with newId)
378 -- but it may now have more IdInfo
380 = env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
381 seInScope = extendInScopeSet (seInScope env) id }
383 extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
384 -- Add these bindings to the floats, and extend the in-scope env too
385 extendFloats env binds
386 = env { seFloats = seFloats env `addFlts` new_floats,
387 seInScope = extendInScopeSetList (seInScope env) bndrs }
389 bndrs = bindersOfBinds binds
390 new_floats = Floats (toOL binds)
391 (foldr (andFF . classifyFF) FltLifted binds)
393 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
394 -- Add the floats for env2 to env1;
395 -- *plus* the in-scope set for env2, which is bigger
396 -- than that for env1
398 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
399 seInScope = seInScope env2 }
401 addFlts :: Floats -> Floats -> Floats
402 addFlts (Floats bs1 l1) (Floats bs2 l2)
403 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
405 zapFloats :: SimplEnv -> SimplEnv
406 zapFloats env = env { seFloats = emptyFloats }
408 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
409 -- Flattens the floats from env2 into a single Rec group,
410 -- prepends the floats from env1, and puts the result back in env2
411 -- This is all very specific to the way recursive bindings are
412 -- handled; see Simplify.simplRecBind
413 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
414 = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
415 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
417 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
418 wrapFloats env expr = wrapFlts (seFloats env) expr
420 wrapFlts :: Floats -> OutExpr -> OutExpr
421 -- Wrap the floats around the expression, using case-binding where necessary
422 wrapFlts (Floats bs _) body = foldrOL wrap body bs
424 wrap (Rec prs) body = Let (Rec prs) body
425 wrap (NonRec b r) body = bindNonRec b r body
427 getFloats :: SimplEnv -> [CoreBind]
428 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
430 isEmptyFloats :: SimplEnv -> Bool
431 isEmptyFloats env = isEmptyFlts (seFloats env)
433 isEmptyFlts :: Floats -> Bool
434 isEmptyFlts (Floats bs _) = isNilOL bs
436 floatBinds :: Floats -> [OutBind]
437 floatBinds (Floats bs _) = fromOL bs
441 %************************************************************************
445 %************************************************************************
449 substId :: SimplEnv -> Id -> SimplSR
450 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
453 | otherwise -- A local Id
454 = case lookupVarEnv ids v of
455 Just (DoneId v) -> DoneId (refine in_scope v)
457 Nothing -> DoneId (refine in_scope v)
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 in_scope v = case lookupInScope in_scope v of
465 Nothing -> WARN( True, ppr v ) v -- This is an error!
467 lookupRecBndr :: SimplEnv -> Id -> Id
468 -- Look up an Id which has been put into the envt by simplRecBndrs,
469 -- but where we have not yet done its RHS
470 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
471 = case lookupVarEnv ids v of
473 Just res -> pprPanic "lookupRecBndr" (ppr v)
474 Nothing -> refine in_scope v
478 %************************************************************************
480 \section{Substituting an Id binder}
482 %************************************************************************
485 These functions are in the monad only so that they can be made strict via seq.
488 simplBinders, simplLamBndrs
489 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
490 simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
491 simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
494 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
495 -- Used for lambda and case-bound variables
496 -- Clone Id if necessary, substitute type
497 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
498 -- The substitution is extended only if the variable is cloned, because
499 -- we *don't* need to use it to track occurrence info.
501 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
502 ; seqTyVar tv `seq` return (env', tv) }
503 | otherwise = do { let (env', id) = substIdBndr env bndr
504 ; seqId id `seq` return (env', id) }
507 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
508 -- Used for lambda binders. These sometimes have unfoldings added by
509 -- the worker/wrapper pass that must be preserved, becuase they can't
510 -- be reconstructed from context. For example:
511 -- f x = case x of (a,b) -> fw a b x
512 -- fw a b x{=(a,b)} = ...
513 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
514 simplLamBndr env bndr
515 | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr -- Normal case
516 | otherwise = seqId id2 `seq` return (env', id2)
518 old_unf = idUnfolding bndr
519 (env', id1) = substIdBndr env bndr
520 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
523 substIdBndr :: SimplEnv -> Id -- Substitition and Id to transform
524 -> (SimplEnv, Id) -- Transformed pair
527 -- * Unique changed if necessary
528 -- * Type substituted
529 -- * Unfolding zapped
530 -- * Rules, worker, lbvar info all substituted
531 -- * Fragile occurrence info zapped
532 -- * The in-scope set extended with the returned Id
533 -- * The substitution extended with a DoneId if unique changed
534 -- In this case, the var in the DoneId is the same as the
537 -- Exactly like CoreSubst.substIdBndr, except that the type of id_subst differs
539 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
541 = (env { seInScope = in_scope `extendInScopeSet` new_id,
542 seIdSubst = new_subst }, new_id)
544 -- id1 is cloned if necessary
545 id1 = uniqAway in_scope old_id
547 -- id2 has its type zapped
548 id2 = substIdType env id1
550 -- new_id has the final IdInfo
551 subst = mkCoreSubst env
552 new_id = maybeModifyIdInfo (substIdInfo subst (idInfo old_id)) id2
554 -- Extend the substitution if the unique has changed
555 -- See the notes with substTyVarBndr for the delSubstEnv
556 -- Also see Note [Extending the Subst] in CoreSubst
557 new_subst | new_id /= old_id
558 = extendVarEnv id_subst old_id (DoneId new_id)
560 = delVarEnv id_subst old_id
564 ------------------------------------
565 seqTyVar :: TyVar -> ()
566 seqTyVar b = b `seq` ()
569 seqId id = seqType (idType id) `seq`
575 seqIds (id:ids) = seqId id `seq` seqIds ids
578 %************************************************************************
582 %************************************************************************
584 Simplifying let binders
585 ~~~~~~~~~~~~~~~~~~~~~~~
586 Rename the binders if necessary,
589 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
590 simplNonRecBndr env id
591 = do { let (env1, id1) = substLetIdBndr env id
592 ; seqId id1 `seq` return (env1, id1) }
595 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
596 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
597 = do { let (env1, ids1) = mapAccumL substLetIdBndr env ids
598 ; seqIds ids1 `seq` return env1 }
601 substLetIdBndr :: SimplEnv -> InBndr -- Env and binder to transform
602 -> (SimplEnv, OutBndr)
603 -- C.f. substIdBndr above
604 -- Clone Id if necessary, substitute its type
605 -- Return an Id with its fragile info zapped
606 -- namely, any info that depends on free variables
607 -- [addLetIdInfo, below, will restore its IdInfo]
608 -- We want to retain robust info, especially arity and demand info,
609 -- so that they are available to occurrences that occur in an
610 -- earlier binding of a letrec
611 -- Augment the subtitution
612 -- if the unique changed, *or*
613 -- if there's interesting occurrence info
615 substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
616 = (env { seInScope = in_scope `extendInScopeSet` new_id,
617 seIdSubst = new_subst }, new_id)
619 id1 = uniqAway in_scope old_id
620 id2 = substIdType env id1
622 -- We want to get rid of any info that's dependent on free variables,
623 -- but keep other info (like the arity).
624 new_id = zapFragileIdInfo id2
626 -- Extend the substitution if the unique has changed,
627 -- or there's some useful occurrence information
628 -- See the notes with substTyVarBndr for the delSubstEnv
629 new_subst | new_id /= old_id
630 = extendVarEnv id_subst old_id (DoneId new_id)
632 = delVarEnv id_subst old_id
635 Note [Add IdInfo back onto a let-bound Id]
636 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
637 We must transfer the IdInfo of the original binder to the new binder.
638 This is crucial, to preserve
642 etc. To do this we must apply the current substitution,
643 which incorporates earlier substitutions in this very letrec group.
645 NB 1. We do this *before* processing the RHS of the binder, so that
646 its substituted rules are visible in its own RHS.
647 This is important. Manuel found cases where he really, really
648 wanted a RULE for a recursive function to apply in that function's
651 NB 2: ARITY. We *do* transfer the arity. This is important, so that
652 the arity of an Id is visible in its own RHS. For example:
653 f = \x. ....g (\y. f y)....
654 We can eta-reduce the arg to g, becuase f is a value. But that
657 This interacts with the 'state hack' too:
662 Can we eta-expand f? Only if we see that f has arity 1, and then we
663 take advantage of the 'state hack' on the result of
664 (f y) :: State# -> (State#, Int) to expand the arity one more.
666 There is a disadvantage though. Making the arity visible in the RHA
667 allows us to eta-reduce
671 which technically is not sound. This is very much a corner case, so
672 I'm not worried about it. Another idea is to ensure that f's arity
673 never decreases; its arity started as 1, and we should never eta-reduce
676 NB 3: OccInfo. It's important that we *do* transer the loop-breaker
677 OccInfo, because that's what stops the Id getting inlined infinitely,
678 in the body of the letrec.
680 NB 4: does no harm for non-recursive bindings
682 NB 5: we can't do the addLetIdInfo part before *all* the RHSs because
687 Here, we'll do postInlineUnconditionally on f, and we must "see" that
688 when substituting in h's RULE.
691 addLetIdInfo :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
692 addLetIdInfo env in_id out_id
693 = (modifyInScope env out_id final_id, final_id)
695 final_id = out_id `setIdInfo` new_info
696 subst = mkCoreSubst env
697 old_info = idInfo in_id
698 new_info = case substIdInfo subst old_info of
700 Just new_info -> new_info
702 substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
707 -- Keep only 'robust' OccInfo
710 -- Seq'ing on the returned IdInfo is enough to cause all the
711 -- substitutions to happen completely
713 substIdInfo subst info
714 | nothing_to_do = Nothing
715 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
716 `setSpecInfo` CoreSubst.substSpec subst old_rules
717 `setWorkerInfo` CoreSubst.substWorker subst old_wrkr
718 `setUnfoldingInfo` noUnfolding)
719 -- setSpecInfo does a seq
720 -- setWorkerInfo does a seq
722 nothing_to_do = keep_occ &&
723 isEmptySpecInfo old_rules &&
724 not (workerExists old_wrkr) &&
725 not (hasUnfolding (unfoldingInfo info))
727 keep_occ = not (isFragileOcc old_occ)
728 old_occ = occInfo info
729 old_rules = specInfo info
730 old_wrkr = workerInfo info
733 substIdType :: SimplEnv -> Id -> Id
734 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
735 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
736 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
737 -- The tyVarsOfType is cheaper than it looks
738 -- because we cache the free tyvars of the type
739 -- in a Note in the id's type itself
744 substUnfolding env NoUnfolding = NoUnfolding
745 substUnfolding env (OtherCon cons) = OtherCon cons
746 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
747 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
751 %************************************************************************
753 Impedence matching to type substitution
755 %************************************************************************
758 substTy :: SimplEnv -> Type -> Type
759 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
760 = Type.substTy (TvSubst in_scope tv_env) ty
762 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
763 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
764 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
765 (TvSubst in_scope' tv_env', tv')
766 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
768 -- When substituting in rules etc we can get CoreSubst to do the work
769 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
770 -- here. I think the this will not usually result in a lot of work;
771 -- the substitutions are typically small, and laziness will avoid work in many cases.
773 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
774 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
775 = mk_subst tv_env id_env
777 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
779 fiddle (DoneEx e) = e
780 fiddle (DoneId v) = Var v
781 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
783 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
785 | isEmptySimplSubst env = expr
786 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr