2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
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 )
24 import Maybes ( maybeToBool, Maybe(..) )
28 infixr 9 `thenLne`, `thenLne_`
31 %************************************************************************
33 \subsection[live-vs-free-doc]{Documentation}
35 %************************************************************************
37 (There is other relevant documentation in codeGen/CgLetNoEscape.)
39 The actual Stg datatype is decorated with {\em live variable}
40 information, as well as {\em free variable} information. The two are
41 {\em not} the same. Liveness is an operational property rather than a
42 semantic one. A variable is live at a particular execution point if
43 it can be referred to {\em directly} again. In particular, a dead
44 variable's stack slot (if it has one):
47 should be stubbed to avoid space leaks, and
49 may be reused for something else.
52 There ought to be a better way to say this. Here are some examples:
59 Just after the `in', v is live, but q is dead. If the whole of that
60 let expression was enclosed in a case expression, thus:
62 case (let v = [q] \[x] -> e in ...v...) of
65 (ie @alts@ mention @q@), then @q@ is live even after the `in'; because
66 we'll return later to the @alts@ and need it.
68 Let-no-escapes make this a bit more interesting:
70 let-no-escape v = [q] \ [x] -> e
74 Here, @q@ is still live at the `in', because @v@ is represented not by
75 a closure but by the current stack state. In other words, if @v@ is
76 live then so is @q@. Furthermore, if @e@ mentions an enclosing
77 let-no-escaped variable, then {\em its} free variables are also live
80 %************************************************************************
82 \subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
84 %************************************************************************
88 setStgVarInfo :: Bool -- True <=> do let-no-escapes
89 -> [PlainStgBinding] -- input
90 -> [PlainStgBinding] -- result
92 setStgVarInfo want_LNEs pgm
95 (pgm', _) = initLne want_LNEs (varsTopBinds pgm)
99 For top-level guys, we basically aren't worried about this
100 live-variable stuff; we do need to keep adding to the environment
101 as we step through the bindings (using @extendVarEnv@).
104 varsTopBinds :: [PlainStgBinding] -> LneM ([PlainStgBinding], FreeVarsInfo)
106 varsTopBinds [] = returnLne ([], emptyFVInfo)
107 varsTopBinds (bind:binds)
108 = extendVarEnv env_extension (
109 varsTopBinds binds `thenLne` \ (binds', fv_binds) ->
110 varsTopBind fv_binds bind `thenLne` \ (bind', fv_bind) ->
111 returnLne ((bind' : binds'),
112 (fv_binds `unionFVInfo` fv_bind) `minusFVBinders` binders
117 env_extension = [(b, LetrecBound
124 StgNonRec binder rhs -> [(binder,rhs)]
125 StgRec pairs -> pairs
127 binders = [b | (b,_) <- pairs]
130 varsTopBind :: FreeVarsInfo -- Info about the body
132 -> LneM (PlainStgBinding, FreeVarsInfo)
134 varsTopBind body_fvs (StgNonRec binder rhs)
135 = varsRhs body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, _) ->
136 returnLne (StgNonRec binder rhs2, fvs)
138 varsTopBind body_fvs (StgRec pairs)
140 (binders, rhss) = unzip pairs
142 fixLne (\ ~(_, rec_rhs_fvs) ->
144 scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
146 mapAndUnzip3Lne (varsRhs scope_fvs) pairs `thenLne` \ (rhss2, fvss, _) ->
148 fvs = unionFVInfos fvss
150 returnLne (StgRec (binders `zip` rhss2), fvs)
156 varsRhs :: FreeVarsInfo -- Free var info for the scope of the binding
158 -> LneM (PlainStgRhs, FreeVarsInfo, EscVarsSet)
160 varsRhs scope_fv_info (binder, StgRhsCon cc con args)
161 = varsAtoms args `thenLne` \ fvs ->
162 returnLne (StgRhsCon cc con args, fvs, getFVSet fvs)
164 varsRhs scope_fv_info (binder, StgRhsClosure cc _ _ upd args body)
165 = extendVarEnv [ (a, LambdaBound) | a <- args ] (
166 do_body args body `thenLne` \ (body2, body_fvs, body_escs) ->
168 set_of_args = mkUniqSet args
169 rhs_fvs = body_fvs `minusFVBinders` args
170 rhs_escs = body_escs `minusUniqSet` set_of_args
171 binder_info = lookupFVInfo scope_fv_info binder
173 returnLne (StgRhsClosure cc binder_info (getFVs rhs_fvs) upd args body2,
177 -- Pick out special case of application in body of thunk
178 do_body [] (StgApp (StgVarAtom f) args _) = varsApp (Just upd) f args
179 do_body _ other_body = varsExpr other_body
183 varsAtoms :: [PlainStgAtom]
187 = mapLne var_atom atoms `thenLne` \ fvs_lists ->
188 returnLne (unionFVInfos fvs_lists)
190 var_atom a@(StgLitAtom _) = returnLne emptyFVInfo
191 var_atom a@(StgVarAtom v)
192 = lookupVarEnv v `thenLne` \ how_bound ->
193 returnLne (singletonFVInfo v how_bound stgArgOcc)
196 %************************************************************************
198 \subsection[expr-StgVarInfo]{Setting variable info on expressions}
200 %************************************************************************
202 @varsExpr@ carries in a monad-ised environment, which binds each
203 let(rec) variable (ie non top level, not imported, not lambda bound,
204 not case-alternative bound) to:
206 - its set of live vars.
207 For normal variables the set of live vars is just the variable
208 itself. For let-no-escaped variables, the set of live vars is the set
209 live at the moment the variable is entered. The set is guaranteed to
210 have no further let-no-escaped vars in it.
213 varsExpr :: PlainStgExpr
214 -> LneM (PlainStgExpr, -- Decorated expr
215 FreeVarsInfo, -- Its free vars (NB free, not live)
216 EscVarsSet) -- Its escapees, a subset of its free vars;
217 -- also a subset of the domain of the envt
218 -- because we are only interested in the escapees
219 -- for vars which might be turned into
220 -- let-no-escaped ones.
223 The second and third components can be derived in a simple bottom up pass, not
224 dependent on any decisions about which variables will be let-no-escaped or
225 not. The first component, that is, the decorated expression, may then depend
226 on these components, but it in turn is not scrutinised as the basis for any
227 decisions. Hence no black holes.
230 varsExpr (StgApp lit@(StgLitAtom _) args _)
231 = --(if null args then id else (trace (ppShow 80 (ppr PprShowAll args)))) (
232 returnLne (StgApp lit [] emptyUniqSet, emptyFVInfo, emptyUniqSet)
235 varsExpr (StgApp fun@(StgVarAtom f) args _) = varsApp Nothing f args
237 varsExpr (StgConApp con args _)
238 = getVarsLiveInCont `thenLne` \ live_in_cont ->
239 varsAtoms args `thenLne` \ args_fvs ->
241 returnLne (StgConApp con args live_in_cont, args_fvs, getFVSet args_fvs)
243 varsExpr (StgPrimApp op args _)
244 = getVarsLiveInCont `thenLne` \ live_in_cont ->
245 varsAtoms args `thenLne` \ args_fvs ->
247 returnLne (StgPrimApp op args live_in_cont, args_fvs, getFVSet args_fvs)
249 varsExpr (StgSCC ty label expr)
250 = varsExpr expr `thenLne` ( \ (expr2, fvs, escs) ->
251 returnLne (StgSCC ty label expr2, fvs, escs) )
254 Cases require a little more real work.
256 varsExpr (StgCase scrut _ _ uniq alts)
257 = getVarsLiveInCont `thenLne` \ live_in_cont ->
258 vars_alts alts `thenLne` \ (alts2, alts_fvs, alts_escs) ->
259 lookupLiveVarsForSet alts_fvs `thenLne` \ alts_lvs ->
261 live_in_alts = live_in_cont `unionUniqSets` alts_lvs
263 -- we tell the scrutinee that everything live in the alts
264 -- is live in it, too.
265 setVarsLiveInCont live_in_alts (
267 ) `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
268 lookupLiveVarsForSet scrut_fvs `thenLne` \ scrut_lvs ->
270 live_in_whole_case = live_in_alts `unionUniqSets` scrut_lvs
273 StgCase scrut2 live_in_whole_case live_in_alts uniq alts2,
274 scrut_fvs `unionFVInfo` alts_fvs,
275 alts_escs `unionUniqSets` (getFVSet scrut_fvs) -- All free vars in the scrutinee escape
278 vars_alts (StgAlgAlts ty alts deflt)
279 = mapAndUnzip3Lne vars_alg_alt alts
280 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
282 alts_fvs = unionFVInfos alts_fvs_list
283 alts_escs = unionManyUniqSets alts_escs_list
285 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
287 StgAlgAlts ty alts2 deflt2,
288 alts_fvs `unionFVInfo` deflt_fvs,
289 alts_escs `unionUniqSets` deflt_escs
292 vars_alg_alt (con, binders, worthless_use_mask, rhs)
293 = extendVarEnv [(b, CaseBound) | b <- binders] (
294 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
296 good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders ]
297 -- records whether each param is used in the RHS
300 (con, binders, good_use_mask, rhs2),
301 rhs_fvs `minusFVBinders` binders,
302 rhs_escs `minusUniqSet` mkUniqSet binders -- ToDo: remove the minusUniqSet;
303 -- since escs won't include
304 -- any of these binders
307 vars_alts (StgPrimAlts ty alts deflt)
308 = mapAndUnzip3Lne vars_prim_alt alts
309 `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
311 alts_fvs = unionFVInfos alts_fvs_list
312 alts_escs = unionManyUniqSets alts_escs_list
314 vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
316 StgPrimAlts ty alts2 deflt2,
317 alts_fvs `unionFVInfo` deflt_fvs,
318 alts_escs `unionUniqSets` deflt_escs
321 vars_prim_alt (lit, rhs)
322 = varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
323 returnLne ((lit, rhs2), rhs_fvs, rhs_escs)
325 vars_deflt StgNoDefault
326 = returnLne (StgNoDefault, emptyFVInfo, emptyUniqSet)
328 vars_deflt (StgBindDefault binder _ rhs)
329 = extendVarEnv [(binder, CaseBound)] (
330 varsExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
332 used_in_rhs = binder `elementOfFVInfo` rhs_fvs
335 StgBindDefault binder used_in_rhs rhs2,
336 rhs_fvs `minusFVBinders` [binder],
337 rhs_escs `minusUniqSet` singletonUniqSet binder
341 Lets not only take quite a bit of work, but this is where we convert
342 then to let-no-escapes, if we wish.
344 (Meanwhile, we don't expect to see let-no-escapes...)
346 varsExpr (StgLetNoEscape _ _ _ _) = panic "varsExpr: unexpected StgLetNoEscape"
348 varsExpr (StgLet bind body)
349 = isSwitchSetLne {-StgDoLetNoEscapes-} `thenLne` \ want_LNEs ->
351 (fixLne (\ ~(_, _, _, no_binder_escapes) ->
353 non_escaping_let = want_LNEs && no_binder_escapes
355 vars_let non_escaping_let bind body
356 )) `thenLne` \ (new_let, fvs, escs, _) ->
358 returnLne (new_let, fvs, escs)
363 -- rest of varsExpr goes here
365 #endif {- Data Parallel Haskell -}
370 varsApp :: Maybe UpdateFlag -- Just upd <=> this application is
371 -- the rhs of a thunk binding
372 -- x = [...] \upd [] -> the_app
373 -- with specified update flag
375 -> [PlainStgAtom] -- Arguments
376 -> LneM (PlainStgExpr, FreeVarsInfo, EscVarsSet)
378 varsApp maybe_thunk_body f args
379 = getVarsLiveInCont `thenLne` \ live_in_cont ->
381 varsAtoms args `thenLne` \ args_fvs ->
383 lookupVarEnv f `thenLne` \ how_bound ->
388 fun_fvs = singletonFVInfo f how_bound fun_occ
392 LetrecBound _ arity _
393 | n_args == 0 -> stgFakeFunAppOcc -- Function Application
394 -- with no arguments.
395 -- used by the lambda lifter.
396 | arity > n_args -> stgUnsatOcc -- Unsaturated
400 maybeToBool maybe_thunk_body -> -- Exactly saturated,
402 case maybe_thunk_body of
403 Just Updatable -> stgStdHeapOcc
404 Just SingleEntry -> stgNoUpdHeapOcc
405 other -> panic "varsApp"
407 | otherwise -> stgNormalOcc
408 -- record only that it occurs free
410 other -> NoStgBinderInfo
411 -- uninteresting variable
413 myself = singletonUniqSet f
415 fun_escs = case how_bound of
417 LetrecBound _ arity lvs ->
418 if arity == n_args then
419 emptyUniqSet -- Function doesn't escape
421 myself -- Inexact application; it does escape
423 other -> emptyUniqSet -- Only letrec-bound escapees
426 -- At the moment of the call:
428 -- either the function is *not* let-no-escaped, in which case
429 -- nothing is live except live_in_cont
430 -- or the function *is* let-no-escaped in which case the
431 -- variables it uses are live, but still the function
432 -- itself is not. PS. In this case, the function's
433 -- live vars should already include those of the
434 -- continuation, but it does no harm to just union the
438 = live_in_cont `unionUniqSets` case how_bound of
439 LetrecBound _ _ lvs -> lvs `minusUniqSet` myself
440 other -> emptyUniqSet
443 StgApp (StgVarAtom f) args live_at_call,
444 fun_fvs `unionFVInfo` args_fvs,
445 fun_escs `unionUniqSets` (getFVSet args_fvs)
446 -- All the free vars of the args are disqualified
447 -- from being let-no-escaped.
453 vars_let :: Bool -- True <=> yes, we are let-no-escaping this let
454 -> PlainStgBinding -- bindings
455 -> PlainStgExpr -- body
456 -> LneM (PlainStgExpr, -- new let
457 FreeVarsInfo, -- variables free in the whole let
458 EscVarsSet, -- variables that escape from the whole let
459 Bool) -- True <=> none of the binders in the bindings
460 -- is among the escaping vars
462 vars_let let_no_escape bind body
463 = fixLne (\ ~(_, _, _, rec_bind_lvs, _, rec_body_fvs, _, _) ->
465 -- Do the bindings, setting live_in_cont to empty if
466 -- we ain't in a let-no-escape world
467 getVarsLiveInCont `thenLne` \ live_in_cont ->
469 (if let_no_escape then live_in_cont else emptyUniqSet)
470 (vars_bind rec_bind_lvs rec_body_fvs bind)
471 `thenLne` \ (bind2, bind_fvs, bind_escs, env_ext) ->
473 -- The live variables of this binding are the ones which are live
474 -- by virtue of being accessible via the free vars of the binding (lvs_from_fvs)
475 -- together with the live_in_cont ones
476 lookupLiveVarsForSet (bind_fvs `minusFVBinders` binders) `thenLne` \ lvs_from_fvs ->
478 bind_lvs = lvs_from_fvs `unionUniqSets` live_in_cont
481 -- bind_fvs and bind_escs still include the binders of the let(rec)
482 -- but bind_lvs does not
485 extendVarEnv env_ext (
486 varsExpr body `thenLne` \ (body2, body_fvs, body_escs) ->
487 lookupLiveVarsForSet body_fvs `thenLne` \ body_lvs ->
489 returnLne (bind2, bind_fvs, bind_escs, bind_lvs,
490 body2, body_fvs, body_escs, body_lvs)
492 )) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs,
493 body2, body_fvs, body_escs, body_lvs) ->
496 -- Compute the new let-expression
498 new_let = if let_no_escape then
499 -- trace "StgLetNoEscape!" (
500 StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
506 = (bind_fvs `unionFVInfo` body_fvs) `minusFVBinders` binders
509 = bind_lvs `unionUniqSets` (body_lvs `minusUniqSet` set_of_binders)
511 real_bind_escs = if let_no_escape then
515 -- Everything escapes which is free in the bindings
517 let_escs = (real_bind_escs `unionUniqSets` body_escs) `minusUniqSet` set_of_binders
519 all_escs = bind_escs `unionUniqSets` body_escs -- Still includes binders of
522 no_binder_escapes = isEmptyUniqSet (set_of_binders `intersectUniqSets` all_escs)
523 -- Mustn't depend on the passed-in let_no_escape flag, since
524 -- no_binder_escapes is used by the caller to derive the flag!
533 binders = case bind of
534 StgNonRec binder rhs -> [binder]
535 StgRec pairs -> map fst pairs
536 set_of_binders = mkUniqSet binders
538 mk_binding bind_lvs (binder,rhs)
540 LetrecBound False -- Not top level
545 live_vars = if let_no_escape then
546 bind_lvs `unionUniqSets` singletonUniqSet binder
548 singletonUniqSet binder
550 vars_bind :: PlainStgLiveVars
551 -> FreeVarsInfo -- Free var info for body of binding
553 -> LneM (PlainStgBinding,
554 FreeVarsInfo, EscVarsSet, -- free vars; escapee vars
556 -- extension to environment
558 vars_bind rec_bind_lvs rec_body_fvs (StgNonRec binder rhs)
559 = varsRhs rec_body_fvs (binder,rhs) `thenLne` \ (rhs2, fvs, escs) ->
561 env_ext = [mk_binding rec_bind_lvs (binder,rhs)]
563 returnLne (StgNonRec binder rhs2, fvs, escs, env_ext)
565 vars_bind rec_bind_lvs rec_body_fvs (StgRec pairs)
567 (binders, rhss) = unzip pairs
568 env_ext = map (mk_binding rec_bind_lvs) pairs
570 extendVarEnv env_ext (
571 fixLne (\ ~(_, rec_rhs_fvs, _, _) ->
573 rec_scope_fvs = unionFVInfo rec_body_fvs rec_rhs_fvs
575 mapAndUnzip3Lne (varsRhs rec_scope_fvs) pairs `thenLne` \ (rhss2, fvss, escss) ->
577 fvs = unionFVInfos fvss
578 escs = unionManyUniqSets escss
580 returnLne (StgRec (binders `zip` rhss2), fvs, escs, env_ext)
584 %************************************************************************
586 \subsection[LNE-monad]{A little monad for this let-no-escaping pass}
588 %************************************************************************
590 There's a lot of stuff to pass around, so we use this @LneM@ monad to
591 help. All the stuff here is only passed {\em down}.
594 type LneM a = Bool -- True <=> do let-no-escapes
596 -> PlainStgLiveVars -- vars live in continuation
606 Bool -- True <=> bound at top level
608 PlainStgLiveVars -- Live vars... see notes below
611 For a let(rec)-bound variable, x, we record what varibles are live if
612 x is live. For "normal" variables that is just x alone. If x is
613 a let-no-escaped variable then x is represented by a code pointer and
614 a stack pointer (well, one for each stack). So all of the variables
615 needed in the execution of x are live if x is, and are therefore recorded
616 in the LetrecBound constructor; x itself *is* included.
618 The std monad functions:
620 initLne :: Bool -> LneM a -> a
621 initLne want_LNEs m = m want_LNEs nullIdEnv emptyUniqSet
623 #ifdef __GLASGOW_HASKELL__
624 {-# INLINE thenLne #-}
625 {-# INLINE thenLne_ #-}
626 {-# INLINE returnLne #-}
629 returnLne :: a -> LneM a
630 returnLne e sw env lvs_cont = e
632 thenLne :: LneM a -> (a -> LneM b) -> LneM b
633 (m `thenLne` k) sw env lvs_cont
634 = case (m sw env lvs_cont) of
635 m_result -> k m_result sw env lvs_cont
637 thenLne_ :: LneM a -> LneM b -> LneM b
638 (m `thenLne_` k) sw env lvs_cont
639 = case (m sw env lvs_cont) of
640 _ -> k sw env lvs_cont
642 mapLne :: (a -> LneM b) -> [a] -> LneM [b]
643 mapLne f [] = returnLne []
645 = f x `thenLne` \ r ->
646 mapLne f xs `thenLne` \ rs ->
649 mapAndUnzipLne :: (a -> LneM (b,c)) -> [a] -> LneM ([b],[c])
651 mapAndUnzipLne f [] = returnLne ([],[])
652 mapAndUnzipLne f (x:xs)
653 = f x `thenLne` \ (r1, r2) ->
654 mapAndUnzipLne f xs `thenLne` \ (rs1, rs2) ->
655 returnLne (r1:rs1, r2:rs2)
657 mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
659 mapAndUnzip3Lne f [] = returnLne ([],[],[])
660 mapAndUnzip3Lne f (x:xs)
661 = f x `thenLne` \ (r1, r2, r3) ->
662 mapAndUnzip3Lne f xs `thenLne` \ (rs1, rs2, rs3) ->
663 returnLne (r1:rs1, r2:rs2, r3:rs3)
665 fixLne :: (a -> LneM a) -> LneM a
666 fixLne expr sw env lvs_cont = result
668 result = expr result sw env lvs_cont
669 -- ^^^^^^ ------ ^^^^^^
672 Functions specific to this monad:
675 ifSwitchSetLne :: GlobalSwitch -> LneM a -> LneM a -> LneM a
676 ifSwitchSetLne switch then_ else_ switch_checker env lvs_cont
677 = (if switch_checker switch then then_ else else_) switch_checker env lvs_cont
680 isSwitchSetLne :: LneM Bool
681 isSwitchSetLne want_LNEs env lvs_cont
684 getVarsLiveInCont :: LneM PlainStgLiveVars
685 getVarsLiveInCont sw env lvs_cont = lvs_cont
687 setVarsLiveInCont :: PlainStgLiveVars -> LneM a -> LneM a
688 setVarsLiveInCont new_lvs_cont expr sw env lvs_cont
689 = expr sw env new_lvs_cont
691 extendVarEnv :: [(Id, HowBound)] -> LneM a -> LneM a
692 extendVarEnv extension expr sw env lvs_cont
693 = expr sw (growIdEnvList env extension) lvs_cont
695 lookupVarEnv :: Id -> LneM HowBound
696 lookupVarEnv v sw env lvs_cont
698 case (lookupIdEnv env v) of
700 Nothing -> --false:ASSERT(not (isLocallyDefined v))
704 -- The result of lookupLiveVarsForSet, a set of live variables, is
705 -- only ever tacked onto a decorated expression. It is never used as
706 -- the basis of a control decision, which might give a black hole.
708 lookupLiveVarsForSet :: FreeVarsInfo -> LneM PlainStgLiveVars
710 lookupLiveVarsForSet fvs sw env lvs_cont
711 = returnLne (unionManyUniqSets (map do_one (getFVs fvs)))
715 = if isLocallyDefined v then
716 case (lookupIdEnv env v) of
717 Just (LetrecBound _ _ lvs) -> lvs `unionUniqSets` singletonUniqSet v
718 Just _ -> singletonUniqSet v
719 Nothing -> pprPanic "lookupVarEnv/do_one:" (ppr PprShowAll v)
725 %************************************************************************
727 \subsection[Free-var info]{Free variable information}
729 %************************************************************************
732 type FreeVarsInfo = IdEnv (Id, Bool, StgBinderInfo)
733 -- If f is mapped to NoStgBinderInfo, that means
734 -- that f *is* mentioned (else it wouldn't be in the
735 -- IdEnv at all), but only in a saturated applications.
737 -- All case/lambda-bound things are also mapped to
738 -- NoStgBinderInfo, since we aren't interested in their
741 -- The Bool is True <=> the Id is top level letrec bound
743 type EscVarsSet = UniqSet Id
747 emptyFVInfo :: FreeVarsInfo
748 emptyFVInfo = nullIdEnv
750 singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
751 singletonFVInfo id ImportBound info = nullIdEnv
752 singletonFVInfo id (LetrecBound top_level _ _) info = unitIdEnv id (id, top_level, info)
753 singletonFVInfo id other info = unitIdEnv id (id, False, info)
755 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
756 unionFVInfo fv1 fv2 = combineIdEnvs plusFVInfo fv1 fv2
758 unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
759 unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
761 minusFVBinders :: FreeVarsInfo -> [Id] -> FreeVarsInfo
762 minusFVBinders fv ids = fv `delManyFromIdEnv` ids
764 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
765 elementOfFVInfo id fvs = maybeToBool (lookupIdEnv fvs id)
767 lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
768 lookupFVInfo fvs id = case lookupIdEnv fvs id of
769 Nothing -> NoStgBinderInfo
770 Just (_,_,info) -> info
772 getFVs :: FreeVarsInfo -> [Id] -- Non-top-level things only
773 getFVs fvs = [id | (id,False,_) <- rngIdEnv fvs]
775 getFVSet :: FreeVarsInfo -> UniqSet Id
776 getFVSet fvs = mkUniqSet (getFVs fvs)
778 plusFVInfo (id1,top1,info1) (id2,top2,info2)
779 = ASSERT (id1 == id2 && top1 == top2)
780 (id1, top1, combineStgBinderInfo info1 info2)
784 rhsArity :: PlainStgRhs -> Arity
785 rhsArity (StgRhsCon _ _ _) = 0
786 rhsArity (StgRhsClosure _ _ _ _ args _) = length args