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