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