2 % (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[SimplMonad]{The simplifier Monad}
8 InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
9 OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
10 InCoercion, OutCoercion,
12 -- The simplifier mode
16 SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
17 isAmongSimpl, intSwitchSet, switchIsOn,
19 setEnclosingCC, getEnclosingCC,
22 SimplEnv, mkSimplEnv, extendIdSubst, extendTvSubst,
23 zapSubstEnv, setSubstEnv,
24 getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
27 SimplSR(..), mkContEx, substId,
29 simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs,
30 simplBinder, simplBinders, addLetIdInfo,
34 FloatsWith, FloatsWithExpr,
35 Floats, emptyFloats, isEmptyFloats, unitFloat, addFloats, flattenFloats,
36 allLifted, wrapFloats, floatBinds,
40 #include "HsVersions.h"
43 import Id ( Id, idType, idOccInfo, idUnfolding, setIdUnfolding )
44 import IdInfo ( IdInfo, vanillaIdInfo, occInfo, setOccInfo, specInfo, setSpecInfo,
45 arityInfo, setArityInfo, workerInfo, setWorkerInfo,
46 unfoldingInfo, setUnfoldingInfo, isEmptySpecInfo,
47 unknownArity, workerExists
50 import Rules ( RuleBase )
51 import CoreUtils ( needsCaseBinding )
52 import CostCentre ( CostCentreStack, subsumedCCS )
55 import VarSet ( isEmptyVarSet )
58 import qualified CoreSubst ( Subst, mkSubst, substExpr, substSpec, substWorker )
59 import qualified Type ( substTy, substTyVarBndr )
61 import Type ( Type, TvSubst(..), TvSubstEnv, composeTvSubst,
62 isUnLiftedType, seqType, tyVarsOfType )
63 import Coercion ( Coercion )
64 import BasicTypes ( OccInfo(..), isFragileOcc )
65 import DynFlags ( SimplifierMode(..) )
66 import Util ( mapAccumL )
70 %************************************************************************
72 \subsection[Simplify-types]{Type declarations}
74 %************************************************************************
77 type InBinder = CoreBndr
78 type InId = Id -- Not yet cloned
79 type InType = Type -- Ditto
80 type InBind = CoreBind
81 type InExpr = CoreExpr
84 type InCoercion = Coercion
86 type OutBinder = CoreBndr
87 type OutId = Id -- Cloned
88 type OutTyVar = TyVar -- Cloned
89 type OutType = Type -- Cloned
90 type OutCoercion = Coercion
91 type OutBind = CoreBind
92 type OutExpr = CoreExpr
97 %************************************************************************
99 \subsubsection{The @SimplEnv@ type}
101 %************************************************************************
107 seMode :: SimplifierMode,
108 seChkr :: SwitchChecker,
109 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
111 -- Rules from other modules
112 seExtRules :: RuleBase,
114 -- The current set of in-scope variables
115 -- They are all OutVars, and all bound in this module
116 seInScope :: InScopeSet, -- OutVars only
118 -- The current substitution
119 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
120 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
123 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
126 = DoneEx OutExpr -- Completed term
127 | DoneId OutId OccInfo -- Completed term variable, with occurrence info
128 | ContEx TvSubstEnv -- A suspended substitution
135 The in-scope part of Subst includes *all* in-scope TyVars and Ids
136 The elements of the set may have better IdInfo than the
137 occurrences of in-scope Ids, and (more important) they will
138 have a correctly-substituted type. So we use a lookup in this
139 set to replace occurrences
141 The Ids in the InScopeSet are replete with their Rules,
142 and as we gather info about the unfolding of an Id, we replace
143 it in the in-scope set.
145 The in-scope set is actually a mapping OutVar -> OutVar, and
146 in case expressions we sometimes bind
149 The substitution is *apply-once* only, because InIds and OutIds can overlap.
150 For example, we generally omit mappings
152 from the substitution, when we decide not to clone a77, but it's quite
153 legitimate to put the mapping in the substitution anyway.
155 Indeed, we do so when we want to pass fragile OccInfo to the
156 occurrences of the variable; we add a substitution
157 x77 -> DoneId x77 occ
158 to record x's occurrence information.]
160 Furthermore, consider
161 let x = case k of I# x77 -> ... in
162 let y = case k of I# x77 -> ... in ...
163 and suppose the body is strict in both x and y. Then the simplifier
164 will pull the first (case k) to the top; so the second (case k) will
165 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
168 Of course, the substitution *must* applied! Things in its domain
169 simply aren't necessarily bound in the result.
171 * substId adds a binding (DoneId new_id occ) to the substitution if
172 EITHER the Id's unique has changed
173 OR the Id has interesting occurrence information
174 So in effect you can only get to interesting occurrence information
175 by looking up the *old* Id; it's not really attached to the new id
178 Note, though that the substitution isn't necessarily extended
179 if the type changes. Why not? Because of the next point:
181 * We *always, always* finish by looking up in the in-scope set
182 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
183 Reason: so that we never finish up with a "old" Id in the result.
184 An old Id might point to an old unfolding and so on... which gives a space leak.
186 [The DoneEx and DoneVar hits map to "new" stuff.]
188 * It follows that substExpr must not do a no-op if the substitution is empty.
189 substType is free to do so, however.
191 * When we come to a let-binding (say) we generate new IdInfo, including an
192 unfolding, attach it to the binder, and add this newly adorned binder to
193 the in-scope set. So all subsequent occurrences of the binder will get mapped
194 to the full-adorned binder, which is also the one put in the binding site.
196 * The in-scope "set" usually maps x->x; we use it simply for its domain.
197 But sometimes we have two in-scope Ids that are synomyms, and should
198 map to the same target: x->x, y->x. Notably:
200 That's why the "set" is actually a VarEnv Var
204 mkSimplEnv :: SimplifierMode -> SwitchChecker -> RuleBase -> SimplEnv
205 mkSimplEnv mode switches rules
206 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
207 seMode = mode, seInScope = emptyInScopeSet,
209 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
210 -- The top level "enclosing CC" is "SUBSUMED".
212 ---------------------
213 getSwitchChecker :: SimplEnv -> SwitchChecker
214 getSwitchChecker env = seChkr env
216 ---------------------
217 getMode :: SimplEnv -> SimplifierMode
218 getMode env = seMode env
220 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
221 setMode mode env = env { seMode = mode }
223 ---------------------
224 getEnclosingCC :: SimplEnv -> CostCentreStack
225 getEnclosingCC env = seCC env
227 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
228 setEnclosingCC env cc = env {seCC = cc}
230 ---------------------
231 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
232 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
233 = env {seIdSubst = extendVarEnv subst var res}
235 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
236 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
237 = env {seTvSubst = extendVarEnv subst var res}
239 ---------------------
240 getInScope :: SimplEnv -> InScopeSet
241 getInScope env = seInScope env
243 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
244 setInScopeSet env in_scope = env {seInScope = in_scope}
246 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
247 setInScope env env_with_in_scope = setInScopeSet env (getInScope env_with_in_scope)
249 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
250 -- The new Ids are guaranteed to be freshly allocated
251 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
252 = env { seInScope = in_scope `extendInScopeSetList` vs,
253 seIdSubst = id_subst `delVarEnvList` vs }
254 -- Why delete? Consider
255 -- let x = a*b in (x, \x -> x+3)
256 -- We add [x |-> a*b] to the substitution, but we must
257 -- *delete* it from the substitution when going inside
260 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
261 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
262 = env {seInScope = modifyInScopeSet in_scope v v'}
264 ---------------------
265 zapSubstEnv :: SimplEnv -> SimplEnv
266 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
268 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
269 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
271 mkContEx :: SimplEnv -> InExpr -> SimplSR
272 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
274 isEmptySimplSubst :: SimplEnv -> Bool
275 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
276 = isEmptyVarEnv tvs && isEmptyVarEnv ids
278 ---------------------
279 getRules :: SimplEnv -> RuleBase
280 getRules = seExtRules
284 %************************************************************************
288 %************************************************************************
292 substId :: SimplEnv -> Id -> SimplSR
293 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
296 | otherwise -- A local Id
297 = case lookupVarEnv ids v of
298 Just (DoneId v occ) -> DoneId (refine v) occ
300 Nothing -> let v' = refine v
301 in DoneId v' (idOccInfo v')
302 -- We don't put LoopBreakers in the substitution (unless then need
303 -- to be cloned for name-clash rasons), so the idOccInfo is
304 -- very important! If isFragileOcc returned True for
305 -- loop breakers we could avoid this call, but at the expense
306 -- of adding more to the substitution, and building new Ids
307 -- a bit more often than really necessary
309 -- Get the most up-to-date thing from the in-scope set
310 -- Even though it isn't in the substitution, it may be in
311 -- the in-scope set better IdInfo
312 refine v = case lookupInScope in_scope v of
314 Nothing -> WARN( True, ppr v ) v -- This is an error!
318 %************************************************************************
320 \section{Substituting an Id binder}
322 %************************************************************************
325 These functions are in the monad only so that they can be made strict via seq.
328 simplBinders, simplLamBndrs
329 :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
330 simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
331 simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
334 simplBinder :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
335 -- Used for lambda and case-bound variables
336 -- Clone Id if necessary, substitute type
337 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
338 -- The substitution is extended only if the variable is cloned, because
339 -- we *don't* need to use it to track occurrence info.
341 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
342 ; seqTyVar tv `seq` return (env', tv) }
343 | otherwise = do { let (env', id) = substIdBndr env bndr
344 ; seqId id `seq` return (env', id) }
347 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
348 -- Used for lambda binders. These sometimes have unfoldings added by
349 -- the worker/wrapper pass that must be preserved, becuase they can't
350 -- be reconstructed from context. For example:
351 -- f x = case x of (a,b) -> fw a b x
352 -- fw a b x{=(a,b)} = ...
353 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
354 simplLamBndr env bndr
355 | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr -- Normal case
356 | otherwise = seqId id2 `seq` return (env', id2)
358 old_unf = idUnfolding bndr
359 (env', id1) = substIdBndr env bndr
360 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
363 substIdBndr :: SimplEnv -> Id -- Substitition and Id to transform
364 -> (SimplEnv, Id) -- Transformed pair
367 -- * Unique changed if necessary
368 -- * Type substituted
369 -- * Unfolding zapped
370 -- * Rules, worker, lbvar info all substituted
371 -- * Fragile occurrence info zapped
372 -- * The in-scope set extended with the returned Id
373 -- * The substitution extended with a DoneId if unique changed
374 -- In this case, the var in the DoneId is the same as the
377 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
379 = (env { seInScope = in_scope `extendInScopeSet` new_id,
380 seIdSubst = new_subst }, new_id)
382 -- id1 is cloned if necessary
383 id1 = uniqAway in_scope old_id
385 -- id2 has its type zapped
386 id2 = substIdType env id1
388 -- new_id has the final IdInfo
389 subst = mkCoreSubst env
390 new_id = maybeModifyIdInfo (substIdInfo subst (idInfo old_id)) id2
392 -- Extend the substitution if the unique has changed
393 -- See the notes with substTyVarBndr for the delSubstEnv
394 new_subst | new_id /= old_id
395 = extendVarEnv id_subst old_id (DoneId new_id (idOccInfo old_id))
397 = delVarEnv id_subst old_id
402 seqTyVar :: TyVar -> ()
403 seqTyVar b = b `seq` ()
406 seqId id = seqType (idType id) `seq`
412 seqIds (id:ids) = seqId id `seq` seqIds ids
416 %************************************************************************
420 %************************************************************************
422 Simplifying let binders
423 ~~~~~~~~~~~~~~~~~~~~~~~
424 Rename the binders if necessary,
427 simplNonRecBndr :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
428 simplNonRecBndr env id
429 = do { let (env1, id1) = substLetIdBndr env id
430 ; seqId id1 `seq` return (env1, id1) }
433 simplRecBndrs :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
434 simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
435 = do { let (env1, ids1) = mapAccumL substLetIdBndr env ids
436 ; seqIds ids1 `seq` return (env1, ids1) }
439 substLetIdBndr :: SimplEnv -> InBinder -- Env and binder to transform
440 -> (SimplEnv, OutBinder)
441 -- C.f. CoreSubst.substIdBndr
442 -- Clone Id if necessary, substitute its type
443 -- Return an Id with completely zapped IdInfo
444 -- [addLetIdInfo, below, will restore its IdInfo]
445 -- Augment the subtitution
446 -- if the unique changed, *or*
447 -- if there's interesting occurrence info
449 substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
450 = (env { seInScope = in_scope `extendInScopeSet` new_id,
451 seIdSubst = new_subst }, new_id)
453 id1 = uniqAway in_scope old_id
454 id2 = substIdType env id1
455 new_id = setIdInfo id2 vanillaIdInfo
457 -- Extend the substitution if the unique has changed,
458 -- or there's some useful occurrence information
459 -- See the notes with substTyVarBndr for the delSubstEnv
460 occ_info = occInfo (idInfo old_id)
461 new_subst | new_id /= old_id || isFragileOcc occ_info
462 = extendVarEnv id_subst old_id (DoneId new_id occ_info)
464 = delVarEnv id_subst old_id
467 Add IdInfo back onto a let-bound Id
468 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
469 We must transfer the IdInfo of the original binder to the new binder.
470 This is crucial, to preserve
474 etc. To do this we must apply the current substitution,
475 which incorporates earlier substitutions in this very letrec group.
477 NB 1. We do this *before* processing the RHS of the binder, so that
478 its substituted rules are visible in its own RHS.
479 This is important. Manuel found cases where he really, really
480 wanted a RULE for a recursive function to apply in that function's
483 NB 2: ARITY. We *do* transfer the arity. This is important, so that
484 the arity of an Id is visible in its own RHS. For example:
485 f = \x. ....g (\y. f y)....
486 We can eta-reduce the arg to g, becuase f is a value. But that
489 This interacts with the 'state hack' too:
494 Can we eta-expand f? Only if we see that f has arity 1, and then we
495 take advantage of the 'state hack' on the result of
496 (f y) :: State# -> (State#, Int) to expand the arity one more.
498 There is a disadvantage though. Making the arity visible in the RHA
499 allows us to eta-reduce
503 which technically is not sound. This is very much a corner case, so
504 I'm not worried about it. Another idea is to ensure that f's arity
505 never decreases; its arity started as 1, and we should never eta-reduce
508 NB 3: OccInfo. It's important that we *do* transer the loop-breaker
509 OccInfo, because that's what stops the Id getting inlined infinitely,
510 in the body of the letrec.
512 NB 4: does no harm for non-recursive bindings
514 NB 5: we can't do the addLetIdInfo part before *all* the RHSs because
519 Here, we'll do postInlineUnconditionally on f, and we must "see" that
520 when substituting in h's RULE.
523 addLetIdInfo :: SimplEnv -> InBinder -> OutBinder -> (SimplEnv, OutBinder)
524 addLetIdInfo env in_id out_id
525 = (modifyInScope env out_id final_id, final_id)
527 final_id = out_id `setIdInfo` new_info
528 subst = mkCoreSubst env
529 old_info = idInfo in_id
530 new_info = case substIdInfo subst old_info of
532 Just new_info -> new_info
534 substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
539 -- Keep only 'robust' OccInfo
542 -- Seq'ing on the returned IdInfo is enough to cause all the
543 -- substitutions to happen completely
545 substIdInfo subst info
546 | nothing_to_do = Nothing
547 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
548 `setSpecInfo` CoreSubst.substSpec subst old_rules
549 `setWorkerInfo` CoreSubst.substWorker subst old_wrkr
550 `setUnfoldingInfo` noUnfolding)
551 -- setSpecInfo does a seq
552 -- setWorkerInfo does a seq
554 nothing_to_do = keep_occ &&
555 isEmptySpecInfo old_rules &&
556 not (workerExists old_wrkr) &&
557 not (hasUnfolding (unfoldingInfo info))
559 keep_occ = not (isFragileOcc old_occ)
560 old_arity = arityInfo info
561 old_occ = occInfo info
562 old_rules = specInfo info
563 old_wrkr = workerInfo info
566 substIdType :: SimplEnv -> Id -> Id
567 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
568 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
569 | otherwise = setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
570 -- The tyVarsOfType is cheaper than it looks
571 -- because we cache the free tyvars of the type
572 -- in a Note in the id's type itself
577 substUnfolding env NoUnfolding = NoUnfolding
578 substUnfolding env (OtherCon cons) = OtherCon cons
579 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
580 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
584 %************************************************************************
586 Impedence matching to type substitution
588 %************************************************************************
591 substTy :: SimplEnv -> Type -> Type
592 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
593 = Type.substTy (TvSubst in_scope tv_env) ty
595 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
596 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
597 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
598 (TvSubst in_scope' tv_env', tv')
599 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
601 -- When substituting in rules etc we can get CoreSubst to do the work
602 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
603 -- here. I think the this will not usually result in a lot of work;
604 -- the substitutions are typically small, and laziness will avoid work in many cases.
606 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
607 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
608 = mk_subst tv_env id_env
610 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
612 fiddle (DoneEx e) = e
613 fiddle (DoneId v occ) = Var v
614 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
616 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
618 | isEmptySimplSubst env = expr
619 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr
623 %************************************************************************
627 %************************************************************************
630 type FloatsWithExpr = FloatsWith OutExpr
631 type FloatsWith a = (Floats, a)
632 -- We return something equivalent to (let b in e), but
633 -- in pieces to avoid the quadratic blowup when floating
634 -- incrementally. Comments just before simplExprB in Simplify.lhs
636 data Floats = Floats (OrdList OutBind)
637 InScopeSet -- Environment "inside" all the floats
638 Bool -- True <=> All bindings are lifted
640 allLifted :: Floats -> Bool
641 allLifted (Floats _ _ is_lifted) = is_lifted
643 wrapFloats :: Floats -> OutExpr -> OutExpr
644 wrapFloats (Floats bs _ _) body = foldrOL Let body bs
646 isEmptyFloats :: Floats -> Bool
647 isEmptyFloats (Floats bs _ _) = isNilOL bs
649 floatBinds :: Floats -> [OutBind]
650 floatBinds (Floats bs _ _) = fromOL bs
652 flattenFloats :: Floats -> Floats
653 -- Flattens into a single Rec group
654 flattenFloats (Floats bs is is_lifted)
655 = ASSERT2( is_lifted, ppr (fromOL bs) )
656 Floats (unitOL (Rec (flattenBinds (fromOL bs)))) is is_lifted
660 emptyFloats :: SimplEnv -> Floats
661 emptyFloats env = Floats nilOL (getInScope env) True
663 unitFloat :: SimplEnv -> OutId -> OutExpr -> Floats
664 -- A single non-rec float; extend the in-scope set
665 unitFloat env var rhs = Floats (unitOL (NonRec var rhs))
666 (extendInScopeSet (getInScope env) var)
667 (not (isUnLiftedType (idType var)))
669 addFloats :: SimplEnv -> Floats
670 -> (SimplEnv -> SimplM (FloatsWith a))
671 -> SimplM (FloatsWith a)
672 addFloats env (Floats b1 is1 l1) thing_inside
676 = thing_inside (setInScopeSet env is1) `thenSmpl` \ (Floats b2 is2 l2, res) ->
677 returnSmpl (Floats (b1 `appOL` b2) is2 (l1 && l2), res)
679 addLetBind :: OutBind -> Floats -> Floats
680 addLetBind bind (Floats binds in_scope lifted)
681 = Floats (bind `consOL` binds) in_scope (lifted && is_lifted_bind bind)
683 is_lifted_bind (Rec _) = True
684 is_lifted_bind (NonRec b r) = not (isUnLiftedType (idType b))
686 -- addAuxiliaryBind * takes already-simplified things (bndr and rhs)
687 -- * extends the in-scope env
688 -- * assumes it's a let-bindable thing
689 addAuxiliaryBind :: SimplEnv -> OutBind
690 -> (SimplEnv -> SimplM (FloatsWith a))
691 -> SimplM (FloatsWith a)
692 -- Extends the in-scope environment as well as wrapping the bindings
693 addAuxiliaryBind env bind thing_inside
694 = ASSERT( case bind of { NonRec b r -> not (needsCaseBinding (idType b) r) ; Rec _ -> True } )
695 thing_inside (addNewInScopeIds env (bindersOf bind)) `thenSmpl` \ (floats, x) ->
696 returnSmpl (addLetBind bind floats, x)