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