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