2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 % $Id: CgLetNoEscape.lhs,v 1.21 2003/07/02 13:12:37 simonpj Exp $
6 %********************************************************
8 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
10 %********************************************************
13 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
15 #include "HsVersions.h"
17 import {-# SOURCE #-} CgExpr ( cgExpr )
23 import CgBindery ( CgIdInfo, letNoEscapeIdInfo, nukeDeadBindings )
24 import CgCase ( mkRetDirectTarget, restoreCurrentCostCentre )
25 import CgCon ( bindUnboxedTupleComponents )
26 import CgHeapery ( unbxTupleHeapCheck )
27 import CgStackery ( allocStackTop, deAllocStackTop )
28 import CgUsages ( getSpRelOffset )
29 import CLabel ( mkReturnInfoLabel )
30 import ClosureInfo ( mkLFLetNoEscape )
31 import CostCentre ( CostCentreStack )
33 import Var ( idUnique )
34 import PrimRep ( PrimRep(..), retPrimRepSize )
35 import BasicTypes ( RecFlag(..) )
38 %************************************************************************
40 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
42 %************************************************************************
44 [The {\em code} that detects these things is elsewhere.]
48 let x = fvs \ args -> e
51 if ... then x else ...
53 @x@ is used twice (so we probably can't unfold it), but when it is
54 entered, the stack is deeper than it was when the definition of @x@
55 happened. Specifically, if instead of allocating a closure for @x@,
56 we saved all @x@'s fvs on the stack, and remembered the stack depth at
57 that moment, then whenever we enter @x@ we can simply set the stack
58 pointer(s) to these remembered (compile-time-fixed) values, and jump
61 All of this is provided x is:
66 guaranteed to be entered before the stack retreats -- ie x is not
67 buried in a heap-allocated closure, or passed as an argument to something;
69 all the enters have exactly the right number of arguments,
72 all the enters are tail calls; that is, they return to the
73 caller enclosing the definition of @x@.
76 Under these circumstances we say that @x@ is {\em non-escaping}.
78 An example of when (4) does {\em not} hold:
81 in case x of ...alts...
84 Here, @x@ is certainly entered only when the stack is deeper than when
85 @x@ is defined, but here it must return to \tr{...alts...} So we can't
86 just adjust the stack down to @x@'s recalled points, because that
87 would lost @alts@' context.
89 Things can get a little more complicated. Consider:
92 in let x = fvs \ args -> ...y...
96 Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
97 @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
100 @x@ can even be recursive! Eg:
102 letrec x = [y] \ [v] -> if v then x True else ...
108 %************************************************************************
110 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
112 %************************************************************************
115 Generating code for this is fun. It is all very very similar to what
116 we do for a case expression. The duality is between
126 That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
127 the alternative of the case; it needs to be compiled in an environment
128 in which all volatile bindings are forgotten, and the free vars are
129 bound only to stable things like stack locations.. The @e@ part will
130 execute {\em next}, just like the scrutinee of a case.
132 First, we need to save all @x@'s free vars
133 on the stack, if they aren't there already.
138 -> CostCentreStack -- NB: *** NOT USED *** ToDo (WDP 94/06)
139 -> StgBinderInfo -- NB: ditto
141 -> StgLiveVars -- variables live in RHS, including the binders
142 -- themselves in the case of a recursive group
143 -> EndOfBlockInfo -- where are we going to?
144 -> Maybe VirtualSpOffset -- Slot for current cost centre
145 -> RecFlag -- is the binding recursive?
146 -> [Id] -- args (as in \ args -> body)
147 -> StgExpr -- body (as in above)
148 -> FCode (Id, CgIdInfo)
150 -- ToDo: deal with the cost-centre issues
153 bndr cc binder_info srt full_live_in_rhss
154 rhs_eob_info cc_slot rec args body
157 lf_info = mkLFLetNoEscape arity
160 -- saveVolatileVarsAndRegs done earlier in cgExpr.
165 (allocStackTop retPrimRepSize `thenFC` \_ ->
166 nukeDeadBindings full_live_in_rhss)
168 (deAllocStackTop retPrimRepSize `thenFC` \_ ->
170 -- TEMP omit for line-by-line compatibility
171 -- restoreCurrentCostCentre cc_slot `thenC`
172 cgLetNoEscapeBody bndr cc args body
173 ) `thenFC` \ abs_c ->
174 mkRetDirectTarget bndr abs_c srt
175 -- Ignore the label that comes back from
176 -- mkRetDirectTarget. It must be conjured up elswhere
177 ) `thenFC` \ (vSp, _) ->
179 returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info)
183 cgLetNoEscapeBody :: Id -- Name of the joint point
189 cgLetNoEscapeBody bndr cc all_args body
190 = bindUnboxedTupleComponents all_args `thenFC` \ (arg_regs, ptrs, nptrs, ret_slot) ->
192 -- Enter the closures cc, if required
193 --enterCostCentreCode closure_info cc IsFunction `thenC`
195 -- The "return address" slot doesn't have a return address in it;
196 -- but the heap-check needs it filled in if the heap-check fails.
197 -- So we pass code to fill it in to the heap-check macro
198 getSpRelOffset ret_slot `thenFC` \ sp_rel ->
199 let lbl = mkReturnInfoLabel (idUnique bndr)
200 frame_hdr_asst = CAssign (CVal sp_rel RetRep) (CLbl lbl RetRep)
203 -- Do heap check [ToDo: omit for non-recursive case by recording in
204 -- in envt and absorbing at call site]
205 unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst (