ghc/compiler/simplCore/BinderInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[BinderInfo]{Information attached to binders by SubstAnal}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 \begin{code}
  11 #include "HsVersions.h"
  12
  13 module BinderInfo (
  14         BinderInfo(..),
  15         FunOrArg, DuplicationDanger, InsideSCC,  -- NB: all abstract (yay!)
  16
  17         inlineUnconditionally, oneTextualOcc, oneSafeOcc,
  18
  19         combineBinderInfo, combineAltsBinderInfo,
  20
  21         argOccurrence, funOccurrence,
  22         markMany, markDangerousToDup, markInsideSCC,
  23         getBinderInfoArity,
  24         setBinderInfoArityToZero,
  25
  26         isFun, isDupDanger -- for Simon Marlow deforestation
  27     ) where
  28
  29 import Ubiq{-uitous-}
  30
  31 import Pretty
  32 import Util             ( panic )
  33 \end{code}
  34
  35 The @BinderInfo@ describes how a variable is used in a given scope.
  36
  37 NOTE: With SCCs we have to be careful what we unfold! We don't want to
  38 change the attribution of execution costs. If we decide to unfold
  39 within an SCC we can tag the definition as @DontKeepBinder@.
  40 Definitions tagged as @KeepBinder@ are discarded when we enter the
  41 scope of an SCC.
  42
  43 \begin{code}
  44 data BinderInfo
  45   = DeadCode    -- Dead code; discard the binding.
  46
  47   | ManyOcc     -- Everything else besides DeadCode and OneOccs
  48
  49         Int     -- number of arguments on stack when called
  50
  51
  52   | OneOcc      -- Just one occurrence (or one each in
  53                 -- mutually-exclusive case alts).
  54
  55       FunOrArg  -- How it occurs
  56
  57       DuplicationDanger
  58
  59       InsideSCC
  60
  61       Int       -- Number of mutually-exclusive case alternatives
  62                 -- in which it occurs
  63
  64                 -- Note that we only worry about the case-alt counts
  65                 -- if the OneOcc is substitutable -- that's the only
  66                 -- time we *use* the info; we could be more clever for
  67                 -- other cases if we really had to. (WDP/PS)
  68
  69       Int       -- number of arguments on stack when called
  70
  71 -- In general, we are feel free to substitute unless
  72 -- (a) is in an argument position (ArgOcc)
  73 -- (b) is inside a lambda [or type lambda?] (DupDanger)
  74 -- (c) is inside an SCC expression (InsideSCC)
  75 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
  76 --      (because the RHS will be inlined regardless of its size)
  77 --      [again, DupDanger]
  78
  79 data FunOrArg
  80   = FunOcc      -- An occurrence in a function position
  81   | ArgOcc      -- Other arg occurrence
  82
  83     -- When combining branches of a case, only report FunOcc if
  84     -- both branches are FunOccs
  85
  86 data DuplicationDanger
  87   = DupDanger   -- Inside a non-linear lambda (that is, a lambda which
  88                 -- is sure to be instantiated only once), or inside
  89                 -- the rhs of an INLINE-pragma'd thing.  Either way,
  90                 -- substituting a redex for this occurrence is
  91                 -- dangerous because it might duplicate work.
  92
  93   | NoDupDanger -- It's ok; substitution won't duplicate work.
  94
  95 data InsideSCC
  96   = InsideSCC       -- Inside an SCC; so be careful when substituting.
  97   | NotInsideSCC    -- It's ok.
  98 \end{code}
  99
 100
 101 Predicates
 102 ~~~~~~~~~~
 103
 104 @oneTextualOcc@ checks for one occurrence, in any position.
 105 The occurrence may be inside a lambda, that's all right.
 106
 107 \begin{code}
 108 oneTextualOcc :: Bool -> BinderInfo -> Bool
 109
 110 oneTextualOcc ok_to_dup (OneOcc _ _ _ n_alts _) = n_alts <= 1 || ok_to_dup
 111 oneTextualOcc _         other                   = False
 112 \end{code}
 113
 114 @safeSingleOcc@ detects single occurences of values that are safe to
 115 inline, {\em including} ones in an argument position.
 116
 117 \begin{code}
 118 oneSafeOcc :: Bool -> BinderInfo -> Bool
 119 oneSafeOcc ok_to_dup (OneOcc _ NoDupDanger NotInsideSCC n_alts _)
 120                                                      = n_alts <= 1 || ok_to_dup
 121 oneSafeOcc _         other                           = False
 122 \end{code}
 123
 124 @inlineUnconditionally@ decides whether a let-bound thing can
 125 definitely be inlined.
 126
 127 \begin{code}
 128 inlineUnconditionally :: Bool -> BinderInfo -> Bool
 129
 130 --inlineUnconditionally ok_to_dup DeadCode = True
 131 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
 132   = n_alt_occs <= 1 || ok_to_dup
 133             -- We [i.e., Patrick] don't mind the code explosion,
 134             -- though.  We could have a flag to limit the
 135             -- damage, e.g., limit to M alternatives.
 136
 137 inlineUnconditionally _ _ = False
 138 \end{code}
 139
 140 \begin{code}
 141 isFun :: FunOrArg -> Bool
 142 isFun FunOcc = True
 143 isFun _ = False
 144
 145 isDupDanger :: DuplicationDanger -> Bool
 146 isDupDanger DupDanger = True
 147 isDupDanger _ = False
 148 \end{code}
 149
 150
 151 Construction
 152 ~~~~~~~~~~~~~
 153 \begin{code}
 154 argOccurrence, funOccurrence :: Int -> BinderInfo
 155
 156 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
 157 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
 158
 159 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
 160
 161 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
 162 markMany (ManyOcc ar)        = ManyOcc ar
 163 markMany DeadCode            = panic "markMany"
 164
 165 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
 166   = OneOcc posn DupDanger in_scc n_alts ar
 167 markDangerousToDup other = other
 168
 169 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
 170   = OneOcc posn dup_danger InsideSCC n_alts ar
 171 markInsideSCC other = other
 172
 173 combineBinderInfo, combineAltsBinderInfo
 174         :: BinderInfo -> BinderInfo -> BinderInfo
 175
 176 combineBinderInfo DeadCode info2 = info2
 177 combineBinderInfo info1 DeadCode = info1
 178 combineBinderInfo info1 info2
 179         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 180
 181 combineAltsBinderInfo DeadCode info2 = info2
 182 combineAltsBinderInfo info1 DeadCode = info1
 183 combineAltsBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
 184                       (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
 185   = OneOcc (combine_posns posn1 posn2)
 186            (combine_dups  dup1  dup2)
 187            (combine_sccs  scc1  scc2)
 188            (n_alts1 + n_alts2)
 189            (min ar_1 ar_2)
 190   where
 191     combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
 192     combine_posns _      _      = ArgOcc
 193
 194     combine_dups DupDanger _ = DupDanger        -- Too paranoid?? ToDo
 195     combine_dups _ DupDanger = DupDanger
 196     combine_dups _ _         = NoDupDanger
 197
 198     combine_sccs InsideSCC _ = InsideSCC        -- Too paranoid?? ToDo
 199     combine_sccs _ InsideSCC = InsideSCC
 200     combine_sccs _ _         = NotInsideSCC
 201
 202 combineAltsBinderInfo info1 info2
 203         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 204
 205 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 206 setBinderInfoArityToZero DeadCode    = DeadCode
 207 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
 208 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
 209 \end{code}
 210
 211 \begin{code}
 212 getBinderInfoArity (DeadCode) = 0
 213 getBinderInfoArity (ManyOcc i) = i
 214 getBinderInfoArity (OneOcc _ _ _ _ i) = i
 215 \end{code}
 216
 217 \begin{code}
 218 instance Outputable BinderInfo where
 219   ppr sty DeadCode     = ppStr "Dead"
 220   ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
 221   ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
 222     = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
 223                   ppChar '-', pp_scc in_scc,  ppChar '-', ppInt n_alts,
 224                   ppChar '-', ppInt ar ]
 225     where
 226       pp_posn FunOcc = ppStr "fun"
 227       pp_posn ArgOcc = ppStr "arg"
 228
 229       pp_danger DupDanger   = ppStr "*dup*"
 230       pp_danger NoDupDanger = ppStr "nodup"
 231
 232       pp_scc InsideSCC    = ppStr "*SCC*"
 233       pp_scc NotInsideSCC = ppStr "noscc"
 234 \end{code}
 235