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, okToInline,
  18
  19         addBinderInfo, orBinderInfo, andBinderInfo,
  20
  21         argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
  22         markMany, markDangerousToDup, markInsideSCC,
  23         getBinderInfoArity,
  24         setBinderInfoArityToZero,
  25
  26         isFun, isDupDanger -- for Simon Marlow deforestation
  27     ) where
  28
  29 IMP_Ubiq(){-uitous-}
  30
  31 import CoreUnfold       ( FormSummary(..) )
  32 import Pretty
  33 import Util             ( panic )
  34 \end{code}
  35
  36 The @BinderInfo@ describes how a variable is used in a given scope.
  37
  38 NOTE: With SCCs we have to be careful what we unfold! We don't want to
  39 change the attribution of execution costs. If we decide to unfold
  40 within an SCC we can tag the definition as @DontKeepBinder@.
  41 Definitions tagged as @KeepBinder@ are discarded when we enter the
  42 scope of an SCC.
  43
  44 \begin{code}
  45 data BinderInfo
  46   = DeadCode    -- Dead code; discard the binding.
  47
  48   | ManyOcc     -- Everything else besides DeadCode and OneOccs
  49
  50         Int     -- number of arguments on stack when called; this is a minimum guarantee
  51
  52
  53   | OneOcc      -- Just one occurrence (or one each in
  54                 -- mutually-exclusive case alts).
  55
  56       FunOrArg  -- How it occurs
  57
  58       DuplicationDanger
  59
  60       InsideSCC
  61
  62       Int       -- Number of mutually-exclusive case alternatives
  63                 -- in which it occurs
  64
  65                 -- Note that we only worry about the case-alt counts
  66                 -- if the OneOcc is substitutable -- that's the only
  67                 -- time we *use* the info; we could be more clever for
  68                 -- other cases if we really had to. (WDP/PS)
  69
  70       Int       -- number of arguments on stack when called; minimum guarantee
  71
  72 -- In general, we are feel free to substitute unless
  73 -- (a) is in an argument position (ArgOcc)
  74 -- (b) is inside a lambda [or type lambda?] (DupDanger)
  75 -- (c) is inside an SCC expression (InsideSCC)
  76 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
  77 --      (because the RHS will be inlined regardless of its size)
  78 --      [again, DupDanger]
  79
  80 data FunOrArg
  81   = FunOcc      -- An occurrence in a function position
  82   | ArgOcc      -- Other arg occurrence
  83
  84     -- When combining branches of a case, only report FunOcc if
  85     -- both branches are FunOccs
  86
  87 data DuplicationDanger
  88   = DupDanger   -- Inside a non-linear lambda (that is, a lambda which
  89                 -- is sure to be instantiated only once), or inside
  90                 -- the rhs of an INLINE-pragma'd thing.  Either way,
  91                 -- substituting a redex for this occurrence is
  92                 -- dangerous because it might duplicate work.
  93
  94   | NoDupDanger -- It's ok; substitution won't duplicate work.
  95
  96 data InsideSCC
  97   = InsideSCC       -- Inside an SCC; so be careful when substituting.
  98   | NotInsideSCC    -- It's ok.
  99
 100 noBinderInfo = ManyOcc 0        -- A non-committal value
 101 \end{code}
 102
 103
 104 Predicates
 105 ~~~~~~~~~~
 106
 107 \begin{code}
 108 okToInline
 109         :: FormSummary  -- What the thing to be inlined is like
 110         -> BinderInfo   -- How the thing to be inlined occurs
 111         -> Bool         -- True => it's small enough to inline
 112         -> Bool         -- True => yes, inline it
 113
 114 -- Always inline bottoms
 115 okToInline BottomForm occ_info small_enough
 116   = True        -- Unless one of the type args is unboxed??
 117                 -- This used to be checked for, but I can't
 118                 -- see why so I've left it out.
 119
 120 -- A WHNF can be inlined if it occurs once, or is small
 121 okToInline form occ_info small_enough
 122  | is_whnf_form form
 123  = small_enough || one_occ
 124  where
 125    one_occ = case occ_info of
 126                 OneOcc _ _ _ n_alts _ -> n_alts <= 1
 127                 other                 -> False
 128
 129    is_whnf_form VarForm   = True
 130    is_whnf_form ValueForm = True
 131    is_whnf_form other     = False
 132
 133 -- A non-WHNF can be inlined if it doesn't occur inside a lambda,
 134 -- and occurs exactly once or
 135 --     occurs once in each branch of a case and is small
 136 okToInline OtherForm (OneOcc _ NoDupDanger _ n_alts _) small_enough
 137   = n_alts <= 1 || small_enough
 138
 139 okToInline form any_occ small_enough = False
 140 \end{code}
 141
 142 @inlineUnconditionally@ decides whether a let-bound thing can
 143 definitely be inlined.
 144
 145 \begin{code}
 146 inlineUnconditionally :: Bool -> BinderInfo -> Bool
 147
 148 --inlineUnconditionally ok_to_dup DeadCode = True
 149 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
 150   = n_alt_occs <= 1 || ok_to_dup
 151             -- We [i.e., Patrick] don't mind the code explosion,
 152             -- though.  We could have a flag to limit the
 153             -- damage, e.g., limit to M alternatives.
 154
 155 inlineUnconditionally _ _ = False
 156 \end{code}
 157
 158 \begin{code}
 159 isFun :: FunOrArg -> Bool
 160 isFun FunOcc = True
 161 isFun _ = False
 162
 163 isDupDanger :: DuplicationDanger -> Bool
 164 isDupDanger DupDanger = True
 165 isDupDanger _ = False
 166 \end{code}
 167
 168
 169 Construction
 170 ~~~~~~~~~~~~~
 171 \begin{code}
 172 argOccurrence, funOccurrence :: Int -> BinderInfo
 173
 174 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
 175 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
 176
 177 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
 178
 179 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
 180 markMany (ManyOcc ar)        = ManyOcc ar
 181 markMany DeadCode            = panic "markMany"
 182
 183 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
 184   = OneOcc posn DupDanger in_scc n_alts ar
 185 markDangerousToDup other = other
 186
 187 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
 188
 189 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
 190   = OneOcc posn dup_danger InsideSCC n_alts ar
 191 markInsideSCC other = other
 192
 193 addBinderInfo, orBinderInfo
 194         :: BinderInfo -> BinderInfo -> BinderInfo
 195
 196 addBinderInfo DeadCode info2 = info2
 197 addBinderInfo info1 DeadCode = info1
 198 addBinderInfo info1 info2
 199         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 200
 201 -- (orBinderInfo orig new) is used when combining occurrence
 202 -- info from branches of a case
 203
 204 orBinderInfo DeadCode info2 = info2
 205 orBinderInfo info1 DeadCode = info1
 206 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
 207              (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
 208   = OneOcc (combine_posns posn1 posn2)
 209            (combine_dups  dup1  dup2)
 210            (combine_sccs  scc1  scc2)
 211            (n_alts1 + n_alts2)
 212            (min ar_1 ar_2)
 213 orBinderInfo info1 info2
 214         = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 215
 216 -- (andBinderInfo orig new) is used in two situations:
 217 -- First, when a variable whose occurrence info
 218 --   is currently "orig" is bound to a variable whose occurrence info is "new"
 219 --      eg  (\new -> e) orig
 220 --   What we want to do is to *worsen* orig's info to take account of new's
 221 --
 222 -- second, when completing a let-binding
 223 --      let new = ...orig...
 224 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
 225 -- to worsen this info by the way new occurs in the let body; then we use
 226 -- that to worsen orig's currently recorded occurrence info.
 227
 228 andBinderInfo DeadCode info2 = DeadCode
 229 andBinderInfo info1 DeadCode = DeadCode
 230 andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
 231               (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
 232   = OneOcc (combine_posns posn1 posn2)
 233            (combine_dups  dup1  dup2)
 234            (combine_sccs  scc1  scc2)
 235            (n_alts1 + n_alts2)
 236            ar_1                                 -- Min arity just from orig
 237 andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
 238
 239
 240 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
 241 combine_posns _          _  = ArgOcc
 242
 243 combine_dups DupDanger _ = DupDanger    -- Too paranoid?? ToDo
 244 combine_dups _ DupDanger = DupDanger
 245 combine_dups _ _             = NoDupDanger
 246
 247 combine_sccs InsideSCC _ = InsideSCC    -- Too paranoid?? ToDo
 248 combine_sccs _ InsideSCC = InsideSCC
 249 combine_sccs _ _             = NotInsideSCC
 250
 251 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 252 setBinderInfoArityToZero DeadCode    = DeadCode
 253 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
 254 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
 255 \end{code}
 256
 257 \begin{code}
 258 getBinderInfoArity (DeadCode) = 0
 259 getBinderInfoArity (ManyOcc i) = i
 260 getBinderInfoArity (OneOcc _ _ _ _ i) = i
 261 \end{code}
 262
 263 \begin{code}
 264 instance Outputable BinderInfo where
 265   ppr sty DeadCode     = ppStr "Dead"
 266   ppr sty (ManyOcc ar) = ppBesides [ ppStr "Many-", ppInt ar ]
 267   ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
 268     = ppBesides [ ppStr "One-", pp_posn posn, ppChar '-', pp_danger dup_danger,
 269                   ppChar '-', pp_scc in_scc,  ppChar '-', ppInt n_alts,
 270                   ppChar '-', ppInt ar ]
 271     where
 272       pp_posn FunOcc = ppStr "fun"
 273       pp_posn ArgOcc = ppStr "arg"
 274
 275       pp_danger DupDanger   = ppStr "*dup*"
 276       pp_danger NoDupDanger = ppStr "nodup"
 277
 278       pp_scc InsideSCC    = ppStr "*SCC*"
 279       pp_scc NotInsideSCC = ppStr "noscc"
 280 \end{code}
 281