2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 \section[StgVarInfo]{Sets free/live variable info in STG syntax}
6 And, as we have the info in hand, we may convert some lets to
10 #include "HsVersions.h"
12 module StgVarInfo ( setStgVarInfo ) where
18 import Id ( emptyIdSet, mkIdSet, minusIdSet,
19 unionIdSets, unionManyIdSets, isEmptyIdSet,
20 unitIdSet, intersectIdSets,
21 addOneToIdSet, SYN_IE(IdSet),
22 nullIdEnv, growIdEnvList, lookupIdEnv,
23 unitIdEnv, combineIdEnvs, delManyFromIdEnv,
24 rngIdEnv, SYN_IE(IdEnv),
27 import Maybes ( maybeToBool )
28 import Name ( isLocallyDefined )
29 import PprStyle ( PprStyle(..) )
30 import PprType ( GenType{-instance Outputable-} )
31 import Util ( panic, pprPanic, assertPanic )
33 infixr 9 `thenLne`, `thenLne_`
36 %************************************************************************
38 \subsection[live-vs-free-doc]{Documentation}
40 %************************************************************************
42 (There is other relevant documentation in codeGen/CgLetNoEscape.)
44 The actual Stg datatype is decorated with {\em live variable}
45 information, as well as {\em free variable} information. The two are
46 {\em not} the same. Liveness is an operational property rather than a
47 semantic one. A variable is live at a particular execution point if
48 it can be referred to {\em directly} again. In particular, a dead
49 variable's stack slot (if it has one):
52 should be stubbed to avoid space leaks, and
54 may be reused for something else.
57 There ought to be a better way to say this. Here are some examples:
64 Just after the `in', v is live, but q is dead. If the whole of that
65 let expression was enclosed in a case expression, thus:
67 case (let v = [q] \[x] -> e in ...v...) of
70 (ie @alts@ mention @q@), then @q@ is live even after the `in'; because
71 we'll return later to the @alts@ and need it.
73 Let-no-escapes make this a bit more interesting:
75 let-no-escape v = [q] \ [x] -> e
79 Here, @q@ is still live at the `in', because @v@ is represented not by
80 a closure but by the current stack state. In other words, if @v@ is
81 live then so is @q@. Furthermore, if @e@ mentions an enclosing
82 let-no-escaped variable, then {\em its} free variables are also live
85 %************************************************************************
87 \subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
89 %************************************************************************
93 setStgVarInfo :: Bool -- True <=> do let-no-escapes
94 -> [StgBinding] -- input
95 -> [StgBinding] -- result
97 setStgVarInfo want_LNEs pgm
100 (pgm', _) = initLne want_LNEs (varsTopBinds pgm)
104 For top-level guys, we basically aren't worried about this
105 live-variable stuff; we do need to keep adding to the environment
106 as we step through the bindings (using @extendVarEnv@).
109 varsTopBinds :: [StgBinding] -> LneM ([StgBinding], FreeVarsInfo)
111 varsTopBinds [] = returnLne ([], emptyFVInfo)
112 varsTopBinds (bind:binds)
113 = extendVarEnv env_extension (
114 varsTopBinds binds `thenLne` \ (binds', fv_binds) ->
115 varsTopBind fv_binds bind `thenLne` \ (bind', fv_bind) ->
116 returnLne ((bind' : binds'),
117 (fv_binds `unionFVInfo` fv_bind) `minusFVBinders` binders
122 env_extension = [(b, LetrecBound
129 StgNonRec binder rhs -> [(binder,rhs)]
130 StgRec pairs -> pairs
132 binders = [b | (b,_) <- pairs]
135 varsTopBind :: FreeVarsInfo -- Info about the body
137 -> LneM (StgBinding, FreeVarsInfo)
139 varsTopBind body_fvs (StgNonRec binder rhs)
140 = varsRhs body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, _) ->
141 returnLne (StgNonRec binder rhs2, fvs)
143 varsTopBind body_fvs (StgRec pairs)
145 (binders, rhss) = unzip pairs
147 fixLne (\ ~(_, rec_rhs_fvs) ->
149 scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
151 mapAndUnzip3Lne (varsRhs scope_fvs) pairs `thenLne` \ (rhss2, fvss, _) ->
153 fvs = unionFVInfos fvss
155 returnLne (StgRec (binders `zip` rhss2), fvs)
161 varsRhs :: FreeVarsInfo -- Free var info for the scope of the binding
163 -> LneM (StgRhs, FreeVarsInfo, EscVarsSet)
165 varsRhs scope_fv_info (binder, StgRhsCon cc con args)
166 = varsAtoms args `thenLne` \ fvs ->
167 returnLne (StgRhsCon cc con args, fvs, getFVSet fvs)
169 varsRhs scope_fv_info (binder, StgRhsClosure cc _ _ upd args body)
170 = extendVarEnv [ (a, LambdaBound) | a <- args ] (
171 do_body args body `thenLne` \ (body2, body_fvs, body_escs) ->
173 set_of_args = mkIdSet args
174 rhs_fvs = body_fvs `minusFVBinders` args
175 rhs_escs = body_escs `minusIdSet` set_of_args
176 binder_info = lookupFVInfo scope_fv_info binder
178 returnLne (StgRhsClosure cc binder_info (getFVs rhs_fvs) upd args body2,
182 -- Pick out special case of application in body of thunk
183 do_body [] (StgApp (StgVarArg f) args _) = varsApp (Just upd) f args
184 do_body _ other_body = varsExpr other_body
188 varsAtoms :: [StgArg]
192 = mapLne var_atom atoms `thenLne` \ fvs_lists ->
193 returnLne (unionFVInfos fvs_lists)
195 var_atom a@(StgLitArg _) = returnLne emptyFVInfo
196 var_atom a@(StgVarArg v)
197 = lookupVarEnv v `thenLne` \ how_bound ->
198 returnLne (singletonFVInfo v how_bound stgArgOcc)
201 %************************************************************************
203 \subsection[expr-StgVarInfo]{Setting variable info on expressions}
205 %************************************************************************
207 @varsExpr@ carries in a monad-ised environment, which binds each
208 let(rec) variable (ie non top level, not imported, not lambda bound,
209 not case-alternative bound) to:
211 - its set of live vars.
212 For normal variables the set of live vars is just the variable
213 itself. For let-no-escaped variables, the set of live vars is the set
214 live at the moment the variable is entered. The set is guaranteed to
215 have no further let-no-escaped vars in it.
219 -> LneM (StgExpr, -- Decorated expr
220 FreeVarsInfo, -- Its free vars (NB free, not live)
221 EscVarsSet) -- Its escapees, a subset of its free vars;
222 -- also a subset of the domain of the envt
223 -- because we are only interested in the escapees
224 -- for vars which might be turned into
225 -- let-no-escaped ones.
228 The second and third components can be derived in a simple bottom up pass, not
229 dependent on any decisions about which variables will be let-no-escaped or
230 not. The first component, that is, the decorated expression, may then depend
231 on these components, but it in turn is not scrutinised as the basis for any
232 decisions. Hence no black holes.
235 varsExpr (StgApp lit@(StgLitArg _) args _)
236 = returnLne (StgApp lit [] emptyIdSet, emptyFVInfo, emptyIdSet)
238 varsExpr (StgApp fun@(StgVarArg f) args _) = varsApp Nothing f args
240 varsExpr (StgCon con args _)
241 = getVarsLiveInCont `thenLne` \ live_in_cont ->
242 varsAtoms args `thenLne` \ args_fvs ->
244 returnLne (StgCon con args live_in_cont, args_fvs, getFVSet args_fvs)
246 varsExpr (StgPrim op args _)
247 = getVarsLiveInCont `thenLne` \ live_in_cont ->
248 varsAtoms args `thenLne` \ args_fvs ->
250 returnLne (StgPrim op args live_in_cont, args_fvs, getFVSet args_fvs)
252 varsExpr (StgSCC ty label expr)
253 = varsExpr expr `thenLne` ( \ (expr2, fvs, escs) ->
254 returnLne (StgSCC ty label expr2, fvs, escs) )
257 Cases require a little more real work.
259 varsExpr (StgCase scrut _ _ uniq alts)
260 = getVarsLiveInCont `thenLne` \ live_in_cont ->
261 vars_alts alts `thenLne` \ (alts2, alts_fvs, alts_escs) ->
262 lookupLiveVarsForSet alts_fvs `thenLne` \ alts_lvs ->
264 live_in_alts = live_in_cont `unionIdSets` alts_lvs
266 -- we tell the scrutinee that everything live in the alts
267 -- is live in it, too.
268 setVarsLiveInCont live_in_alts (
270 ) `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
271 lookupLiveVarsForSet scrut_fvs `thenLne` \ scrut_lvs ->
273 live_in_whole_case = live_in_alts `unionIdSets` scrut_lvs
276 StgCase scrut2 live_in_whole_case live_in_alts uniq alts2,
277 scrut_fvs `unionFVInfo` alts_fvs,
278 alts_escs `unionIdSets` (getFVSet scrut_fvs) -- All free vars in the scrutinee escape
281 vars_alts (StgAlgAlts ty alts deflt)
282 = mapAndUnzip3Lne vars_alg_alt alts
283 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
285 alts_fvs = unionFVInfos alts_fvs_list
286 alts_escs = unionManyIdSets alts_escs_list
288 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
290 StgAlgAlts ty alts2 deflt2,
291 alts_fvs `unionFVInfo` deflt_fvs,
292 alts_escs `unionIdSets` deflt_escs
295 vars_alg_alt (con, binders, worthless_use_mask, rhs)
296 = extendVarEnv [(b, CaseBound) | b <- binders] (
297 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
299 good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders ]
300 -- records whether each param is used in the RHS
303 (con, binders, good_use_mask, rhs2),
304 rhs_fvs `minusFVBinders` binders,
305 rhs_escs `minusIdSet` mkIdSet binders -- ToDo: remove the minusIdSet;
306 -- since escs won't include
307 -- any of these binders
310 vars_alts (StgPrimAlts ty alts deflt)
311 = mapAndUnzip3Lne vars_prim_alt alts
312 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
314 alts_fvs = unionFVInfos alts_fvs_list
315 alts_escs = unionManyIdSets alts_escs_list
317 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
319 StgPrimAlts ty alts2 deflt2,
320 alts_fvs `unionFVInfo` deflt_fvs,
321 alts_escs `unionIdSets` deflt_escs
324 vars_prim_alt (lit, rhs)
325 = varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
326 returnLne ((lit, rhs2), rhs_fvs, rhs_escs)
328 vars_deflt StgNoDefault
329 = returnLne (StgNoDefault, emptyFVInfo, emptyIdSet)
331 vars_deflt (StgBindDefault binder _ rhs)
332 = extendVarEnv [(binder, CaseBound)] (
333 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
335 used_in_rhs = binder `elementOfFVInfo` rhs_fvs
338 StgBindDefault binder used_in_rhs rhs2,
339 rhs_fvs `minusFVBinders` [binder],
340 rhs_escs `minusIdSet` unitIdSet binder
344 Lets not only take quite a bit of work, but this is where we convert
345 then to let-no-escapes, if we wish.
347 (Meanwhile, we don't expect to see let-no-escapes...)
349 varsExpr (StgLetNoEscape _ _ _ _) = panic "varsExpr: unexpected StgLetNoEscape"
351 varsExpr (StgLet bind body)
352 = isSwitchSetLne {-StgDoLetNoEscapes-} `thenLne` \ want_LNEs ->
354 (fixLne (\ ~(_, _, _, no_binder_escapes) ->
356 non_escaping_let = want_LNEs && no_binder_escapes
358 vars_let non_escaping_let bind body
359 )) `thenLne` \ (new_let, fvs, escs, _) ->
361 returnLne (new_let, fvs, escs)
366 varsApp :: Maybe UpdateFlag -- Just upd <=> this application is
367 -- the rhs of a thunk binding
368 -- x = [...] \upd [] -> the_app
369 -- with specified update flag
371 -> [StgArg] -- Arguments
372 -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
374 varsApp maybe_thunk_body f args
375 = getVarsLiveInCont `thenLne` \ live_in_cont ->
377 varsAtoms args `thenLne` \ args_fvs ->
379 lookupVarEnv f `thenLne` \ how_bound ->
384 fun_fvs = singletonFVInfo f how_bound fun_occ
388 LetrecBound _ arity _
389 | n_args == 0 -> stgFakeFunAppOcc -- Function Application
390 -- with no arguments.
391 -- used by the lambda lifter.
392 | arity > n_args -> stgUnsatOcc -- Unsaturated
396 maybeToBool maybe_thunk_body -> -- Exactly saturated,
398 case maybe_thunk_body of
399 Just Updatable -> stgStdHeapOcc
400 Just SingleEntry -> stgNoUpdHeapOcc
401 other -> panic "varsApp"
403 | otherwise -> stgNormalOcc
404 -- record only that it occurs free
406 other -> NoStgBinderInfo
407 -- uninteresting variable
411 fun_escs = case how_bound of
413 LetrecBound _ arity lvs ->
414 if arity == n_args then
415 emptyIdSet -- Function doesn't escape
417 myself -- Inexact application; it does escape
419 other -> emptyIdSet -- Only letrec-bound escapees
422 -- At the moment of the call:
424 -- either the function is *not* let-no-escaped, in which case
425 -- nothing is live except live_in_cont
426 -- or the function *is* let-no-escaped in which case the
427 -- variables it uses are live, but still the function
428 -- itself is not. PS. In this case, the function's
429 -- live vars should already include those of the
430 -- continuation, but it does no harm to just union the
434 = live_in_cont `unionIdSets` case how_bound of
435 LetrecBound _ _ lvs -> lvs `minusIdSet` myself
439 StgApp (StgVarArg f) args live_at_call,
440 fun_fvs `unionFVInfo` args_fvs,
441 fun_escs `unionIdSets` (getFVSet args_fvs)
442 -- All the free vars of the args are disqualified
443 -- from being let-no-escaped.
449 vars_let :: Bool -- True <=> yes, we are let-no-escaping this let
450 -> StgBinding -- bindings
452 -> LneM (StgExpr, -- new let
453 FreeVarsInfo, -- variables free in the whole let
454 EscVarsSet, -- variables that escape from the whole let
455 Bool) -- True <=> none of the binders in the bindings
456 -- is among the escaping vars
458 vars_let let_no_escape bind body
459 = fixLne (\ ~(_, _, _, rec_bind_lvs, _, rec_body_fvs, _, _) ->
461 -- Do the bindings, setting live_in_cont to empty if
462 -- we ain't in a let-no-escape world
463 getVarsLiveInCont `thenLne` \ live_in_cont ->
465 (if let_no_escape then live_in_cont else emptyIdSet)
466 (vars_bind rec_bind_lvs rec_body_fvs bind)
467 `thenLne` \ (bind2, bind_fvs, bind_escs, env_ext) ->
469 -- The live variables of this binding are the ones which are live
470 -- by virtue of being accessible via the free vars of the binding (lvs_from_fvs)
471 -- together with the live_in_cont ones
472 lookupLiveVarsForSet (bind_fvs `minusFVBinders` binders) `thenLne` \ lvs_from_fvs ->
474 bind_lvs = lvs_from_fvs `unionIdSets` live_in_cont
477 -- bind_fvs and bind_escs still include the binders of the let(rec)
478 -- but bind_lvs does not
481 extendVarEnv env_ext (
482 varsExpr body `thenLne` \ (body2, body_fvs, body_escs) ->
483 lookupLiveVarsForSet body_fvs `thenLne` \ body_lvs ->
485 returnLne (bind2, bind_fvs, bind_escs, bind_lvs,
486 body2, body_fvs, body_escs, body_lvs)
488 )) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs,
489 body2, body_fvs, body_escs, body_lvs) ->
492 -- Compute the new let-expression
494 new_let = if let_no_escape then
495 -- trace "StgLetNoEscape!" (
496 StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
502 = (bind_fvs `unionFVInfo` body_fvs) `minusFVBinders` binders
505 = bind_lvs `unionIdSets` (body_lvs `minusIdSet` set_of_binders)
507 real_bind_escs = if let_no_escape then
511 -- Everything escapes which is free in the bindings
513 let_escs = (real_bind_escs `unionIdSets` body_escs) `minusIdSet` set_of_binders
515 all_escs = bind_escs `unionIdSets` body_escs -- Still includes binders of
518 no_binder_escapes = isEmptyIdSet (set_of_binders `intersectIdSets` all_escs)
519 -- Mustn't depend on the passed-in let_no_escape flag, since
520 -- no_binder_escapes is used by the caller to derive the flag!
529 binders = case bind of
530 StgNonRec binder rhs -> [binder]
531 StgRec pairs -> map fst pairs
532 set_of_binders = mkIdSet binders
534 mk_binding bind_lvs (binder,rhs)
536 LetrecBound False -- Not top level
541 live_vars = if let_no_escape then
542 addOneToIdSet bind_lvs binder
546 vars_bind :: StgLiveVars
547 -> FreeVarsInfo -- Free var info for body of binding
550 FreeVarsInfo, EscVarsSet, -- free vars; escapee vars
552 -- extension to environment
554 vars_bind rec_bind_lvs rec_body_fvs (StgNonRec binder rhs)
555 = varsRhs rec_body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, escs) ->
557 env_ext = [mk_binding rec_bind_lvs (binder,rhs)]
559 returnLne (StgNonRec binder rhs2, fvs, escs, env_ext)
561 vars_bind rec_bind_lvs rec_body_fvs (StgRec pairs)
563 (binders, rhss) = unzip pairs
564 env_ext = map (mk_binding rec_bind_lvs) pairs
566 extendVarEnv env_ext (
567 fixLne (\ ~(_, rec_rhs_fvs, _, _) ->
569 rec_scope_fvs = unionFVInfo rec_body_fvs rec_rhs_fvs
571 mapAndUnzip3Lne (varsRhs rec_scope_fvs) pairs `thenLne` \ (rhss2, fvss, escss) ->
573 fvs = unionFVInfos fvss
574 escs = unionManyIdSets escss
576 returnLne (StgRec (binders `zip` rhss2), fvs, escs, env_ext)
580 %************************************************************************
582 \subsection[LNE-monad]{A little monad for this let-no-escaping pass}
584 %************************************************************************
586 There's a lot of stuff to pass around, so we use this @LneM@ monad to
587 help. All the stuff here is only passed {\em down}.
590 type LneM a = Bool -- True <=> do let-no-escapes
592 -> StgLiveVars -- vars live in continuation
600 Bool -- True <=> bound at top level
602 StgLiveVars -- Live vars... see notes below
605 For a let(rec)-bound variable, x, we record what varibles are live if
606 x is live. For "normal" variables that is just x alone. If x is
607 a let-no-escaped variable then x is represented by a code pointer and
608 a stack pointer (well, one for each stack). So all of the variables
609 needed in the execution of x are live if x is, and are therefore recorded
610 in the LetrecBound constructor; x itself *is* included.
612 The std monad functions:
614 initLne :: Bool -> LneM a -> a
615 initLne want_LNEs m = m want_LNEs nullIdEnv emptyIdSet
617 {-# INLINE thenLne #-}
618 {-# INLINE thenLne_ #-}
619 {-# INLINE returnLne #-}
621 returnLne :: a -> LneM a
622 returnLne e sw env lvs_cont = e
624 thenLne :: LneM a -> (a -> LneM b) -> LneM b
625 thenLne m k sw env lvs_cont
626 = case (m sw env lvs_cont) of
627 m_result -> k m_result sw env lvs_cont
629 thenLne_ :: LneM a -> LneM b -> LneM b
630 thenLne_ m k sw env lvs_cont
631 = case (m sw env lvs_cont) of
632 _ -> k sw env lvs_cont
634 mapLne :: (a -> LneM b) -> [a] -> LneM [b]
635 mapLne f [] = returnLne []
637 = f x `thenLne` \ r ->
638 mapLne f xs `thenLne` \ rs ->
641 mapAndUnzipLne :: (a -> LneM (b,c)) -> [a] -> LneM ([b],[c])
643 mapAndUnzipLne f [] = returnLne ([],[])
644 mapAndUnzipLne f (x:xs)
645 = f x `thenLne` \ (r1, r2) ->
646 mapAndUnzipLne f xs `thenLne` \ (rs1, rs2) ->
647 returnLne (r1:rs1, r2:rs2)
649 mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
651 mapAndUnzip3Lne f [] = returnLne ([],[],[])
652 mapAndUnzip3Lne f (x:xs)
653 = f x `thenLne` \ (r1, r2, r3) ->
654 mapAndUnzip3Lne f xs `thenLne` \ (rs1, rs2, rs3) ->
655 returnLne (r1:rs1, r2:rs2, r3:rs3)
657 fixLne :: (a -> LneM a) -> LneM a
658 fixLne expr sw env lvs_cont = result
660 result = expr result sw env lvs_cont
661 -- ^^^^^^ ------ ^^^^^^
664 Functions specific to this monad:
666 isSwitchSetLne :: LneM Bool
667 isSwitchSetLne want_LNEs env lvs_cont
670 getVarsLiveInCont :: LneM StgLiveVars
671 getVarsLiveInCont sw env lvs_cont = lvs_cont
673 setVarsLiveInCont :: StgLiveVars -> LneM a -> LneM a
674 setVarsLiveInCont new_lvs_cont expr sw env lvs_cont
675 = expr sw env new_lvs_cont
677 extendVarEnv :: [(Id, HowBound)] -> LneM a -> LneM a
678 extendVarEnv extension expr sw env lvs_cont
679 = expr sw (growIdEnvList env extension) lvs_cont
681 lookupVarEnv :: Id -> LneM HowBound
682 lookupVarEnv v sw env lvs_cont
684 case (lookupIdEnv env v) of
686 Nothing -> --false:ASSERT(not (isLocallyDefined v))
690 -- The result of lookupLiveVarsForSet, a set of live variables, is
691 -- only ever tacked onto a decorated expression. It is never used as
692 -- the basis of a control decision, which might give a black hole.
694 lookupLiveVarsForSet :: FreeVarsInfo -> LneM StgLiveVars
696 lookupLiveVarsForSet fvs sw env lvs_cont
697 = returnLne (unionManyIdSets (map do_one (getFVs fvs)))
701 = if isLocallyDefined v then
702 case (lookupIdEnv env v) of
703 Just (LetrecBound _ _ lvs) -> addOneToIdSet lvs v
704 Just _ -> unitIdSet v
705 Nothing -> pprPanic "lookupVarEnv/do_one:" (ppr PprShowAll v)
711 %************************************************************************
713 \subsection[Free-var info]{Free variable information}
715 %************************************************************************
718 type FreeVarsInfo = IdEnv (Id, Bool, StgBinderInfo)
719 -- If f is mapped to NoStgBinderInfo, that means
720 -- that f *is* mentioned (else it wouldn't be in the
721 -- IdEnv at all), but only in a saturated applications.
723 -- All case/lambda-bound things are also mapped to
724 -- NoStgBinderInfo, since we aren't interested in their
727 -- The Bool is True <=> the Id is top level letrec bound
729 type EscVarsSet = IdSet
733 emptyFVInfo :: FreeVarsInfo
734 emptyFVInfo = nullIdEnv
736 singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
737 singletonFVInfo id ImportBound info = nullIdEnv
738 singletonFVInfo id (LetrecBound top_level _ _) info = unitIdEnv id (id, top_level, info)
739 singletonFVInfo id other info = unitIdEnv id (id, False, info)
741 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
742 unionFVInfo fv1 fv2 = combineIdEnvs plusFVInfo fv1 fv2
744 unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
745 unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
747 minusFVBinders :: FreeVarsInfo -> [Id] -> FreeVarsInfo
748 minusFVBinders fv ids = fv `delManyFromIdEnv` ids
750 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
751 elementOfFVInfo id fvs = maybeToBool (lookupIdEnv fvs id)
753 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
754 lookupFVInfo fvs id = case lookupIdEnv fvs id of
755 Nothing -> NoStgBinderInfo
756 Just (_,_,info) -> info
758 getFVs :: FreeVarsInfo -> [Id] -- Non-top-level things only
759 getFVs fvs = [id | (id,False,_) <- rngIdEnv fvs]
761 getFVSet :: FreeVarsInfo -> IdSet
762 getFVSet fvs = mkIdSet (getFVs fvs)
764 plusFVInfo (id1,top1,info1) (id2,top2,info2)
765 = ASSERT (id1 == id2 && top1 == top2)
766 (id1, top1, combineStgBinderInfo info1 info2)
770 rhsArity :: StgRhs -> Arity
771 rhsArity (StgRhsCon _ _ _) = 0
772 rhsArity (StgRhsClosure _ _ _ _ args _) = length args