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,
11 -- The simplifier mode
15 SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
16 isAmongSimpl, intSwitchSet, switchIsOn,
18 setEnclosingCC, getEnclosingCC,
21 SimplEnv, mkSimplEnv, extendIdSubst, extendTvSubst,
22 zapSubstEnv, setSubstEnv,
23 getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
24 getRules, refineSimplEnv,
26 SimplSR(..), mkContEx, substId,
28 simplLetBndr, simplLetBndrs, simplLamBndr, simplLamBndrs,
29 simplBinder, simplBinders,
30 simplIdInfo, substExpr, substTy,
33 FloatsWith, FloatsWithExpr,
34 Floats, emptyFloats, isEmptyFloats, unitFloat, addFloats, flattenFloats,
35 allLifted, wrapFloats, floatBinds,
39 #include "HsVersions.h"
42 import Id ( Id, idType, idOccInfo, idUnfolding, setIdUnfolding )
43 import IdInfo ( IdInfo, vanillaIdInfo, occInfo, setOccInfo, specInfo, setSpecInfo,
44 arityInfo, setArityInfo, workerInfo, setWorkerInfo,
45 unfoldingInfo, setUnfoldingInfo, isEmptySpecInfo,
46 unknownArity, workerExists
49 import Unify ( TypeRefinement )
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 BasicTypes ( OccInfo(..), isFragileOcc )
64 import DynFlags ( SimplifierMode(..) )
68 %************************************************************************
70 \subsection[Simplify-types]{Type declarations}
72 %************************************************************************
75 type InBinder = CoreBndr
76 type InId = Id -- Not yet cloned
77 type InType = Type -- Ditto
78 type InBind = CoreBind
79 type InExpr = CoreExpr
83 type OutBinder = CoreBndr
84 type OutId = Id -- Cloned
85 type OutTyVar = TyVar -- Cloned
86 type OutType = Type -- Cloned
87 type OutBind = CoreBind
88 type OutExpr = CoreExpr
93 %************************************************************************
95 \subsubsection{The @SimplEnv@ type}
97 %************************************************************************
103 seMode :: SimplifierMode,
104 seChkr :: SwitchChecker,
105 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
107 -- Rules from other modules
108 seExtRules :: RuleBase,
110 -- The current set of in-scope variables
111 -- They are all OutVars, and all bound in this module
112 seInScope :: InScopeSet, -- OutVars only
114 -- The current substitution
115 seTvSubst :: TvSubstEnv, -- InTyVar |--> OutType
116 seIdSubst :: SimplIdSubst -- InId |--> OutExpr
119 type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
122 = DoneEx OutExpr -- Completed term
123 | DoneId OutId OccInfo -- Completed term variable, with occurrence info
124 | ContEx TvSubstEnv -- A suspended substitution
131 The in-scope part of Subst includes *all* in-scope TyVars and Ids
132 The elements of the set may have better IdInfo than the
133 occurrences of in-scope Ids, and (more important) they will
134 have a correctly-substituted type. So we use a lookup in this
135 set to replace occurrences
137 The Ids in the InScopeSet are replete with their Rules,
138 and as we gather info about the unfolding of an Id, we replace
139 it in the in-scope set.
141 The in-scope set is actually a mapping OutVar -> OutVar, and
142 in case expressions we sometimes bind
145 The substitution is *apply-once* only, because InIds and OutIds can overlap.
146 For example, we generally omit mappings
148 from the substitution, when we decide not to clone a77, but it's quite
149 legitimate to put the mapping in the substitution anyway.
151 Indeed, we do so when we want to pass fragile OccInfo to the
152 occurrences of the variable; we add a substitution
153 x77 -> DoneId x77 occ
154 to record x's occurrence information.]
156 Furthermore, consider
157 let x = case k of I# x77 -> ... in
158 let y = case k of I# x77 -> ... in ...
159 and suppose the body is strict in both x and y. Then the simplifier
160 will pull the first (case k) to the top; so the second (case k) will
161 cancel out, mapping x77 to, well, x77! But one is an in-Id and the
164 Of course, the substitution *must* applied! Things in its domain
165 simply aren't necessarily bound in the result.
167 * substId adds a binding (DoneId new_id occ) to the substitution if
168 EITHER the Id's unique has changed
169 OR the Id has interesting occurrence information
170 So in effect you can only get to interesting occurrence information
171 by looking up the *old* Id; it's not really attached to the new id
174 Note, though that the substitution isn't necessarily extended
175 if the type changes. Why not? Because of the next point:
177 * We *always, always* finish by looking up in the in-scope set
178 any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
179 Reason: so that we never finish up with a "old" Id in the result.
180 An old Id might point to an old unfolding and so on... which gives a space leak.
182 [The DoneEx and DoneVar hits map to "new" stuff.]
184 * It follows that substExpr must not do a no-op if the substitution is empty.
185 substType is free to do so, however.
187 * When we come to a let-binding (say) we generate new IdInfo, including an
188 unfolding, attach it to the binder, and add this newly adorned binder to
189 the in-scope set. So all subsequent occurrences of the binder will get mapped
190 to the full-adorned binder, which is also the one put in the binding site.
192 * The in-scope "set" usually maps x->x; we use it simply for its domain.
193 But sometimes we have two in-scope Ids that are synomyms, and should
194 map to the same target: x->x, y->x. Notably:
196 That's why the "set" is actually a VarEnv Var
199 Note [GADT type refinement]
200 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
201 When we come to a GADT pattern match that refines the in-scope types, we
202 a) Refine the types of the Ids in the in-scope set, seInScope.
203 For exmaple, consider
205 Foo :: T (Bool -> Bool)
207 (\ (x::T a) (y::a) -> case x of { Foo -> y True }
209 Technically this is well-typed, but exprType will barf on the
210 (y True) unless we refine the type on y's occurrence.
212 b) Refine the range of the type substitution, seTvSubst.
213 Very similar reason to (a).
215 NB: we don't refine the range of the SimplIdSubst, because it's always
216 interpreted relative to the seInScope (see substId)
218 For (b) we need to be a little careful. Specifically, we compose the refinement
219 with the type substitution. Suppose
220 The substitution was [a->b, b->a]
221 and the refinement was [b->Int]
222 Then we want [a->Int, b->a]
225 The substitution was [a->b]
226 and the refinement was [b->Int]
227 Then we want [a->Int, b->Int]
228 becuase b might be both an InTyVar and OutTyVar
232 mkSimplEnv :: SimplifierMode -> SwitchChecker -> RuleBase -> SimplEnv
233 mkSimplEnv mode switches rules
234 = SimplEnv { seChkr = switches, seCC = subsumedCCS,
235 seMode = mode, seInScope = emptyInScopeSet,
237 seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
238 -- The top level "enclosing CC" is "SUBSUMED".
240 ---------------------
241 getSwitchChecker :: SimplEnv -> SwitchChecker
242 getSwitchChecker env = seChkr env
244 ---------------------
245 getMode :: SimplEnv -> SimplifierMode
246 getMode env = seMode env
248 setMode :: SimplifierMode -> SimplEnv -> SimplEnv
249 setMode mode env = env { seMode = mode }
251 ---------------------
252 getEnclosingCC :: SimplEnv -> CostCentreStack
253 getEnclosingCC env = seCC env
255 setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
256 setEnclosingCC env cc = env {seCC = cc}
258 ---------------------
259 extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
260 extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
261 = env {seIdSubst = extendVarEnv subst var res}
263 extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
264 extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
265 = env {seTvSubst = extendVarEnv subst var res}
267 ---------------------
268 getInScope :: SimplEnv -> InScopeSet
269 getInScope env = seInScope env
271 setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
272 setInScopeSet env in_scope = env {seInScope = in_scope}
274 setInScope :: SimplEnv -> SimplEnv -> SimplEnv
275 setInScope env env_with_in_scope = setInScopeSet env (getInScope env_with_in_scope)
277 addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
278 -- The new Ids are guaranteed to be freshly allocated
279 addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
280 = env { seInScope = in_scope `extendInScopeSetList` vs,
281 seIdSubst = id_subst `delVarEnvList` vs } -- Why delete?
283 modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
284 modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
285 = env {seInScope = modifyInScopeSet in_scope v v'}
287 ---------------------
288 zapSubstEnv :: SimplEnv -> SimplEnv
289 zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
291 setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
292 setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
294 mkContEx :: SimplEnv -> InExpr -> SimplSR
295 mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
297 isEmptySimplSubst :: SimplEnv -> Bool
298 isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
299 = isEmptyVarEnv tvs && isEmptyVarEnv ids
301 ---------------------
302 getRules :: SimplEnv -> RuleBase
303 getRules = seExtRules
308 Given an idempotent substitution, generated by the unifier, use it to
309 refine the environment
312 refineSimplEnv :: SimplEnv -> TypeRefinement -> SimplEnv
313 -- The TvSubstEnv is the refinement, and it refines OutTyVars into OutTypes
314 refineSimplEnv env@(SimplEnv { seTvSubst = tv_subst, seInScope = in_scope })
315 (refine_tv_subst, all_bound_here)
316 = env { seTvSubst = composeTvSubst in_scope refine_tv_subst tv_subst,
317 seInScope = in_scope' }
320 | all_bound_here = in_scope
321 -- The tvs are the tyvars bound here. If only they
322 -- are refined, there's no need to do anything
323 | otherwise = mapInScopeSet refine_id in_scope
325 refine_id v -- Only refine its type; any rules will get
326 -- refined if they are used (I hope)
327 | isId v = setIdType v (Type.substTy refine_subst (idType v))
329 refine_subst = TvSubst in_scope refine_tv_subst
332 %************************************************************************
336 %************************************************************************
340 substId :: SimplEnv -> Id -> SimplSR
341 substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
344 | otherwise -- A local Id
345 = case lookupVarEnv ids v of
346 Just (DoneId v occ) -> DoneId (refine v) occ
348 Nothing -> let v' = refine v
349 in DoneId v' (idOccInfo v')
350 -- We don't put LoopBreakers in the substitution (unless then need
351 -- to be cloned for name-clash rasons), so the idOccInfo is
352 -- very important! If isFragileOcc returned True for
353 -- loop breakers we could avoid this call, but at the expense
354 -- of adding more to the substitution, and building new Ids
355 -- a bit more often than really necessary
357 -- Get the most up-to-date thing from the in-scope set
358 -- Even though it isn't in the substitution, it may be in
359 -- the in-scope set with a different type (we only use the
360 -- substitution if the unique changes).
361 refine v = case lookupInScope in_scope v of
363 Nothing -> WARN( True, ppr v ) v -- This is an error!
367 %************************************************************************
369 \section{Substituting an Id binder}
371 %************************************************************************
374 These functions are in the monad only so that they can be made strict via seq.
377 simplBinders, simplLamBndrs, simplLetBndrs
378 :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
379 simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
380 simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
381 simplLetBndrs env bndrs = mapAccumLSmpl simplLetBndr env bndrs
384 simplBinder :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
385 -- Used for lambda and case-bound variables
386 -- Clone Id if necessary, substitute type
387 -- Return with IdInfo already substituted, but (fragile) occurrence info zapped
388 -- The substitution is extended only if the variable is cloned, because
389 -- we *don't* need to use it to track occurrence info.
391 | isTyVar bndr = do { let (env', tv) = substTyVarBndr env bndr
392 ; seqTyVar tv `seq` return (env', tv) }
393 | otherwise = do { let (env', id) = substIdBndr env bndr
394 ; seqId id `seq` return (env', id) }
397 simplLetBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
398 simplLetBndr env id = do { let (env', id') = substLetId env id
399 ; seqId id' `seq` return (env', id') }
402 simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
403 -- Used for lambda binders. These sometimes have unfoldings added by
404 -- the worker/wrapper pass that must be preserved, becuase they can't
405 -- be reconstructed from context. For example:
406 -- f x = case x of (a,b) -> fw a b x
407 -- fw a b x{=(a,b)} = ...
408 -- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
409 simplLamBndr env bndr
410 | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr -- Normal case
411 | otherwise = seqId id2 `seq` return (env', id2)
413 old_unf = idUnfolding bndr
414 (env', id1) = substIdBndr env bndr
415 id2 = id1 `setIdUnfolding` substUnfolding env old_unf
418 seqTyVar :: TyVar -> ()
419 seqTyVar b = b `seq` ()
422 seqId id = seqType (idType id) `seq`
428 substIdBndr :: SimplEnv -> Id -- Substitition and Id to transform
429 -> (SimplEnv, Id) -- Transformed pair
432 -- * Unique changed if necessary
433 -- * Type substituted
434 -- * Unfolding zapped
435 -- * Rules, worker, lbvar info all substituted
436 -- * Fragile occurrence info zapped
437 -- * The in-scope set extended with the returned Id
438 -- * The substitution extended with a DoneId if unique changed
439 -- In this case, the var in the DoneId is the same as the
442 substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
444 = (env { seInScope = in_scope `extendInScopeSet` new_id,
445 seIdSubst = new_subst }, new_id)
447 -- id1 is cloned if necessary
448 id1 = uniqAway in_scope old_id
450 -- id2 has its type zapped
451 id2 = substIdType env id1
453 -- new_id has the right IdInfo
454 -- The lazy-set is because we're in a loop here, with
455 -- rec_env, when dealing with a mutually-recursive group
456 new_id = maybeModifyIdInfo (substIdInfo env) id2
458 -- Extend the substitution if the unique has changed
459 -- See the notes with substTyVarBndr for the delSubstEnv
460 new_subst | new_id /= old_id
461 = extendVarEnv id_subst old_id (DoneId new_id (idOccInfo old_id))
463 = delVarEnv id_subst old_id
465 substLetId :: SimplEnv -> Id -> (SimplEnv, Id)
466 -- A variant for let-bound Ids
467 -- Clone Id if necessary
468 -- Substitute its type
469 -- Return an Id with completely zapped IdInfo
470 -- [A subsequent substIdInfo will restore its IdInfo]
471 -- Augment the subtitution
472 -- if the unique changed, *or*
473 -- if there's interesting occurrence info
475 substLetId env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
476 = (env { seInScope = in_scope `extendInScopeSet` new_id,
477 seIdSubst = new_subst }, new_id)
479 old_info = idInfo old_id
480 id1 = uniqAway in_scope old_id
481 id2 = substIdType env id1
482 new_id = setIdInfo id2 vanillaIdInfo
484 -- Extend the substitution if the unique has changed,
485 -- or there's some useful occurrence information
486 -- See the notes with substTyVarBndr for the delSubstEnv
487 occ_info = occInfo old_info
488 new_subst | new_id /= old_id || isFragileOcc occ_info
489 = extendVarEnv id_subst old_id (DoneId new_id occ_info)
491 = delVarEnv id_subst old_id
495 %************************************************************************
497 Impedence matching to type substitution
499 %************************************************************************
502 substTy :: SimplEnv -> Type -> Type
503 substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
504 = Type.substTy (TvSubst in_scope tv_env) ty
506 substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
507 substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
508 = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
509 (TvSubst in_scope' tv_env', tv')
510 -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
512 -- When substituting in rules etc we can get CoreSubst to do the work
513 -- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
514 -- here. I think the this will not usually result in a lot of work;
515 -- the substitutions are typically small, and laziness will avoid work in many cases.
517 mkCoreSubst :: SimplEnv -> CoreSubst.Subst
518 mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
519 = mk_subst tv_env id_env
521 mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
523 fiddle (DoneEx e) = e
524 fiddle (DoneId v occ) = Var v
525 fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
527 substExpr :: SimplEnv -> CoreExpr -> CoreExpr
529 | isEmptySimplSubst env = expr
530 | otherwise = CoreSubst.substExpr (mkCoreSubst env) expr
534 %************************************************************************
536 \section{IdInfo substitution}
538 %************************************************************************
541 simplIdInfo :: SimplEnv -> IdInfo -> IdInfo
542 -- Used by the simplifier to compute new IdInfo for a let(rec) binder,
543 -- subsequent to simplLetId having zapped its IdInfo
544 simplIdInfo env old_info
545 = case substIdInfo env old_info of
546 Just new_info -> new_info
549 substIdInfo :: SimplEnv
556 -- Keep only 'robust' OccInfo
559 -- Seq'ing on the returned IdInfo is enough to cause all the
560 -- substitutions to happen completely
563 | nothing_to_do = Nothing
564 | otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
565 `setArityInfo` (if keep_arity then old_arity else unknownArity)
566 `setSpecInfo` CoreSubst.substSpec subst old_rules
567 `setWorkerInfo` CoreSubst.substWorker subst old_wrkr
568 `setUnfoldingInfo` noUnfolding)
569 -- setSpecInfo does a seq
570 -- setWorkerInfo does a seq
572 subst = mkCoreSubst env
573 nothing_to_do = keep_occ && keep_arity &&
574 isEmptySpecInfo old_rules &&
575 not (workerExists old_wrkr) &&
576 not (hasUnfolding (unfoldingInfo info))
578 keep_occ = not (isFragileOcc old_occ)
579 keep_arity = old_arity == unknownArity
580 old_arity = arityInfo info
581 old_occ = occInfo info
582 old_rules = specInfo info
583 old_wrkr = workerInfo info
586 substIdType :: SimplEnv -> Id -> Id
587 substIdType env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env}) id
588 | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
589 | otherwise = setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
590 -- The tyVarsOfType is cheaper than it looks
591 -- because we cache the free tyvars of the type
592 -- in a Note in the id's type itself
597 substUnfolding env NoUnfolding = NoUnfolding
598 substUnfolding env (OtherCon cons) = OtherCon cons
599 substUnfolding env (CompulsoryUnfolding rhs) = CompulsoryUnfolding (substExpr env rhs)
600 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
604 %************************************************************************
608 %************************************************************************
611 type FloatsWithExpr = FloatsWith OutExpr
612 type FloatsWith a = (Floats, a)
613 -- We return something equivalent to (let b in e), but
614 -- in pieces to avoid the quadratic blowup when floating
615 -- incrementally. Comments just before simplExprB in Simplify.lhs
617 data Floats = Floats (OrdList OutBind)
618 InScopeSet -- Environment "inside" all the floats
619 Bool -- True <=> All bindings are lifted
621 allLifted :: Floats -> Bool
622 allLifted (Floats _ _ is_lifted) = is_lifted
624 wrapFloats :: Floats -> OutExpr -> OutExpr
625 wrapFloats (Floats bs _ _) body = foldrOL Let body bs
627 isEmptyFloats :: Floats -> Bool
628 isEmptyFloats (Floats bs _ _) = isNilOL bs
630 floatBinds :: Floats -> [OutBind]
631 floatBinds (Floats bs _ _) = fromOL bs
633 flattenFloats :: Floats -> Floats
634 -- Flattens into a single Rec group
635 flattenFloats (Floats bs is is_lifted)
636 = ASSERT2( is_lifted, ppr (fromOL bs) )
637 Floats (unitOL (Rec (flattenBinds (fromOL bs)))) is is_lifted
641 emptyFloats :: SimplEnv -> Floats
642 emptyFloats env = Floats nilOL (getInScope env) True
644 unitFloat :: SimplEnv -> OutId -> OutExpr -> Floats
645 -- A single non-rec float; extend the in-scope set
646 unitFloat env var rhs = Floats (unitOL (NonRec var rhs))
647 (extendInScopeSet (getInScope env) var)
648 (not (isUnLiftedType (idType var)))
650 addFloats :: SimplEnv -> Floats
651 -> (SimplEnv -> SimplM (FloatsWith a))
652 -> SimplM (FloatsWith a)
653 addFloats env (Floats b1 is1 l1) thing_inside
657 = thing_inside (setInScopeSet env is1) `thenSmpl` \ (Floats b2 is2 l2, res) ->
658 returnSmpl (Floats (b1 `appOL` b2) is2 (l1 && l2), res)
660 addLetBind :: OutBind -> Floats -> Floats
661 addLetBind bind (Floats binds in_scope lifted)
662 = Floats (bind `consOL` binds) in_scope (lifted && is_lifted_bind bind)
664 is_lifted_bind (Rec _) = True
665 is_lifted_bind (NonRec b r) = not (isUnLiftedType (idType b))
667 -- addAuxiliaryBind * takes already-simplified things (bndr and rhs)
668 -- * extends the in-scope env
669 -- * assumes it's a let-bindable thing
670 addAuxiliaryBind :: SimplEnv -> OutBind
671 -> (SimplEnv -> SimplM (FloatsWith a))
672 -> SimplM (FloatsWith a)
673 -- Extends the in-scope environment as well as wrapping the bindings
674 addAuxiliaryBind env bind thing_inside
675 = ASSERT( case bind of { NonRec b r -> not (needsCaseBinding (idType b) r) ; Rec _ -> True } )
676 thing_inside (addNewInScopeIds env (bindersOf bind)) `thenSmpl` \ (floats, x) ->
677 returnSmpl (addLetBind bind floats, x)