2 o% (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[SimplMonad]{The simplifier Monad}
8 InId, InBind, InExpr, InAlt, InArg, InType, InBndr, InVar,
9 OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr, OutVar,
10 InCoercion, OutCoercion,
12 -- The simplifier mode
13 setMode, getMode, updMode,
15 setEnclosingCC, getEnclosingCC,
18 SimplEnv(..), StaticEnv, pprSimplEnv, -- Temp not abstract
19 mkSimplEnv, extendIdSubst, SimplEnv.extendTvSubst, SimplEnv.extendCvSubst,
20 zapSubstEnv, setSubstEnv,
21 getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
24 SimplSR(..), mkContEx, substId, lookupRecBndr,
26 simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
27 simplBinder, simplBinders, addBndrRules,
28 substExpr, substTy, substTyVar, getTvSubst,
29 getCvSubst, substCo, substCoVar,
33 Floats, emptyFloats, isEmptyFloats, addNonRec, addFloats, extendFloats,
34 wrapFloats, floatBinds, setFloats, zapFloats, addRecFloats,
35 doFloatFromRhs, getFloats
38 #include "HsVersions.h"
41 import CoreMonad ( SimplifierMode(..) )
53 import qualified CoreSubst
55 import Type hiding ( substTy, substTyVarBndr, substTyVar )
56 import qualified Coercion
57 import Coercion hiding ( substCo, substTy, substCoVar, substCoVarBndr, substTyVarBndr )
66 %************************************************************************
68 \subsection[Simplify-types]{Type declarations}
70 %************************************************************************
73 type InBndr = CoreBndr
74 type InVar = Var -- Not yet cloned
75 type InId = Id -- Not yet cloned
76 type InType = Type -- Ditto
77 type InBind = CoreBind
78 type InExpr = CoreExpr
81 type InCoercion = Coercion
83 type OutBndr = CoreBndr
84 type OutVar = Var -- Cloned
85 type OutId = Id -- Cloned
86 type OutTyVar = TyVar -- Cloned
87 type OutType = Type -- Cloned
88 type OutCoercion = Coercion
89 type OutBind = CoreBind
90 type OutExpr = CoreExpr
95 %************************************************************************
97 \subsubsection{The @SimplEnv@ type}
99 %************************************************************************
105 ----------- Static part of the environment -----------
106 -- Static in the sense of lexically scoped,
107 -- wrt the original expression
109 seMode :: SimplifierMode,
110 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
112 -- The current substitution
113 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
114 seCvSubst :: CvSubstEnv, -- InTyCoVar |--> OutCoercion
115 seIdSubst :: SimplIdSubst, -- InId |--> OutExpr
117 ----------- Dynamic part of the environment -----------
118 -- Dynamic in the sense of describing the setup where
119 -- the expression finally ends up
121 -- The current set of in-scope variables
122 -- They are all OutVars, and all bound in this module
123 seInScope :: InScopeSet, -- OutVars only
124 -- Includes all variables bound by seFloats
126 -- See Note [Simplifier floats]
129 type StaticEnv = SimplEnv -- Just the static part is relevant
131 pprSimplEnv :: SimplEnv -> SDoc
132 -- Used for debugging; selective
134 = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
135 ptext (sLit "IdSubst:") <+> ppr (seIdSubst env),
136 ptext (sLit "InScope:") <+> vcat (map ppr_one in_scope_vars)
139 in_scope_vars = varEnvElts (getInScopeVars (seInScope env))
140 ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)
143 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
144 -- See Note [Extending the Subst] in CoreSubst
147 = DoneEx OutExpr -- Completed term
148 | DoneId OutId -- Completed term variable
149 | ContEx TvSubstEnv -- A suspended substitution
154 instance Outputable SimplSR where
155 ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
156 ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
157 ppr (ContEx _tv _cv _id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
158 ppr (filter_env tv), ppr (filter_env id) -}]
160 -- fvs = exprFreeVars e
161 -- filter_env env = filterVarEnv_Directly keep env
162 -- keep uniq _ = uniq `elemUFM_Directly` fvs
165 Note [SimplEnv invariants]
166 ~~~~~~~~~~~~~~~~~~~~~~~~~~
168 The in-scope part of Subst includes *all* in-scope TyVars and Ids
169 The elements of the set may have better IdInfo than the
170 occurrences of in-scope Ids, and (more important) they will
171 have a correctly-substituted type. So we use a lookup in this
172 set to replace occurrences
174 The Ids in the InScopeSet are replete with their Rules,
175 and as we gather info about the unfolding of an Id, we replace
176 it in the in-scope set.
178 The in-scope set is actually a mapping OutVar -> OutVar, and
179 in case expressions we sometimes bind
182 The substitution is *apply-once* only, because InIds and OutIds can overlap.
183 For example, we generally omit mappings
185 from the substitution, when we decide not to clone a77, but it's quite
186 legitimate to put the mapping in the substitution anyway.
188 Furthermore, consider
189 let x = case k of I# x77 -> ... in
190 let y = case k of I# x77 -> ... in ...
191 and suppose the body is strict in both x and y. Then the simplifier
192 will pull the first (case k) to the top; so the second (case k) will
193 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
196 Of course, the substitution *must* applied! Things in its domain
197 simply aren't necessarily bound in the result.
199 * substId adds a binding (DoneId new_id) to the substitution if
200 the Id's unique has changed
202 Note, though that the substitution isn't necessarily extended
203 if the type of the Id changes. Why not? Because of the next point:
205 * We *always, always* finish by looking up in the in-scope set
206 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
207 Reason: so that we never finish up with a "old" Id in the result.
208 An old Id might point to an old unfolding and so on... which gives a space leak.
210 [The DoneEx and DoneVar hits map to "new" stuff.]
212 * It follows that substExpr must not do a no-op if the substitution is empty.
213 substType is free to do so, however.
215 * When we come to a let-binding (say) we generate new IdInfo, including an
216 unfolding, attach it to the binder, and add this newly adorned binder to
217 the in-scope set. So all subsequent occurrences of the binder will get mapped
218 to the full-adorned binder, which is also the one put in the binding site.
220 * The in-scope "set" usually maps x->x; we use it simply for its domain.
221 But sometimes we have two in-scope Ids that are synomyms, and should
222 map to the same target: x->x, y->x. Notably:
224 That's why the "set" is actually a VarEnv Var
228 mkSimplEnv :: SimplifierMode -> SimplEnv
230 = SimplEnv { seCC = subsumedCCS
232 , seInScope = init_in_scope
233 , seFloats = emptyFloats
234 , seTvSubst = emptyVarEnv
235 , seCvSubst = emptyVarEnv
236 , seIdSubst = emptyVarEnv }
237 -- The top level "enclosing CC" is "SUBSUMED".
239 init_in_scope :: InScopeSet
240 init_in_scope = mkInScopeSet (unitVarSet (mkWildValBinder unitTy))
241 -- See Note [WildCard binders]
244 Note [WildCard binders]
245 ~~~~~~~~~~~~~~~~~~~~~~~
246 The program to be simplified may have wild binders
247 case e of wild { p -> ... }
248 We want to *rename* them away, so that there are no
249 occurrences of 'wild-id' (with wildCardKey). The easy
250 way to do that is to start of with a representative
251 Id in the in-scope set
253 There can be be *occurrences* of wild-id. For example,
254 MkCore.mkCoreApp transforms
255 e (a /# b) --> case (a /# b) of wild { DEFAULT -> e wild }
256 This is ok provided 'wild' isn't free in 'e', and that's the delicate
257 thing. Generally, you want to run the simplifier to get rid of the
258 wild-ids before doing much else.
260 It's a very dark corner of GHC. Maybe it should be cleaned up.
263 getMode :: SimplEnv -> SimplifierMode
264 getMode env = seMode env
266 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
267 setMode mode env = env { seMode = mode }
269 updMode :: (SimplifierMode -> SimplifierMode) -> SimplEnv -> SimplEnv
270 updMode upd env = env { seMode = upd (seMode env) }
272 ---------------------
273 getEnclosingCC :: SimplEnv -> CostCentreStack
274 getEnclosingCC env = seCC env
276 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
277 setEnclosingCC env cc = env {seCC = cc}
279 ---------------------
280 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
281 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
282 = env {seIdSubst = extendVarEnv subst var res}
284 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
285 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
286 = env {seTvSubst = extendVarEnv subst var res}
288 extendCvSubst :: SimplEnv -> CoVar -> Coercion -> SimplEnv
289 extendCvSubst env@(SimplEnv {seCvSubst = subst}) var res
290 = env {seCvSubst = extendVarEnv subst var res}
292 ---------------------
293 getInScope :: SimplEnv -> InScopeSet
294 getInScope env = seInScope env
296 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
297 setInScopeSet env in_scope = env {seInScope = in_scope}
299 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
300 -- Set the in-scope set, and *zap* the floats
301 setInScope env env_with_scope
302 = env { seInScope = seInScope env_with_scope,
303 seFloats = emptyFloats }
305 setFloats :: SimplEnv -> SimplEnv -> SimplEnv
306 -- Set the in-scope set *and* the floats
307 setFloats env env_with_floats
308 = env { seInScope = seInScope env_with_floats,
309 seFloats = seFloats env_with_floats }
311 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
312 -- The new Ids are guaranteed to be freshly allocated
313 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
314 = env { seInScope = in_scope `extendInScopeSetList` vs,
315 seIdSubst = id_subst `delVarEnvList` vs }
316 -- Why delete? Consider
317 -- let x = a*b in (x, \x -> x+3)
318 -- We add [x |-> a*b] to the substitution, but we must
319 -- _delete_ it from the substitution when going inside
322 modifyInScope :: SimplEnv -> CoreBndr -> SimplEnv
323 -- The variable should already be in scope, but
324 -- replace the existing version with this new one
325 -- which has more information
326 modifyInScope env@(SimplEnv {seInScope = in_scope}) v
327 = env {seInScope = extendInScopeSet in_scope v}
329 ---------------------
330 zapSubstEnv :: SimplEnv -> SimplEnv
331 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
333 setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv
334 setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }
336 mkContEx :: SimplEnv -> InExpr -> SimplSR
337 mkContEx (SimplEnv { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids }) e = ContEx tvs cvs ids e
342 %************************************************************************
346 %************************************************************************
348 Note [Simplifier floats]
349 ~~~~~~~~~~~~~~~~~~~~~~~~~
350 The Floats is a bunch of bindings, classified by a FloatFlag.
352 NonRec x (y:ys) FltLifted
353 Rec [(x,rhs)] FltLifted
355 NonRec x# (y +# 3) FltOkSpec -- Unboxed, but ok-for-spec'n
357 NonRec x# (a /# b) FltCareful
358 NonRec x* (f y) FltCareful -- Strict binding; might fail or diverge
359 NonRec x# (f y) FltCareful -- Unboxed binding: might fail or diverge
360 -- (where f :: Int -> Int#)
363 data Floats = Floats (OrdList OutBind) FloatFlag
364 -- See Note [Simplifier floats]
367 = FltLifted -- All bindings are lifted and lazy
368 -- Hence ok to float to top level, or recursive
370 | FltOkSpec -- All bindings are FltLifted *or*
371 -- strict (perhaps because unlifted,
372 -- perhaps because of a strict binder),
373 -- *and* ok-for-speculation
374 -- Hence ok to float out of the RHS
375 -- of a lazy non-recursive let binding
376 -- (but not to top level, or into a rec group)
378 | FltCareful -- At least one binding is strict (or unlifted)
379 -- and not guaranteed cheap
380 -- Do not float these bindings out of a lazy let
382 instance Outputable Floats where
383 ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
385 instance Outputable FloatFlag where
386 ppr FltLifted = ptext (sLit "FltLifted")
387 ppr FltOkSpec = ptext (sLit "FltOkSpec")
388 ppr FltCareful = ptext (sLit "FltCareful")
390 andFF :: FloatFlag -> FloatFlag -> FloatFlag
391 andFF FltCareful _ = FltCareful
392 andFF FltOkSpec FltCareful = FltCareful
393 andFF FltOkSpec _ = FltOkSpec
394 andFF FltLifted flt = flt
396 classifyFF :: CoreBind -> FloatFlag
397 classifyFF (Rec _) = FltLifted
398 classifyFF (NonRec bndr rhs)
399 | not (isStrictId bndr) = FltLifted
400 | exprOkForSpeculation rhs = FltOkSpec
401 | otherwise = FltCareful
403 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool
404 doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff})
405 = not (isNilOL fs) && want_to_float && can_float
407 want_to_float = isTopLevel lvl || exprIsExpandable rhs
408 can_float = case ff of
410 FltOkSpec -> isNotTopLevel lvl && isNonRec rec
411 FltCareful -> isNotTopLevel lvl && isNonRec rec && str
416 emptyFloats :: Floats
417 emptyFloats = Floats nilOL FltLifted
419 unitFloat :: OutBind -> Floats
420 -- A single-binding float
421 unitFloat bind = Floats (unitOL bind) (classifyFF bind)
423 addNonRec :: SimplEnv -> OutId -> OutExpr -> SimplEnv
424 -- Add a non-recursive binding and extend the in-scope set
425 -- The latter is important; the binder may already be in the
426 -- in-scope set (although it might also have been created with newId)
427 -- but it may now have more IdInfo
429 = id `seq` -- This seq forces the Id, and hence its IdInfo,
430 -- and hence any inner substitutions
431 env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
432 seInScope = extendInScopeSet (seInScope env) id }
434 extendFloats :: SimplEnv -> OutBind -> SimplEnv
435 -- Add these bindings to the floats, and extend the in-scope env too
436 extendFloats env bind
437 = env { seFloats = seFloats env `addFlts` unitFloat bind,
438 seInScope = extendInScopeSetList (seInScope env) bndrs }
440 bndrs = bindersOf bind
442 addFloats :: SimplEnv -> SimplEnv -> SimplEnv
443 -- Add the floats for env2 to env1;
444 -- *plus* the in-scope set for env2, which is bigger
445 -- than that for env1
447 = env1 {seFloats = seFloats env1 `addFlts` seFloats env2,
448 seInScope = seInScope env2 }
450 addFlts :: Floats -> Floats -> Floats
451 addFlts (Floats bs1 l1) (Floats bs2 l2)
452 = Floats (bs1 `appOL` bs2) (l1 `andFF` l2)
454 zapFloats :: SimplEnv -> SimplEnv
455 zapFloats env = env { seFloats = emptyFloats }
457 addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
458 -- Flattens the floats from env2 into a single Rec group,
459 -- prepends the floats from env1, and puts the result back in env2
460 -- This is all very specific to the way recursive bindings are
461 -- handled; see Simplify.simplRecBind
462 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
463 = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )
464 env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
466 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
467 wrapFloats env expr = wrapFlts (seFloats env) expr
469 wrapFlts :: Floats -> OutExpr -> OutExpr
470 -- Wrap the floats around the expression, using case-binding where necessary
471 wrapFlts (Floats bs _) body = foldrOL wrap body bs
473 wrap (Rec prs) body = Let (Rec prs) body
474 wrap (NonRec b r) body = bindNonRec b r body
476 getFloats :: SimplEnv -> [CoreBind]
477 getFloats (SimplEnv {seFloats = Floats bs _}) = fromOL bs
479 isEmptyFloats :: SimplEnv -> Bool
480 isEmptyFloats env = isEmptyFlts (seFloats env)
482 isEmptyFlts :: Floats -> Bool
483 isEmptyFlts (Floats bs _) = isNilOL bs
485 floatBinds :: Floats -> [OutBind]
486 floatBinds (Floats bs _) = fromOL bs
490 %************************************************************************
494 %************************************************************************
496 Note [Global Ids in the substitution]
497 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
498 We look up even a global (eg imported) Id in the substitution. Consider
499 case X.g_34 of b { (a,b) -> ... case X.g_34 of { (p,q) -> ...} ... }
500 The binder-swap in the occurence analyser will add a binding
501 for a LocalId version of g (with the same unique though):
502 case X.g_34 of b { (a,b) -> let g_34 = b in
503 ... case X.g_34 of { (p,q) -> ...} ... }
504 So we want to look up the inner X.g_34 in the substitution, where we'll
505 find that it has been substituted by b. (Or conceivably cloned.)
508 substId :: SimplEnv -> InId -> SimplSR
509 -- Returns DoneEx only on a non-Var expression
510 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
511 = case lookupVarEnv ids v of -- Note [Global Ids in the substitution]
512 Nothing -> DoneId (refine in_scope v)
513 Just (DoneId v) -> DoneId (refine in_scope v)
514 Just (DoneEx (Var v)) -> DoneId (refine in_scope v)
515 Just res -> res -- DoneEx non-var, or ContEx
517 -- Get the most up-to-date thing from the in-scope set
518 -- Even though it isn't in the substitution, it may be in
519 -- the in-scope set with better IdInfo
520 refine :: InScopeSet -> Var -> Var
522 | isLocalId v = case lookupInScope in_scope v of
524 Nothing -> WARN( True, ppr v ) v -- This is an error!
527 lookupRecBndr :: SimplEnv -> InId -> OutId
528 -- Look up an Id which has been put into the envt by simplRecBndrs,
529 -- but where we have not yet done its RHS
530 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
531 = case lookupVarEnv ids v of
533 Just _ -> pprPanic "lookupRecBndr" (ppr v)
534 Nothing -> refine in_scope v
538 %************************************************************************
540 \section{Substituting an Id binder}
542 %************************************************************************
545 These functions are in the monad only so that they can be made strict via seq.
548 simplBinders, simplLamBndrs
549 :: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
550 simplBinders env bndrs = mapAccumLM simplBinder env bndrs
551 simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
554 simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
555 -- Used for lambda and case-bound variables
556 -- Clone Id if necessary, substitute type
557 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
558 -- The substitution is extended only if the variable is cloned, because
559 -- we *don't* need to use it to track occurrence info.
561 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
562 ; seqTyVar tv `seq` return (env', tv) }
563 | isCoVar bndr = do { let (env', tv) = substCoVarBndr env bndr
564 ; seqId tv `seq` return (env', tv) }
565 | otherwise = do { let (env', id) = substIdBndr env bndr
566 ; seqId id `seq` return (env', id) }
569 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
570 -- Used for lambda binders. These sometimes have unfoldings added by
571 -- the worker/wrapper pass that must be preserved, because they can't
572 -- be reconstructed from context. For example:
573 -- f x = case x of (a,b) -> fw a b x
574 -- fw a b x{=(a,b)} = ...
575 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
576 simplLamBndr env bndr
577 | isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
578 | otherwise = simplBinder env bndr -- Normal case
580 old_unf = idUnfolding bndr
581 (env1, id1) = substIdBndr env bndr
582 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
583 env2 = modifyInScope env1 id2
586 simplNonRecBndr :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
587 -- A non-recursive let binder
588 simplNonRecBndr env id
589 = do { let (env1, id1) = substIdBndr env id
590 ; seqId id1 `seq` return (env1, id1) }
593 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
594 -- Recursive let binders
595 simplRecBndrs env@(SimplEnv {}) ids
596 = do { let (env1, ids1) = mapAccumL substIdBndr env ids
597 ; seqIds ids1 `seq` return env1 }
600 substIdBndr :: SimplEnv
601 -> InBndr -- Env and binder to transform
602 -> (SimplEnv, OutBndr)
603 -- Clone Id if necessary, substitute its type
604 -- Return an Id with its
605 -- * Type substituted
606 -- * UnfoldingInfo, Rules, WorkerInfo zapped
607 -- * Fragile OccInfo (only) zapped: Note [Robust OccInfo]
608 -- * Robust info, retained especially arity and demand info,
609 -- so that they are available to occurrences that occur in an
610 -- earlier binding of a letrec
612 -- For the robust info, see Note [Arity robustness]
614 -- Augment the substitution if the unique changed
615 -- Extend the in-scope set with the new Id
617 -- Similar to CoreSubst.substIdBndr, except that
618 -- the type of id_subst differs
619 -- all fragile info is zapped
621 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst })
623 = (env { seInScope = in_scope `extendInScopeSet` new_id,
624 seIdSubst = new_subst }, new_id)
626 id1 = uniqAway in_scope old_id
627 id2 = substIdType env id1
628 new_id = zapFragileIdInfo id2 -- Zaps rules, worker-info, unfolding
629 -- and fragile OccInfo
631 -- Extend the substitution if the unique has changed,
632 -- or there's some useful occurrence information
633 -- See the notes with substTyVarBndr for the delSubstEnv
634 new_subst | new_id /= old_id
635 = extendVarEnv id_subst old_id (DoneId new_id)
637 = delVarEnv id_subst old_id
641 ------------------------------------
642 seqTyVar :: TyVar -> ()
643 seqTyVar b = b `seq` ()
646 seqId id = seqType (idType id) `seq`
652 seqIds (id:ids) = seqId id `seq` seqIds ids
656 Note [Arity robustness]
657 ~~~~~~~~~~~~~~~~~~~~~~~
658 We *do* transfer the arity from from the in_id of a let binding to the
659 out_id. This is important, so that the arity of an Id is visible in
660 its own RHS. For example:
661 f = \x. ....g (\y. f y)....
662 We can eta-reduce the arg to g, becuase f is a value. But that
665 This interacts with the 'state hack' too:
670 Can we eta-expand f? Only if we see that f has arity 1, and then we
671 take advantage of the 'state hack' on the result of
672 (f y) :: State# -> (State#, Int) to expand the arity one more.
674 There is a disadvantage though. Making the arity visible in the RHS
675 allows us to eta-reduce
679 which technically is not sound. This is very much a corner case, so
680 I'm not worried about it. Another idea is to ensure that f's arity
681 never decreases; its arity started as 1, and we should never eta-reduce
685 Note [Robust OccInfo]
686 ~~~~~~~~~~~~~~~~~~~~~
687 It's important that we *do* retain the loop-breaker OccInfo, because
688 that's what stops the Id getting inlined infinitely, in the body of
692 Note [Rules in a letrec]
693 ~~~~~~~~~~~~~~~~~~~~~~~~
694 After creating fresh binders for the binders of a letrec, we
695 substitute the RULES and add them back onto the binders; this is done
696 *before* processing any of the RHSs. This is important. Manuel found
697 cases where he really, really wanted a RULE for a recursive function
698 to apply in that function's own right-hand side.
700 See Note [Loop breaking and RULES] in OccAnal.
704 addBndrRules :: SimplEnv -> InBndr -> OutBndr -> (SimplEnv, OutBndr)
705 -- Rules are added back in to to the bin
706 addBndrRules env in_id out_id
707 | isEmptySpecInfo old_rules = (env, out_id)
708 | otherwise = (modifyInScope env final_id, final_id)
710 subst = mkCoreSubst (text "local rules") env
711 old_rules = idSpecialisation in_id
712 new_rules = CoreSubst.substSpec subst out_id old_rules
713 final_id = out_id `setIdSpecialisation` new_rules
717 %************************************************************************
719 Impedence matching to type substitution
721 %************************************************************************
724 getTvSubst :: SimplEnv -> TvSubst
725 getTvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env })
726 = mkTvSubst in_scope tv_env
728 getCvSubst :: SimplEnv -> CvSubst
729 getCvSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env })
730 = CvSubst in_scope tv_env cv_env
732 substTy :: SimplEnv -> Type -> Type
733 substTy env ty = Type.substTy (getTvSubst env) ty
735 substTyVar :: SimplEnv -> TyVar -> Type
736 substTyVar env tv = Type.substTyVar (getTvSubst env) tv
738 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
739 substTyVarBndr env tv
740 = case Type.substTyVarBndr (getTvSubst env) tv of
741 (TvSubst in_scope' tv_env', tv')
742 -> (env { seInScope = in_scope', seTvSubst = tv_env' }, tv')
744 substCoVar :: SimplEnv -> CoVar -> Coercion
745 substCoVar env tv = Coercion.substCoVar (getCvSubst env) tv
747 substCoVarBndr :: SimplEnv -> CoVar -> (SimplEnv, CoVar)
748 substCoVarBndr env cv
749 = case Coercion.substCoVarBndr (getCvSubst env) cv of
750 (CvSubst in_scope' tv_env' cv_env', cv')
751 -> (env { seInScope = in_scope', seTvSubst = tv_env', seCvSubst = cv_env' }, cv')
753 substCo :: SimplEnv -> Coercion -> Coercion
754 substCo env co = Coercion.substCo (getCvSubst env) co
756 -- When substituting in rules etc we can get CoreSubst to do the work
757 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
758 -- here. I think the this will not usually result in a lot of work;
759 -- the substitutions are typically small, and laziness will avoid work in many cases.
761 mkCoreSubst :: SDoc -> SimplEnv -> CoreSubst.Subst
762 mkCoreSubst doc (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seCvSubst = cv_env, seIdSubst = id_env })
763 = mk_subst tv_env cv_env id_env
765 mk_subst tv_env cv_env id_env = CoreSubst.mkSubst in_scope tv_env cv_env (mapVarEnv fiddle id_env)
767 fiddle (DoneEx e) = e
768 fiddle (DoneId v) = Var v
769 fiddle (ContEx tv cv id e) = CoreSubst.substExpr (text "mkCoreSubst" <+> doc) (mk_subst tv cv id) e
770 -- Don't shortcut here
773 substIdType :: SimplEnv -> Id -> Id
774 substIdType (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) id
775 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
776 | otherwise = Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
777 -- The tyVarsOfType is cheaper than it looks
778 -- because we cache the free tyvars of the type
779 -- in a Note in the id's type itself
784 substExpr :: SDoc -> SimplEnv -> CoreExpr -> CoreExpr
786 = CoreSubst.substExpr (text "SimplEnv.substExpr1" <+> doc)
787 (mkCoreSubst (text "SimplEnv.substExpr2" <+> doc) env)
788 -- Do *not* short-cut in the case of an empty substitution
789 -- See Note [SimplEnv invariants]
791 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
792 substUnfolding env unf = CoreSubst.substUnfolding (mkCoreSubst (text "subst-unfolding") env) unf
793 -- Do *not* short-cut in the case of an empty substitution
794 -- See Note [SimplEnv invariants]