Fix scoped type variables for expression type signatures
[ghc-hetmet.git] / compiler / codeGen / CgLetNoEscape.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
3 %
4 % $Id: CgLetNoEscape.lhs,v 1.26 2004/09/30 10:35:47 simonpj Exp $
5 %
6 %********************************************************
7 %*                                                      *
8 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
9 %*                                                      *
10 %********************************************************
11
12 \begin{code}
13 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
14
15 #include "HsVersions.h"
16
17 import {-# SOURCE #-} CgExpr ( cgExpr )
18
19 import StgSyn
20 import CgMonad
21
22 import CgBindery        ( CgIdInfo, letNoEscapeIdInfo, nukeDeadBindings )
23 import CgCase           ( restoreCurrentCostCentre )
24 import CgCon            ( bindUnboxedTupleComponents )
25 import CgHeapery        ( unbxTupleHeapCheck )
26 import CgInfoTbls       ( emitDirectReturnTarget )
27 import CgStackery       ( allocStackTop, deAllocStackTop, getSpRelOffset )
28 import Cmm              ( CmmStmt(..) )
29 import CmmUtils         ( mkLblExpr, oneStmt )
30 import CLabel           ( mkReturnInfoLabel )
31 import ClosureInfo      ( mkLFLetNoEscape )
32 import CostCentre       ( CostCentreStack )
33 import Id               ( Id, idName )
34 import Var              ( idUnique )
35 import SMRep            ( retAddrSizeW )
36 import BasicTypes       ( RecFlag(..) )
37 \end{code}
38
39 %************************************************************************
40 %*                                                                      *
41 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
42 %*                                                                      *
43 %************************************************************************
44
45 [The {\em code} that detects these things is elsewhere.]
46
47 Consider:
48 \begin{verbatim}
49         let x = fvs \ args -> e
50         in
51                 if ... then x else
52                 if ... then x else ...
53 \end{verbatim}
54 @x@ is used twice (so we probably can't unfold it), but when it is
55 entered, the stack is deeper than it was when the definition of @x@
56 happened.  Specifically, if instead of allocating a closure for @x@,
57 we saved all @x@'s fvs on the stack, and remembered the stack depth at
58 that moment, then whenever we enter @x@ we can simply set the stack
59 pointer(s) to these remembered (compile-time-fixed) values, and jump
60 to the code for @x@.
61
62 All of this is provided x is:
63 \begin{enumerate}
64 \item
65 non-updatable;
66 \item
67 guaranteed to be entered before the stack retreats -- ie x is not
68 buried in a heap-allocated closure, or passed as an argument to something;
69 \item
70 all the enters have exactly the right number of arguments,
71 no more no less;
72 \item
73 all the enters are tail calls; that is, they return to the
74 caller enclosing the definition of @x@.
75 \end{enumerate}
76
77 Under these circumstances we say that @x@ is {\em non-escaping}.
78
79 An example of when (4) does {\em not} hold:
80 \begin{verbatim}
81         let x = ...
82         in case x of ...alts...
83 \end{verbatim}
84
85 Here, @x@ is certainly entered only when the stack is deeper than when
86 @x@ is defined, but here it must return to \tr{...alts...} So we can't
87 just adjust the stack down to @x@'s recalled points, because that
88 would lost @alts@' context.
89
90 Things can get a little more complicated.  Consider:
91 \begin{verbatim}
92         let y = ...
93         in let x = fvs \ args -> ...y...
94         in ...x...
95 \end{verbatim}
96
97 Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
98 @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
99 non-escaping.
100
101 @x@ can even be recursive!  Eg:
102 \begin{verbatim}
103         letrec x = [y] \ [v] -> if v then x True else ...
104         in
105                 ...(x b)...
106 \end{verbatim}
107
108
109 %************************************************************************
110 %*                                                                      *
111 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
112 %*                                                                      *
113 %************************************************************************
114
115
116 Generating code for this is fun.  It is all very very similar to what
117 we do for a case expression.  The duality is between
118 \begin{verbatim}
119         let-no-escape x = b
120         in e
121 \end{verbatim}
122 and
123 \begin{verbatim}
124         case e of ... -> b
125 \end{verbatim}
126
127 That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
128 the alternative of the case; it needs to be compiled in an environment
129 in which all volatile bindings are forgotten, and the free vars are
130 bound only to stable things like stack locations..  The @e@ part will
131 execute {\em next}, just like the scrutinee of a case.
132
133 First, we need to save all @x@'s free vars
134 on the stack, if they aren't there already.
135
136 \begin{code}
137 cgLetNoEscapeClosure
138         :: Id                   -- binder
139         -> CostCentreStack      -- NB: *** NOT USED *** ToDo (WDP 94/06)
140         -> StgBinderInfo        -- NB: ditto
141         -> SRT
142         -> StgLiveVars          -- variables live in RHS, including the binders
143                                 -- themselves in the case of a recursive group
144         -> EndOfBlockInfo       -- where are we going to?
145         -> Maybe VirtualSpOffset -- Slot for current cost centre
146         -> RecFlag              -- is the binding recursive?
147         -> [Id]                 -- args (as in \ args -> body)
148         -> StgExpr              -- body (as in above)
149         -> FCode (Id, CgIdInfo)
150
151 -- ToDo: deal with the cost-centre issues
152
153 cgLetNoEscapeClosure 
154         bndr cc binder_info srt full_live_in_rhss 
155         rhs_eob_info cc_slot rec args body
156   = let
157         arity   = length args
158         lf_info = mkLFLetNoEscape arity
159     in
160     -- saveVolatileVarsAndRegs done earlier in cgExpr.
161
162     do  { (vSp, _) <- forkEvalHelp rhs_eob_info
163
164                 (do { allocStackTop retAddrSizeW
165                     ; nukeDeadBindings full_live_in_rhss })
166
167                 (do { deAllocStackTop retAddrSizeW
168                     ; abs_c <- forkProc $ cgLetNoEscapeBody bndr cc 
169                                                   cc_slot args body
170
171                         -- Ignore the label that comes back from
172                         -- mkRetDirectTarget.  It must be conjured up elswhere
173                     ; emitDirectReturnTarget (idName bndr) abs_c srt
174                     ; return () })
175
176         ; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) }
177 \end{code}
178
179 \begin{code}
180 cgLetNoEscapeBody :: Id         -- Name of the joint point
181                   -> CostCentreStack
182                   -> Maybe VirtualSpOffset
183                   -> [Id]       -- Args
184                   -> StgExpr    -- Body
185                   -> Code
186
187 cgLetNoEscapeBody bndr cc cc_slot all_args body = do
188   { (arg_regs, ptrs, nptrs, ret_slot) <- bindUnboxedTupleComponents all_args
189
190      -- restore the saved cost centre.  BUT: we must not free the stack slot
191      -- containing the cost centre, because it might be needed for a
192      -- recursive call to this let-no-escape.
193   ; restoreCurrentCostCentre cc_slot False{-don't free-}
194
195         -- Enter the closures cc, if required
196   ; -- enterCostCentreCode closure_info cc IsFunction
197
198         -- The "return address" slot doesn't have a return address in it;
199         -- but the heap-check needs it filled in if the heap-check fails.
200         -- So we pass code to fill it in to the heap-check macro
201   ; sp_rel <- getSpRelOffset ret_slot
202
203   ; let lbl            = mkReturnInfoLabel (idUnique bndr)
204         frame_hdr_asst = oneStmt (CmmStore sp_rel (mkLblExpr lbl))
205
206         -- Do heap check [ToDo: omit for non-recursive case by recording in
207         --      in envt and absorbing at call site]
208   ; unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst 
209                         (cgExpr body)
210   }
211 \end{code}