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
14 IMPORT_Trace -- ToDo: rm (debugging only)
20 import Id ( getIdArity, externallyVisibleId )
21 import IdInfo -- ( arityMaybe, ArityInfo )
23 import Maybes ( maybeToBool, Maybe(..) )
27 infixr 9 `thenLne`, `thenLne_`
30 %************************************************************************
32 \subsection[live-vs-free-doc]{Documentation}
34 %************************************************************************
36 (There is other relevant documentation in codeGen/CgLetNoEscape.)
38 The actual Stg datatype is decorated with {\em live variable}
39 information, as well as {\em free variable} information. The two are
40 {\em not} the same. Liveness is an operational property rather than a
41 semantic one. A variable is live at a particular execution point if
42 it can be referred to {\em directly} again. In particular, a dead
43 variable's stack slot (if it has one):
46 should be stubbed to avoid space leaks, and
48 may be reused for something else.
51 There ought to be a better way to say this. Here are some examples:
58 Just after the `in', v is live, but q is dead. If the whole of that
59 let expression was enclosed in a case expression, thus:
61 case (let v = [q] \[x] -> e in ...v...) of
64 (ie @alts@ mention @q@), then @q@ is live even after the `in'; because
65 we'll return later to the @alts@ and need it.
67 Let-no-escapes make this a bit more interesting:
69 let-no-escape v = [q] \ [x] -> e
73 Here, @q@ is still live at the `in', because @v@ is represented not by
74 a closure but by the current stack state. In other words, if @v@ is
75 live then so is @q@. Furthermore, if @e@ mentions an enclosing
76 let-no-escaped variable, then {\em its} free variables are also live
79 %************************************************************************
81 \subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
83 %************************************************************************
87 setStgVarInfo :: Bool -- True <=> do let-no-escapes
88 -> [StgBinding] -- input
89 -> [StgBinding] -- result
91 setStgVarInfo want_LNEs pgm
94 (pgm', _) = initLne want_LNEs (varsTopBinds pgm)
98 For top-level guys, we basically aren't worried about this
99 live-variable stuff; we do need to keep adding to the environment
100 as we step through the bindings (using @extendVarEnv@).
103 varsTopBinds :: [StgBinding] -> LneM ([StgBinding], FreeVarsInfo)
105 varsTopBinds [] = returnLne ([], emptyFVInfo)
106 varsTopBinds (bind:binds)
107 = extendVarEnv env_extension (
108 varsTopBinds binds `thenLne` \ (binds', fv_binds) ->
109 varsTopBind fv_binds bind `thenLne` \ (bind', fv_bind) ->
110 returnLne ((bind' : binds'),
111 (fv_binds `unionFVInfo` fv_bind) `minusFVBinders` binders
116 env_extension = [(b, LetrecBound
123 StgNonRec binder rhs -> [(binder,rhs)]
124 StgRec pairs -> pairs
126 binders = [b | (b,_) <- pairs]
129 varsTopBind :: FreeVarsInfo -- Info about the body
131 -> LneM (StgBinding, FreeVarsInfo)
133 varsTopBind body_fvs (StgNonRec binder rhs)
134 = varsRhs body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, _) ->
135 returnLne (StgNonRec binder rhs2, fvs)
137 varsTopBind body_fvs (StgRec pairs)
139 (binders, rhss) = unzip pairs
141 fixLne (\ ~(_, rec_rhs_fvs) ->
143 scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
145 mapAndUnzip3Lne (varsRhs scope_fvs) pairs `thenLne` \ (rhss2, fvss, _) ->
147 fvs = unionFVInfos fvss
149 returnLne (StgRec (binders `zip` rhss2), fvs)
155 varsRhs :: FreeVarsInfo -- Free var info for the scope of the binding
157 -> LneM (StgRhs, FreeVarsInfo, EscVarsSet)
159 varsRhs scope_fv_info (binder, StgRhsCon cc con args)
160 = varsAtoms args `thenLne` \ fvs ->
161 returnLne (StgRhsCon cc con args, fvs, getFVSet fvs)
163 varsRhs scope_fv_info (binder, StgRhsClosure cc _ _ upd args body)
164 = extendVarEnv [ (a, LambdaBound) | a <- args ] (
165 do_body args body `thenLne` \ (body2, body_fvs, body_escs) ->
167 set_of_args = mkUniqSet args
168 rhs_fvs = body_fvs `minusFVBinders` args
169 rhs_escs = body_escs `minusUniqSet` set_of_args
170 binder_info = lookupFVInfo scope_fv_info binder
172 returnLne (StgRhsClosure cc binder_info (getFVs rhs_fvs) upd args body2,
176 -- Pick out special case of application in body of thunk
177 do_body [] (StgApp (StgVarArg f) args _) = varsApp (Just upd) f args
178 do_body _ other_body = varsExpr other_body
182 varsAtoms :: [StgArg]
186 = mapLne var_atom atoms `thenLne` \ fvs_lists ->
187 returnLne (unionFVInfos fvs_lists)
189 var_atom a@(StgLitArg _) = returnLne emptyFVInfo
190 var_atom a@(StgVarArg v)
191 = lookupVarEnv v `thenLne` \ how_bound ->
192 returnLne (singletonFVInfo v how_bound stgArgOcc)
195 %************************************************************************
197 \subsection[expr-StgVarInfo]{Setting variable info on expressions}
199 %************************************************************************
201 @varsExpr@ carries in a monad-ised environment, which binds each
202 let(rec) variable (ie non top level, not imported, not lambda bound,
203 not case-alternative bound) to:
205 - its set of live vars.
206 For normal variables the set of live vars is just the variable
207 itself. For let-no-escaped variables, the set of live vars is the set
208 live at the moment the variable is entered. The set is guaranteed to
209 have no further let-no-escaped vars in it.
213 -> LneM (StgExpr, -- Decorated expr
214 FreeVarsInfo, -- Its free vars (NB free, not live)
215 EscVarsSet) -- Its escapees, a subset of its free vars;
216 -- also a subset of the domain of the envt
217 -- because we are only interested in the escapees
218 -- for vars which might be turned into
219 -- let-no-escaped ones.
222 The second and third components can be derived in a simple bottom up pass, not
223 dependent on any decisions about which variables will be let-no-escaped or
224 not. The first component, that is, the decorated expression, may then depend
225 on these components, but it in turn is not scrutinised as the basis for any
226 decisions. Hence no black holes.
229 varsExpr (StgApp lit@(StgLitArg _) args _)
230 = --(if null args then id else (trace (ppShow 80 (ppr PprShowAll args)))) (
231 returnLne (StgApp lit [] emptyUniqSet, emptyFVInfo, emptyUniqSet)
234 varsExpr (StgApp fun@(StgVarArg f) args _) = varsApp Nothing f args
236 varsExpr (StgCon con args _)
237 = getVarsLiveInCont `thenLne` \ live_in_cont ->
238 varsAtoms args `thenLne` \ args_fvs ->
240 returnLne (StgCon con args live_in_cont, args_fvs, getFVSet args_fvs)
242 varsExpr (StgPrim op args _)
243 = getVarsLiveInCont `thenLne` \ live_in_cont ->
244 varsAtoms args `thenLne` \ args_fvs ->
246 returnLne (StgPrim op args live_in_cont, args_fvs, getFVSet args_fvs)
248 varsExpr (StgSCC ty label expr)
249 = varsExpr expr `thenLne` ( \ (expr2, fvs, escs) ->
250 returnLne (StgSCC ty label expr2, fvs, escs) )
253 Cases require a little more real work.
255 varsExpr (StgCase scrut _ _ uniq alts)
256 = getVarsLiveInCont `thenLne` \ live_in_cont ->
257 vars_alts alts `thenLne` \ (alts2, alts_fvs, alts_escs) ->
258 lookupLiveVarsForSet alts_fvs `thenLne` \ alts_lvs ->
260 live_in_alts = live_in_cont `unionUniqSets` alts_lvs
262 -- we tell the scrutinee that everything live in the alts
263 -- is live in it, too.
264 setVarsLiveInCont live_in_alts (
266 ) `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
267 lookupLiveVarsForSet scrut_fvs `thenLne` \ scrut_lvs ->
269 live_in_whole_case = live_in_alts `unionUniqSets` scrut_lvs
272 StgCase scrut2 live_in_whole_case live_in_alts uniq alts2,
273 scrut_fvs `unionFVInfo` alts_fvs,
274 alts_escs `unionUniqSets` (getFVSet scrut_fvs) -- All free vars in the scrutinee escape
277 vars_alts (StgAlgAlts ty alts deflt)
278 = mapAndUnzip3Lne vars_alg_alt alts
279 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
281 alts_fvs = unionFVInfos alts_fvs_list
282 alts_escs = unionManyUniqSets alts_escs_list
284 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
286 StgAlgAlts ty alts2 deflt2,
287 alts_fvs `unionFVInfo` deflt_fvs,
288 alts_escs `unionUniqSets` deflt_escs
291 vars_alg_alt (con, binders, worthless_use_mask, rhs)
292 = extendVarEnv [(b, CaseBound) | b <- binders] (
293 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
295 good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders ]
296 -- records whether each param is used in the RHS
299 (con, binders, good_use_mask, rhs2),
300 rhs_fvs `minusFVBinders` binders,
301 rhs_escs `minusUniqSet` mkUniqSet binders -- ToDo: remove the minusUniqSet;
302 -- since escs won't include
303 -- any of these binders
306 vars_alts (StgPrimAlts ty alts deflt)
307 = mapAndUnzip3Lne vars_prim_alt alts
308 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
310 alts_fvs = unionFVInfos alts_fvs_list
311 alts_escs = unionManyUniqSets alts_escs_list
313 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
315 StgPrimAlts ty alts2 deflt2,
316 alts_fvs `unionFVInfo` deflt_fvs,
317 alts_escs `unionUniqSets` deflt_escs
320 vars_prim_alt (lit, rhs)
321 = varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
322 returnLne ((lit, rhs2), rhs_fvs, rhs_escs)
324 vars_deflt StgNoDefault
325 = returnLne (StgNoDefault, emptyFVInfo, emptyUniqSet)
327 vars_deflt (StgBindDefault binder _ rhs)
328 = extendVarEnv [(binder, CaseBound)] (
329 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
331 used_in_rhs = binder `elementOfFVInfo` rhs_fvs
334 StgBindDefault binder used_in_rhs rhs2,
335 rhs_fvs `minusFVBinders` [binder],
336 rhs_escs `minusUniqSet` singletonUniqSet binder
340 Lets not only take quite a bit of work, but this is where we convert
341 then to let-no-escapes, if we wish.
343 (Meanwhile, we don't expect to see let-no-escapes...)
345 varsExpr (StgLetNoEscape _ _ _ _) = panic "varsExpr: unexpected StgLetNoEscape"
347 varsExpr (StgLet bind body)
348 = isSwitchSetLne {-StgDoLetNoEscapes-} `thenLne` \ want_LNEs ->
350 (fixLne (\ ~(_, _, _, no_binder_escapes) ->
352 non_escaping_let = want_LNEs && no_binder_escapes
354 vars_let non_escaping_let bind body
355 )) `thenLne` \ (new_let, fvs, escs, _) ->
357 returnLne (new_let, fvs, escs)
362 varsApp :: Maybe UpdateFlag -- Just upd <=> this application is
363 -- the rhs of a thunk binding
364 -- x = [...] \upd [] -> the_app
365 -- with specified update flag
367 -> [StgArg] -- Arguments
368 -> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
370 varsApp maybe_thunk_body f args
371 = getVarsLiveInCont `thenLne` \ live_in_cont ->
373 varsAtoms args `thenLne` \ args_fvs ->
375 lookupVarEnv f `thenLne` \ how_bound ->
380 fun_fvs = singletonFVInfo f how_bound fun_occ
384 LetrecBound _ arity _
385 | n_args == 0 -> stgFakeFunAppOcc -- Function Application
386 -- with no arguments.
387 -- used by the lambda lifter.
388 | arity > n_args -> stgUnsatOcc -- Unsaturated
392 maybeToBool maybe_thunk_body -> -- Exactly saturated,
394 case maybe_thunk_body of
395 Just Updatable -> stgStdHeapOcc
396 Just SingleEntry -> stgNoUpdHeapOcc
397 other -> panic "varsApp"
399 | otherwise -> stgNormalOcc
400 -- record only that it occurs free
402 other -> NoStgBinderInfo
403 -- uninteresting variable
405 myself = singletonUniqSet f
407 fun_escs = case how_bound of
409 LetrecBound _ arity lvs ->
410 if arity == n_args then
411 emptyUniqSet -- Function doesn't escape
413 myself -- Inexact application; it does escape
415 other -> emptyUniqSet -- Only letrec-bound escapees
418 -- At the moment of the call:
420 -- either the function is *not* let-no-escaped, in which case
421 -- nothing is live except live_in_cont
422 -- or the function *is* let-no-escaped in which case the
423 -- variables it uses are live, but still the function
424 -- itself is not. PS. In this case, the function's
425 -- live vars should already include those of the
426 -- continuation, but it does no harm to just union the
430 = live_in_cont `unionUniqSets` case how_bound of
431 LetrecBound _ _ lvs -> lvs `minusUniqSet` myself
432 other -> emptyUniqSet
435 StgApp (StgVarArg f) args live_at_call,
436 fun_fvs `unionFVInfo` args_fvs,
437 fun_escs `unionUniqSets` (getFVSet args_fvs)
438 -- All the free vars of the args are disqualified
439 -- from being let-no-escaped.
445 vars_let :: Bool -- True <=> yes, we are let-no-escaping this let
446 -> StgBinding -- bindings
448 -> LneM (StgExpr, -- new let
449 FreeVarsInfo, -- variables free in the whole let
450 EscVarsSet, -- variables that escape from the whole let
451 Bool) -- True <=> none of the binders in the bindings
452 -- is among the escaping vars
454 vars_let let_no_escape bind body
455 = fixLne (\ ~(_, _, _, rec_bind_lvs, _, rec_body_fvs, _, _) ->
457 -- Do the bindings, setting live_in_cont to empty if
458 -- we ain't in a let-no-escape world
459 getVarsLiveInCont `thenLne` \ live_in_cont ->
461 (if let_no_escape then live_in_cont else emptyUniqSet)
462 (vars_bind rec_bind_lvs rec_body_fvs bind)
463 `thenLne` \ (bind2, bind_fvs, bind_escs, env_ext) ->
465 -- The live variables of this binding are the ones which are live
466 -- by virtue of being accessible via the free vars of the binding (lvs_from_fvs)
467 -- together with the live_in_cont ones
468 lookupLiveVarsForSet (bind_fvs `minusFVBinders` binders) `thenLne` \ lvs_from_fvs ->
470 bind_lvs = lvs_from_fvs `unionUniqSets` live_in_cont
473 -- bind_fvs and bind_escs still include the binders of the let(rec)
474 -- but bind_lvs does not
477 extendVarEnv env_ext (
478 varsExpr body `thenLne` \ (body2, body_fvs, body_escs) ->
479 lookupLiveVarsForSet body_fvs `thenLne` \ body_lvs ->
481 returnLne (bind2, bind_fvs, bind_escs, bind_lvs,
482 body2, body_fvs, body_escs, body_lvs)
484 )) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs,
485 body2, body_fvs, body_escs, body_lvs) ->
488 -- Compute the new let-expression
490 new_let = if let_no_escape then
491 -- trace "StgLetNoEscape!" (
492 StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
498 = (bind_fvs `unionFVInfo` body_fvs) `minusFVBinders` binders
501 = bind_lvs `unionUniqSets` (body_lvs `minusUniqSet` set_of_binders)
503 real_bind_escs = if let_no_escape then
507 -- Everything escapes which is free in the bindings
509 let_escs = (real_bind_escs `unionUniqSets` body_escs) `minusUniqSet` set_of_binders
511 all_escs = bind_escs `unionUniqSets` body_escs -- Still includes binders of
514 no_binder_escapes = isEmptyUniqSet (set_of_binders `intersectUniqSets` all_escs)
515 -- Mustn't depend on the passed-in let_no_escape flag, since
516 -- no_binder_escapes is used by the caller to derive the flag!
525 binders = case bind of
526 StgNonRec binder rhs -> [binder]
527 StgRec pairs -> map fst pairs
528 set_of_binders = mkUniqSet binders
530 mk_binding bind_lvs (binder,rhs)
532 LetrecBound False -- Not top level
537 live_vars = if let_no_escape then
538 bind_lvs `unionUniqSets` singletonUniqSet binder
540 singletonUniqSet binder
542 vars_bind :: StgLiveVars
543 -> FreeVarsInfo -- Free var info for body of binding
546 FreeVarsInfo, EscVarsSet, -- free vars; escapee vars
548 -- extension to environment
550 vars_bind rec_bind_lvs rec_body_fvs (StgNonRec binder rhs)
551 = varsRhs rec_body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, escs) ->
553 env_ext = [mk_binding rec_bind_lvs (binder,rhs)]
555 returnLne (StgNonRec binder rhs2, fvs, escs, env_ext)
557 vars_bind rec_bind_lvs rec_body_fvs (StgRec pairs)
559 (binders, rhss) = unzip pairs
560 env_ext = map (mk_binding rec_bind_lvs) pairs
562 extendVarEnv env_ext (
563 fixLne (\ ~(_, rec_rhs_fvs, _, _) ->
565 rec_scope_fvs = unionFVInfo rec_body_fvs rec_rhs_fvs
567 mapAndUnzip3Lne (varsRhs rec_scope_fvs) pairs `thenLne` \ (rhss2, fvss, escss) ->
569 fvs = unionFVInfos fvss
570 escs = unionManyUniqSets escss
572 returnLne (StgRec (binders `zip` rhss2), fvs, escs, env_ext)
576 %************************************************************************
578 \subsection[LNE-monad]{A little monad for this let-no-escaping pass}
580 %************************************************************************
582 There's a lot of stuff to pass around, so we use this @LneM@ monad to
583 help. All the stuff here is only passed {\em down}.
586 type LneM a = Bool -- True <=> do let-no-escapes
588 -> StgLiveVars -- vars live in continuation
598 Bool -- True <=> bound at top level
600 StgLiveVars -- Live vars... see notes below
603 For a let(rec)-bound variable, x, we record what varibles are live if
604 x is live. For "normal" variables that is just x alone. If x is
605 a let-no-escaped variable then x is represented by a code pointer and
606 a stack pointer (well, one for each stack). So all of the variables
607 needed in the execution of x are live if x is, and are therefore recorded
608 in the LetrecBound constructor; x itself *is* included.
610 The std monad functions:
612 initLne :: Bool -> LneM a -> a
613 initLne want_LNEs m = m want_LNEs nullIdEnv emptyUniqSet
615 {-# INLINE thenLne #-}
616 {-# INLINE thenLne_ #-}
617 {-# INLINE returnLne #-}
619 returnLne :: a -> LneM a
620 returnLne e sw env lvs_cont = e
622 thenLne :: LneM a -> (a -> LneM b) -> LneM b
623 (m `thenLne` k) sw env lvs_cont
624 = case (m sw env lvs_cont) of
625 m_result -> k m_result sw env lvs_cont
627 thenLne_ :: LneM a -> LneM b -> LneM b
628 (m `thenLne_` k) sw env lvs_cont
629 = case (m sw env lvs_cont) of
630 _ -> k sw env lvs_cont
632 mapLne :: (a -> LneM b) -> [a] -> LneM [b]
633 mapLne f [] = returnLne []
635 = f x `thenLne` \ r ->
636 mapLne f xs `thenLne` \ rs ->
639 mapAndUnzipLne :: (a -> LneM (b,c)) -> [a] -> LneM ([b],[c])
641 mapAndUnzipLne f [] = returnLne ([],[])
642 mapAndUnzipLne f (x:xs)
643 = f x `thenLne` \ (r1, r2) ->
644 mapAndUnzipLne f xs `thenLne` \ (rs1, rs2) ->
645 returnLne (r1:rs1, r2:rs2)
647 mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
649 mapAndUnzip3Lne f [] = returnLne ([],[],[])
650 mapAndUnzip3Lne f (x:xs)
651 = f x `thenLne` \ (r1, r2, r3) ->
652 mapAndUnzip3Lne f xs `thenLne` \ (rs1, rs2, rs3) ->
653 returnLne (r1:rs1, r2:rs2, r3:rs3)
655 fixLne :: (a -> LneM a) -> LneM a
656 fixLne expr sw env lvs_cont = result
658 result = expr result sw env lvs_cont
659 -- ^^^^^^ ------ ^^^^^^
662 Functions specific to this monad:
664 isSwitchSetLne :: LneM Bool
665 isSwitchSetLne want_LNEs env lvs_cont
668 getVarsLiveInCont :: LneM StgLiveVars
669 getVarsLiveInCont sw env lvs_cont = lvs_cont
671 setVarsLiveInCont :: StgLiveVars -> LneM a -> LneM a
672 setVarsLiveInCont new_lvs_cont expr sw env lvs_cont
673 = expr sw env new_lvs_cont
675 extendVarEnv :: [(Id, HowBound)] -> LneM a -> LneM a
676 extendVarEnv extension expr sw env lvs_cont
677 = expr sw (growIdEnvList env extension) lvs_cont
679 lookupVarEnv :: Id -> LneM HowBound
680 lookupVarEnv v sw env lvs_cont
682 case (lookupIdEnv env v) of
684 Nothing -> --false:ASSERT(not (isLocallyDefined v))
688 -- The result of lookupLiveVarsForSet, a set of live variables, is
689 -- only ever tacked onto a decorated expression. It is never used as
690 -- the basis of a control decision, which might give a black hole.
692 lookupLiveVarsForSet :: FreeVarsInfo -> LneM StgLiveVars
694 lookupLiveVarsForSet fvs sw env lvs_cont
695 = returnLne (unionManyUniqSets (map do_one (getFVs fvs)))
699 = if isLocallyDefined v then
700 case (lookupIdEnv env v) of
701 Just (LetrecBound _ _ lvs) -> lvs `unionUniqSets` singletonUniqSet v
702 Just _ -> singletonUniqSet v
703 Nothing -> pprPanic "lookupVarEnv/do_one:" (ppr PprShowAll v)
709 %************************************************************************
711 \subsection[Free-var info]{Free variable information}
713 %************************************************************************
716 type FreeVarsInfo = IdEnv (Id, Bool, StgBinderInfo)
717 -- If f is mapped to NoStgBinderInfo, that means
718 -- that f *is* mentioned (else it wouldn't be in the
719 -- IdEnv at all), but only in a saturated applications.
721 -- All case/lambda-bound things are also mapped to
722 -- NoStgBinderInfo, since we aren't interested in their
725 -- The Bool is True <=> the Id is top level letrec bound
727 type EscVarsSet = UniqSet Id
731 emptyFVInfo :: FreeVarsInfo
732 emptyFVInfo = nullIdEnv
734 singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
735 singletonFVInfo id ImportBound info = nullIdEnv
736 singletonFVInfo id (LetrecBound top_level _ _) info = unitIdEnv id (id, top_level, info)
737 singletonFVInfo id other info = unitIdEnv id (id, False, info)
739 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
740 unionFVInfo fv1 fv2 = combineIdEnvs plusFVInfo fv1 fv2
742 unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
743 unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
745 minusFVBinders :: FreeVarsInfo -> [Id] -> FreeVarsInfo
746 minusFVBinders fv ids = fv `delManyFromIdEnv` ids
748 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
749 elementOfFVInfo id fvs = maybeToBool (lookupIdEnv fvs id)
751 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
752 lookupFVInfo fvs id = case lookupIdEnv fvs id of
753 Nothing -> NoStgBinderInfo
754 Just (_,_,info) -> info
756 getFVs :: FreeVarsInfo -> [Id] -- Non-top-level things only
757 getFVs fvs = [id | (id,False,_) <- rngIdEnv fvs]
759 getFVSet :: FreeVarsInfo -> UniqSet Id
760 getFVSet fvs = mkUniqSet (getFVs fvs)
762 plusFVInfo (id1,top1,info1) (id2,top2,info2)
763 = ASSERT (id1 == id2 && top1 == top2)
764 (id1, top1, combineStgBinderInfo info1 info2)
768 rhsArity :: StgRhs -> Arity
769 rhsArity (StgRhsCon _ _ _) = 0
770 rhsArity (StgRhsClosure _ _ _ _ args _) = length args