%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19931998
%
%********************************************************
%* *
\section[CgLetNoEscape]{Handling ``letnoescapes''}
%* *
%********************************************************
\begin{code}
module CgLetNoEscape ( cgLetNoEscapeClosure ) where
#include "HsVersions.h"
import CgExpr ( cgExpr )
import StgSyn
import CgMonad
import CgBindery
import CgCase
import CgCon
import CgHeapery
import CgInfoTbls
import CgStackery
import Cmm
import CmmUtils
import CLabel
import ClosureInfo
import CostCentre
import Id
import SMRep
import BasicTypes
\end{code}
%************************************************************************
%* *
\subsection[whatisnonescaping]{What {\em is} a ``nonescaping let''?}
%* *
%************************************************************************
[The {\em code} that detects these things is elsewhere.]
Consider:
\begin{verbatim}
let x = fvs \ args -> e
in
if ... then x else
if ... then x else ...
\end{verbatim}
@x@ is used twice (so we probably can't unfold it), but when it is
entered, the stack is deeper than it was when the definition of @x@
happened. Specifically, if instead of allocating a closure for @x@,
we saved all @x@'s fvs on the stack, and remembered the stack depth at
that moment, then whenever we enter @x@ we can simply set the stack
pointer(s) to these remembered (compiletimefixed) values, and jump
to the code for @x@.
All of this is provided x is:
\begin{enumerate}
\item
nonupdatable;
\item
guaranteed to be entered before the stack retreats
buried in a heapallocated closure, or passed as an argument to something;
\item
all the enters have exactly the right number of arguments,
no more no less;
\item
all the enters are tail calls; that is, they return to the
caller enclosing the definition of @x@.
\end{enumerate}
Under these circumstances we say that @x@ is {\em nonescaping}.
An example of when (4) does {\em not} hold:
\begin{verbatim}
let x = ...
in case x of ...alts...
\end{verbatim}
Here, @x@ is certainly entered only when the stack is deeper than when
@x@ is defined, but here it must return to \tr{...alts...} So we can't
just adjust the stack down to @x@'s recalled points, because that
would lost @alts@' context.
Things can get a little more complicated. Consider:
\begin{verbatim}
let y = ...
in let x = fvs \ args -> ...y...
in ...x...
\end{verbatim}
Now, if @x@ is used in a nonescaping way in \tr{...x...}, {\em and}
@y@ is used in a nonescaping way in \tr{...y...}, {\em then} @y@ is
nonescaping.
@x@ can even be recursive! Eg:
\begin{verbatim}
letrec x = [y] \ [v] -> if v then x True else ...
in
...(x b)...
\end{verbatim}
%************************************************************************
%* *
\subsection[codeGenfornonescaping]{Generating code for a ``nonescaping let''}
%* *
%************************************************************************
Generating code for this is fun. It is all very very similar to what
we do for a case expression. The duality is between
\begin{verbatim}
letnoescape x = b
in e
\end{verbatim}
and
\begin{verbatim}
case e of ... -> b
\end{verbatim}
That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
the alternative of the case; it needs to be compiled in an environment
in which all volatile bindings are forgotten, and the free vars are
bound only to stable things like stack locations.. The @e@ part will
execute {\em next}, just like the scrutinee of a case.
First, we need to save all @x@'s free vars
on the stack, if they aren't there already.
\begin{code}
cgLetNoEscapeClosure
:: Id
-> CostCentreStack
-> StgBinderInfo
-> StgLiveVars
-> EndOfBlockInfo
-> Maybe VirtualSpOffset
-> RecFlag
-> [Id]
-> StgExpr
-> FCode (Id, CgIdInfo)
cgLetNoEscapeClosure
bndr cc _ full_live_in_rhss
rhs_eob_info cc_slot _ args body
= let
arity = length args
lf_info = mkLFLetNoEscape arity
in
do { (vSp, _) <- forkEvalHelp rhs_eob_info
(do { allocStackTop retAddrSizeW
; nukeDeadBindings full_live_in_rhss })
(do { deAllocStackTop retAddrSizeW
; abs_c <- forkProc $ cgLetNoEscapeBody bndr cc
cc_slot args body
; _ <- emitReturnTarget (idName bndr) abs_c
; return () })
; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) }
\end{code}
\begin{code}
cgLetNoEscapeBody :: Id
-> CostCentreStack
-> Maybe VirtualSpOffset
-> [Id]
-> StgExpr
-> Code
cgLetNoEscapeBody bndr _ cc_slot all_args body = do
{ (arg_regs, ptrs, nptrs, ret_slot) <- bindUnboxedTupleComponents all_args
; restoreCurrentCostCentre cc_slot False
;
; sp_rel <- getSpRelOffset ret_slot
; let lbl = mkReturnInfoLabel (idUnique bndr)
frame_hdr_asst = oneStmt (CmmStore sp_rel (mkLblExpr lbl))
; unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst
(cgExpr body)
}
\end{code}