-\end{code}
-
-\begin{code}
-computeSRTs :: [StgBinding] -> [(StgBinding,[Id])]
-computeSRTs binds = map srtTopBind binds
-\end{code}
-
------------------------------------------------------------------------------
-Algorithm for figuring out SRT layout.
-
-Our functions have type
-
- :: SrtOffset -- next free offset within the SRT
- -> (UniqSet Id, -- global refs in the continuation
- UniqFM (UniqSet Id))-- global refs in let-no-escaped variables
-{- * -} -> StgExpr -- expression to analyse
-
- -> (StgExpr, -- (e) newly annotated expression
- UniqSet Id, -- (g) global refs from this expression
- [Id], -- (s) SRT required for this expression
- SrtOffset) -- (o) new offset
-
-(g) is a set containing all local top-level and imported ids referred
-to by the expression (e), which have MayHaveCafRefs in their CafInfo.
-
-We build a single SRT for a recursive binding group, which is why the
-SRT building is done at the binding level rather than the
-StgRhsClosure level.
-
-The SRT is built up in reverse order, to avoid too many expensive
-appends. We therefore reverse the SRT before returning it, so that
-the offsets will be from the beginning of the SRT.
-
------------------------------------------------------------------------------
-Top-level Bindings
-
-A function whose CafInfo is NoCafRefs will have an empty SRT, and its
-closure will not appear in the SRT of any other function (unless we're
-compiling without optimisation and the CafInfos haven't been emitted
-in the interface files).
-
-Top-Level recursive groups
-
-This gets a bit complicated, but the general idea is that we want a
-single SRT for the whole group, and we'd rather not have recursive
-references in it if at all possible.
-
-We collect all the global references for the group, and filter out
-those that are binders in the group and not CAFs themselves. Why is
-it done this way?
-
- - if all the bindings in the group just refer to each other,
- and none of them are CAFs, we'd like to get an empty SRT.
-
- - if any of the bindings in the group refer to a CAF, this will
- appear in the SRT.
-
-Hmm, that probably makes no sense.
-
-\begin{code}
-srtTopBind
- :: StgBinding
- -> (StgBinding, -- the new binding
- [Id]) -- the SRT for this binding
-
-srtTopBind (StgNonRec binder rhs) =
-
- -- no need to use circularity for non-recursive bindings
- srtRhs (emptyUniqSet,emptyUFM) 0{-initial offset-} rhs
- =: \(rhs, g, srt, off) ->
- let
- filtered_g = uniqSetToList g
- extra_refs = filter (`notElem` srt) filtered_g
- bind_srt = reverse (extra_refs ++ srt)
- in
- ASSERT2(null bind_srt || idMayHaveCafRefs binder, ppr binder)
-
- case rhs of
- StgRhsClosure _ _ _ _ _ _ _ ->
- (StgNonRec binder (attach_srt_rhs rhs 0 (length bind_srt)),
- bind_srt)
-
- -- don't output an SRT for the constructor
- StgRhsCon _ _ _ -> (StgNonRec binder rhs, [])
-
-
-srtTopBind (StgRec bs) =
- ASSERT(null bind_srt || all idMayHaveCafRefs binders)
- (attach_srt_bind (StgRec new_bs) 0 (length bind_srt), bind_srt)
- where
- (binders,rhss) = unzip bs
-
- non_caf_binders = [ b | (b, rhs) <- bs, not (caf_rhs rhs) ]
-
- (new_bs, g, srt, _) = doBinds bs [] emptyUniqSet [] 0
-
- -- filter out ourselves from the global references: it makes no
- -- sense to refer recursively to our SRT unless the recursive
- -- reference is required by a nested SRT.
- filtered_g = filter (\id -> id `notElem` non_caf_binders) (uniqSetToList g)
- extra_refs = filter (`notElem` srt) filtered_g
- bind_srt = reverse (extra_refs ++ srt)
-
- doBinds [] new_binds g srt off = (reverse new_binds, g, srt, off)
- doBinds ((binder,rhs):binds) new_binds g srt off =
- srtRhs (emptyUniqSet,emptyUFM) off rhs
- =: \(rhs, rhs_g, rhs_srt, off) ->
- let
- g' = unionUniqSets rhs_g g
- srt' = rhs_srt ++ srt
- in
- doBinds binds ((binder,rhs):new_binds) g' srt' off
-
-caf_rhs (StgRhsClosure _ _ _ free_vars _ [] body) = True
-caf_rhs _ = False
-\end{code}
-
------------------------------------------------------------------------------
-Non-top-level bindings
-
-\begin{code}
-srtBind :: (UniqSet Id, UniqFM (UniqSet Id))
- -> Int -> StgBinding -> (StgBinding, UniqSet Id, [Id], Int)
-
-srtBind cont_refs off (StgNonRec binder rhs) =
- srtRhs cont_refs off rhs =: \(rhs, g, srt, off) ->
- (StgNonRec binder rhs, g, srt, off)
-
-srtBind cont_refs off (StgRec binds) =
- (StgRec new_binds, g, srt, new_off)
- where
- -- process each binding
- (new_binds, g, srt, new_off) = doBinds binds emptyUniqSet [] off []
-
- doBinds [] g srt off new_binds = (reverse new_binds, g, srt, off)
- doBinds ((binder,rhs):binds) g srt off new_binds =
- srtRhs cont_refs off rhs =: \(rhs, g', srt', off) ->
- doBinds binds (unionUniqSets g g') (srt'++srt) off
- ((binder,rhs):new_binds)
-\end{code}
-
------------------------------------------------------------------------------
-Right Hand Sides
-
-\begin{code}
-srtRhs :: (UniqSet Id, UniqFM (UniqSet Id))
- -> Int -> StgRhs -> (StgRhs, UniqSet Id, [Id], Int)
-
-srtRhs cont off (StgRhsClosure cc bi old_srt free_vars u args body) =
- srtExpr cont off body =: \(body, g, srt, off) ->
- (StgRhsClosure cc bi old_srt free_vars u args body, g, srt, off)
-
-srtRhs cont off e@(StgRhsCon cc con args) =
- (e, getGlobalRefs args, [], off)
-\end{code}
-
------------------------------------------------------------------------------
-Expressions