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 module BinderInfo (
  12         BinderInfo(..),
  13         FunOrArg, DuplicationDanger, InsideSCC,  -- NB: all abstract (yay!)
  14
  15         addBinderInfo, orBinderInfo, andBinderInfo,
  16
  17         deadOccurrence, argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
  18
  19         markMany, markDangerousToDup, markInsideSCC,
  20         getBinderInfoArity,
  21         setBinderInfoArityToZero,
  22
  23         okToInline, isOneOcc, isOneFunOcc, isOneSafeFunOcc, isDeadOcc,
  24
  25         isFun, isDupDanger -- for Simon Marlow deforestation
  26     ) where
  27
  28 #include "HsVersions.h"
  29
  30 import Util             ( panic )
  31 import GlaExts          ( Int(..), (+#) )
  32 import Outputable
  33
  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
 105 \begin{code}
 106 isOneOcc :: BinderInfo -> Bool
 107 isOneOcc (OneOcc _ _ _ _ _) = True
 108 isOneOcc other_bind         = False
 109
 110 isOneFunOcc :: BinderInfo -> Bool
 111 isOneFunOcc (OneOcc FunOcc _ _ _ _) = True
 112 isOneFunOcc other_bind              = False
 113
 114 isOneSafeFunOcc :: Bool -> BinderInfo -> Bool
 115 isOneSafeFunOcc ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alts _)
 116   = ok_to_dup || n_alts <= 1
 117 isOneSafeFunOcc ok_to_dup other_bind        = False
 118
 119 isDeadOcc :: BinderInfo -> Bool
 120 isDeadOcc DeadCode = True
 121 isDeadOcc other    = False
 122
 123 isFun :: FunOrArg -> Bool
 124 isFun FunOcc = True
 125 isFun _ = False
 126
 127 isDupDanger :: DuplicationDanger -> Bool
 128 isDupDanger DupDanger = True
 129 isDupDanger _ = False
 130 \end{code}
 131
 132
 133 \begin{code}
 134 okToInline :: Bool              -- The thing is WHNF or bottom;
 135            -> Bool              -- It's small enough to duplicate the code
 136            -> BinderInfo
 137            -> Bool              -- True <=> inline it
 138
 139 -- A non-WHNF can be inlined if it doesn't occur inside a lambda,
 140 -- and occurs exactly once or
 141 --     occurs once in each branch of a case and is small
 142 okToInline False small_enough (OneOcc _ NoDupDanger _ n_alts _)
 143   = n_alts <= 1 || small_enough
 144
 145 -- If the thing isn't a redex, there's no danger of duplicating work,
 146 -- so we can inline if it occurs once, or is small
 147 okToInline True small_enough occ_info
 148  = small_enough || one_occ
 149  where
 150    one_occ = case occ_info of
 151                 OneOcc _ _ _ n_alts _ -> n_alts <= 1
 152                 other                 -> False
 153
 154 okToInline whnf_or_bot small_enough any_occ = False
 155 \end{code}
 156
 157
 158 Construction
 159 ~~~~~~~~~~~~~
 160 \begin{code}
 161 deadOccurrence :: BinderInfo
 162 deadOccurrence = DeadCode
 163
 164 argOccurrence, funOccurrence :: Int -> BinderInfo
 165
 166 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
 167 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
 168
 169 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
 170
 171 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
 172 markMany (ManyOcc ar)        = ManyOcc ar
 173 markMany DeadCode            = panic "markMany"
 174
 175 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
 176   = OneOcc posn DupDanger in_scc n_alts ar
 177 markDangerousToDup other = other
 178
 179 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
 180
 181 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
 182   = OneOcc posn dup_danger InsideSCC n_alts ar
 183 markInsideSCC other = other
 184
 185 addBinderInfo, orBinderInfo
 186         :: BinderInfo -> BinderInfo -> BinderInfo
 187
 188 addBinderInfo DeadCode info2 = info2
 189 addBinderInfo info1 DeadCode = info1
 190 addBinderInfo info1 info2
 191  = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
 192      (I# i#) -> ManyOcc (I# i#)
 193       -- ManyOcc min (getBinderInfoArity info1) (getBinderInfoArity info2))
 194
 195 -- (orBinderInfo orig new) is used when combining occurrence
 196 -- info from branches of a case
 197
 198 orBinderInfo DeadCode info2 = info2
 199 orBinderInfo info1 DeadCode = info1
 200 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
 201              (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
 202   = let
 203       -- Seriously maligned in order to make it stricter,
 204       -- let's hope it is worth it..
 205      posn = combine_posns posn1 posn2
 206      scc  = combine_sccs  scc1  scc2
 207      dup  = combine_dups  dup1  dup2
 208      alts = n_alts1 + n_alts2
 209      ar   = min ar_1 ar_2
 210
 211       -- No CSE, please!
 212      cont1 = case scc  of { InsideSCC -> cont2; _ -> cont2 }
 213      cont2 = case dup  of { DupDanger -> cont3; _ -> cont3 }
 214      cont3 = case alts of { (I# 0#)   -> cont4; _ -> cont4 }
 215      cont4 = case ar   of { (I# 0#)   -> cont5; _ -> cont5 }
 216      cont5 = OneOcc posn dup scc alts ar
 217     in
 218     case posn of { FunOcc -> cont1; _ -> cont1 }
 219 orBinderInfo info1 info2
 220  = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
 221      (I# i#) -> ManyOcc (I# i#)
 222
 223 -- (andBinderInfo orig new) is used in two situations:
 224 -- First, when a variable whose occurrence info
 225 --   is currently "orig" is bound to a variable whose occurrence info is "new"
 226 --      eg  (\new -> e) orig
 227 --   What we want to do is to *worsen* orig's info to take account of new's
 228 --
 229 -- second, when completing a let-binding
 230 --      let new = ...orig...
 231 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
 232 -- to worsen this info by the way new occurs in the let body; then we use
 233 -- that to worsen orig's currently recorded occurrence info.
 234
 235 andBinderInfo DeadCode info2 = DeadCode
 236 andBinderInfo info1 DeadCode = DeadCode
 237 andBinderInfo (OneOcc posn1 dup1 scc1 (I# n_alts1#) (I# ar_1#))
 238               (OneOcc posn2 dup2 scc2 (I# n_alts2#) ar_2)
 239   = let
 240       -- Perversly maligned in order to make it stricter.
 241      posn = combine_posns posn1 posn2
 242      scc  = combine_sccs  scc1  scc2
 243      dup  = combine_dups  dup1  dup2
 244      alts = I# (n_alts1# +# n_alts2#)
 245
 246       -- No CSE, please!
 247      cont1 = case scc  of { InsideSCC -> cont2; _ -> cont2 }
 248      cont2 = case dup  of { DupDanger -> cont3; _ -> cont3 }
 249      cont3 = case alts of { (I# 0#) -> cont4;   _ -> cont4 }
 250      cont4 = OneOcc posn dup scc alts (I# ar_1#)
 251     in
 252     case posn of {FunOcc -> cont1; _ -> cont1}
 253
 254 andBinderInfo info1 info2 =
 255  case getBinderInfoArity info1 of
 256    (I# i#) -> ManyOcc (I# i#)
 257                --ManyOcc (getBinderInfoArity info1)
 258
 259
 260 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
 261 combine_posns _          _  = ArgOcc
 262
 263 combine_dups DupDanger _ = DupDanger    -- Too paranoid?? ToDo
 264 combine_dups _ DupDanger = DupDanger
 265 combine_dups _ _             = NoDupDanger
 266
 267 combine_sccs InsideSCC _ = InsideSCC    -- Too paranoid?? ToDo
 268 combine_sccs _ InsideSCC = InsideSCC
 269 combine_sccs _ _             = NotInsideSCC
 270
 271 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 272 setBinderInfoArityToZero DeadCode    = DeadCode
 273 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
 274 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
 275 \end{code}
 276
 277 \begin{code}
 278 getBinderInfoArity (DeadCode) = 0
 279 getBinderInfoArity (ManyOcc i) = i
 280 getBinderInfoArity (OneOcc _ _ _ _ i) = i
 281 \end{code}
 282
 283 \begin{code}
 284 instance Outputable BinderInfo where
 285   ppr DeadCode     = ptext SLIT("Dead")
 286   ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
 287   ppr (OneOcc posn dup_danger in_scc n_alts ar)
 288     = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
 289                   char '-', pp_scc in_scc,  char '-', int n_alts,
 290                   char '-', int ar ]
 291     where
 292       pp_posn FunOcc = ptext SLIT("fun")
 293       pp_posn ArgOcc = ptext SLIT("arg")
 294
 295       pp_danger DupDanger   = ptext SLIT("*dup*")
 296       pp_danger NoDupDanger = ptext SLIT("nodup")
 297
 298       pp_scc InsideSCC    = ptext SLIT("*SCC*")
 299       pp_scc NotInsideSCC = ptext SLIT("noscc")
 300 \end{code}
 301