ghc/compiler/codeGen/CgLetNoEscape.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1994
   3 %
   4 %********************************************************
   5 %*                                                      *
   6 \section[CgLetNoEscape]{Handling ``let-no-escapes''}
   7 %*                                                      *
   8 %********************************************************
   9
  10 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module CgLetNoEscape ( cgLetNoEscapeClosure ) where
  14
  15 IMP_Ubiq(){-uitious-}
  16 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
  17 IMPORT_DELOOPER(CgLoop2)                ( cgExpr )
  18 #else
  19 import {-# SOURCE #-} CgExpr ( cgExpr )
  20 #endif
  21
  22 import StgSyn
  23 import CgMonad
  24 import AbsCSyn
  25
  26 import CgBindery        ( letNoEscapeIdInfo, bindArgsToRegs,
  27                           bindNewToAStack, bindNewToBStack,
  28                           CgIdInfo
  29                         )
  30 import CgHeapery        ( heapCheck )
  31 import CgRetConv        ( assignRegs )
  32 import CgStackery       ( mkVirtStkOffsets )
  33 import CgUsages         ( setRealAndVirtualSps, getVirtSps )
  34 import CLabel           ( mkStdEntryLabel )
  35 import ClosureInfo      ( mkLFLetNoEscape )
  36 import CostCentre       ( CostCentre )
  37 import HeapOffs         ( SYN_IE(VirtualSpBOffset) )
  38 import Id               ( idPrimRep, SYN_IE(Id) )
  39 \end{code}
  40
  41 %************************************************************************
  42 %*                                                                      *
  43 \subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 [The {\em code} that detects these things is elsewhere.]
  48
  49 Consider:
  50 \begin{verbatim}
  51         let x = fvs \ args -> e
  52         in
  53                 if ... then x else
  54                 if ... then x else ...
  55 \end{verbatim}
  56 @x@ is used twice (so we probably can't unfold it), but when it is
  57 entered, the stack is deeper than it was then the definition of @x@
  58 happened.  Specifically, if instead of allocating a closure for @x@,
  59 we saved all @x@'s fvs on the stack, and remembered the stack depth at
  60 that moment, then whenever we enter @x@ we can simply set the stack
  61 pointer(s) to these remembered (compile-time-fixed) values, and jump
  62 to the code for @x@.
  63
  64 All of this is provided x is:
  65 \begin{enumerate}
  66 \item
  67 non-updatable;
  68 \item
  69 guaranteed to be entered before the stack retreats -- ie x is not
  70 buried in a heap-allocated closure, or passed as an argument to something;
  71 \item
  72 all the enters have exactly the right number of arguments,
  73 no more no less;
  74 \item
  75 all the enters are tail calls; that is, they return to the
  76 caller enclosing the definition of @x@.
  77 \end{enumerate}
  78
  79 Under these circumstances we say that @x@ is {\em non-escaping}.
  80
  81 An example of when (4) does {\em not} hold:
  82 \begin{verbatim}
  83         let x = ...
  84         in case x of ...alts...
  85 \end{verbatim}
  86
  87 Here, @x@ is certainly entered only when the stack is deeper than when
  88 @x@ is defined, but here it must return to \tr{...alts...} So we can't
  89 just adjust the stack down to @x@'s recalled points, because that
  90 would lost @alts@' context.
  91
  92 Things can get a little more complicated.  Consider:
  93 \begin{verbatim}
  94         let y = ...
  95         in let x = fvs \ args -> ...y...
  96         in ...x...
  97 \end{verbatim}
  98
  99 Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
 100 @y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
 101 non-escaping.
 102
 103 @x@ can even be recursive!  Eg:
 104 \begin{verbatim}
 105         letrec x = [y] \ [v] -> if v then x True else ...
 106         in
 107                 ...(x b)...
 108 \end{verbatim}
 109
 110
 111 %************************************************************************
 112 %*                                                                      *
 113 \subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
 114 %*                                                                      *
 115 %************************************************************************
 116
 117
 118 Generating code for this is fun.  It is all very very similar to what
 119 we do for a case expression.  The duality is between
 120 \begin{verbatim}
 121         let-no-escape x = b
 122         in e
 123 \end{verbatim}
 124 and
 125 \begin{verbatim}
 126         case e of ... -> b
 127 \end{verbatim}
 128
 129 That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
 130 the alternative of the case; it needs to be compiled in an environment
 131 in which all volatile bindings are forgotten, and the free vars are
 132 bound only to stable things like stack locations..  The @e@ part will
 133 execute {\em next}, just like the scrutinee of a case.
 134
 135 First, we need to save all @x@'s free vars
 136 on the stack, if they aren't there already.
 137
 138 \begin{code}
 139 cgLetNoEscapeClosure
 140         :: Id                   -- binder
 141         -> CostCentre           -- NB: *** NOT USED *** ToDo (WDP 94/06)
 142         -> StgBinderInfo        -- NB: ditto
 143         -> StgLiveVars  -- variables live in RHS, including the binders
 144                                 -- themselves in the case of a recursive group
 145         -> EndOfBlockInfo       -- where are we going to?
 146         -> Maybe VirtualSpBOffset -- Slot for current cost centre
 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 binder cc bi full_live_in_rhss rhs_eob_info maybe_cc_slot args body
 154   = let
 155         arity   = length args
 156         lf_info = mkLFLetNoEscape arity full_live_in_rhss{-used???-}
 157     in
 158     forkEvalHelp
 159         rhs_eob_info
 160         (nukeDeadBindings full_live_in_rhss)
 161         (forkAbsC (cgLetNoEscapeBody args body))
 162                                         `thenFC` \ (vA, vB, code) ->
 163     let
 164         label = mkStdEntryLabel binder -- arity
 165     in
 166     absC (CCodeBlock label code) `thenC`
 167     returnFC (binder, letNoEscapeIdInfo binder vA vB lf_info)
 168 \end{code}
 169
 170 \begin{code}
 171 cgLetNoEscapeBody :: [Id]               -- Args
 172                   -> StgExpr    -- Body
 173                   -> Code
 174
 175 cgLetNoEscapeBody all_args rhs
 176   = getVirtSps          `thenFC` \ (vA, vB) ->
 177     let
 178         arg_kinds            = map idPrimRep all_args
 179         (arg_regs, _)        = assignRegs [{-nothing live-}] arg_kinds
 180         (reg_args, stk_args) = splitAt (length arg_regs) all_args
 181
 182         -- stk_args is the args which are passed on the stack at the fast-entry point
 183         -- Using them, we define the stack layout
 184         (spA_stk_args, spB_stk_args, stk_bxd_w_offsets, stk_ubxd_w_offsets)
 185           = mkVirtStkOffsets
 186                 vA vB           -- Initial virtual SpA, SpB
 187                 idPrimRep
 188                 stk_args
 189     in
 190
 191         -- Bind args to appropriate regs/stk locns
 192     bindArgsToRegs reg_args arg_regs                `thenC`
 193     mapCs bindNewToAStack stk_bxd_w_offsets         `thenC`
 194     mapCs bindNewToBStack stk_ubxd_w_offsets        `thenC`
 195     setRealAndVirtualSps spA_stk_args spB_stk_args  `thenC`
 196
 197 {-      ToDo: NOT SURE ABOUT COST CENTRES!
 198         -- Enter the closures cc, if required
 199         lexEnterCCcode closure_info maybe_cc        `thenC`
 200 -}
 201
 202         -- [No need for stack check; forkEvalHelp dealt with that]
 203
 204         -- Do heap check [ToDo: omit for non-recursive case by recording in
 205         --      in envt and absorbing at call site]
 206     heapCheck arg_regs False {- Node doesn't point to it -}  (
 207               -- heapCheck *encloses* the rest
 208
 209         -- Compile the body
 210     cgExpr rhs
 211     )
 212 \end{code}