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         argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
  20         markMany, markDangerousToDup, markInsideSCC,
  21         getBinderInfoArity,
  22         setBinderInfoArityToZero,
  23
  24         inlineUnconditionally, isFun, isDupDanger -- for Simon Marlow deforestation
  25     ) where
  26
  27 IMP_Ubiq(){-uitous-}
  28
  29 import Pretty
  30 import Util             ( panic )
  31 #if __GLASGOW_HASKELL__ >= 202
  32 import Outputable
  33 #endif
  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 isFun :: FunOrArg -> Bool
 108 isFun FunOcc = True
 109 isFun _ = False
 110
 111 isDupDanger :: DuplicationDanger -> Bool
 112 isDupDanger DupDanger = True
 113 isDupDanger _ = False
 114 \end{code}
 115
 116 @inlineUnconditionally@ decides whether a let-bound thing can
 117 definitely be inlined.
 118
 119 \begin{code}
 120 inlineUnconditionally :: Bool -> BinderInfo -> Bool
 121
 122 --inlineUnconditionally ok_to_dup DeadCode = True
 123 inlineUnconditionally ok_to_dup (OneOcc FunOcc NoDupDanger NotInsideSCC n_alt_occs _)
 124   = n_alt_occs <= 1 || ok_to_dup
 125             -- We [i.e., Patrick] don't mind the code explosion,
 126             -- though.  We could have a flag to limit the
 127             -- damage, e.g., limit to M alternatives.
 128
 129 inlineUnconditionally _ _ = False
 130 \end{code}
 131
 132
 133 Construction
 134 ~~~~~~~~~~~~~
 135 \begin{code}
 136 argOccurrence, funOccurrence :: Int -> BinderInfo
 137
 138 funOccurrence = OneOcc FunOcc NoDupDanger NotInsideSCC 1
 139 argOccurrence = OneOcc ArgOcc NoDupDanger NotInsideSCC 1
 140
 141 markMany, markDangerousToDup, markInsideSCC :: BinderInfo -> BinderInfo
 142
 143 markMany (OneOcc _ _ _ _ ar) = ManyOcc ar
 144 markMany (ManyOcc ar)        = ManyOcc ar
 145 markMany DeadCode            = panic "markMany"
 146
 147 markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
 148   = OneOcc posn DupDanger in_scc n_alts ar
 149 markDangerousToDup other = other
 150
 151 dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
 152
 153 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
 154   = OneOcc posn dup_danger InsideSCC n_alts ar
 155 markInsideSCC other = other
 156
 157 addBinderInfo, orBinderInfo
 158         :: BinderInfo -> BinderInfo -> BinderInfo
 159
 160 addBinderInfo DeadCode info2 = info2
 161 addBinderInfo info1 DeadCode = info1
 162 addBinderInfo info1 info2
 163  = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
 164      (I# i#) -> ManyOcc (I# i#)
 165       -- ManyOcc min (getBinderInfoArity info1) (getBinderInfoArity info2))
 166
 167 -- (orBinderInfo orig new) is used when combining occurrence
 168 -- info from branches of a case
 169
 170 orBinderInfo DeadCode info2 = info2
 171 orBinderInfo info1 DeadCode = info1
 172 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
 173              (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
 174   = let
 175       -- Seriously maligned in order to make it stricter,
 176       -- let's hope it is worth it..
 177      posn = combine_posns posn1 posn2
 178      scc  = combine_sccs  scc1  scc2
 179      dup  = combine_dups  dup1  dup2
 180      alts = n_alts1 + n_alts2
 181      ar   = min ar_1 ar_2
 182
 183       -- No CSE, please!
 184      cont1 = case scc  of { InsideSCC -> cont2; _ -> cont2 }
 185      cont2 = case dup  of { DupDanger -> cont3; _ -> cont3 }
 186      cont3 = case alts of { (I# 0#)   -> cont4; _ -> cont4 }
 187      cont4 = case ar   of { (I# 0#)   -> cont5; _ -> cont5 }
 188      cont5 = OneOcc posn dup scc alts ar
 189     in
 190     case posn of { FunOcc -> cont1; _ -> cont1 }
 191 orBinderInfo info1 info2
 192  = case (min (getBinderInfoArity info1) (getBinderInfoArity info2)) of
 193      (I# i#) -> ManyOcc (I# i#)
 194
 195 -- (andBinderInfo orig new) is used in two situations:
 196 -- First, when a variable whose occurrence info
 197 --   is currently "orig" is bound to a variable whose occurrence info is "new"
 198 --      eg  (\new -> e) orig
 199 --   What we want to do is to *worsen* orig's info to take account of new's
 200 --
 201 -- second, when completing a let-binding
 202 --      let new = ...orig...
 203 -- we compute the way orig occurs in (...orig...), and then use orBinderInfo
 204 -- to worsen this info by the way new occurs in the let body; then we use
 205 -- that to worsen orig's currently recorded occurrence info.
 206
 207 andBinderInfo DeadCode info2 = DeadCode
 208 andBinderInfo info1 DeadCode = DeadCode
 209 andBinderInfo (OneOcc posn1 dup1 scc1 (I# n_alts1#) (I# ar_1#))
 210               (OneOcc posn2 dup2 scc2 (I# n_alts2#) ar_2)
 211   = let
 212       -- Perversly maligned in order to make it stricter.
 213      posn = combine_posns posn1 posn2
 214      scc  = combine_sccs  scc1  scc2
 215      dup  = combine_dups  dup1  dup2
 216      alts = I# (n_alts1# +# n_alts2#)
 217
 218       -- No CSE, please!
 219      cont1 = case scc  of { InsideSCC -> cont2; _ -> cont2 }
 220      cont2 = case dup  of { DupDanger -> cont3; _ -> cont3 }
 221      cont3 = case alts of { (I# 0#) -> cont4;   _ -> cont4 }
 222      cont4 = OneOcc posn dup scc alts (I# ar_1#)
 223     in
 224     case posn of {FunOcc -> cont1; _ -> cont1}
 225
 226 andBinderInfo info1 info2 =
 227  case getBinderInfoArity info1 of
 228    (I# i#) -> ManyOcc (I# i#)
 229                --ManyOcc (getBinderInfoArity info1)
 230
 231
 232 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
 233 combine_posns _          _  = ArgOcc
 234
 235 combine_dups DupDanger _ = DupDanger    -- Too paranoid?? ToDo
 236 combine_dups _ DupDanger = DupDanger
 237 combine_dups _ _             = NoDupDanger
 238
 239 combine_sccs InsideSCC _ = InsideSCC    -- Too paranoid?? ToDo
 240 combine_sccs _ InsideSCC = InsideSCC
 241 combine_sccs _ _             = NotInsideSCC
 242
 243 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 244 setBinderInfoArityToZero DeadCode    = DeadCode
 245 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
 246 setBinderInfoArityToZero (OneOcc fa dd sc i _) = OneOcc fa dd sc i 0
 247 \end{code}
 248
 249 \begin{code}
 250 getBinderInfoArity (DeadCode) = 0
 251 getBinderInfoArity (ManyOcc i) = i
 252 getBinderInfoArity (OneOcc _ _ _ _ i) = i
 253 \end{code}
 254
 255 \begin{code}
 256 instance Outputable BinderInfo where
 257   ppr sty DeadCode     = ptext SLIT("Dead")
 258   ppr sty (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
 259   ppr sty (OneOcc posn dup_danger in_scc n_alts ar)
 260     = hcat [ ptext SLIT("One-"), pp_posn posn, char '-', pp_danger dup_danger,
 261                   char '-', pp_scc in_scc,  char '-', int n_alts,
 262                   char '-', int ar ]
 263     where
 264       pp_posn FunOcc = ptext SLIT("fun")
 265       pp_posn ArgOcc = ptext SLIT("arg")
 266
 267       pp_danger DupDanger   = ptext SLIT("*dup*")
 268       pp_danger NoDupDanger = ptext SLIT("nodup")
 269
 270       pp_scc InsideSCC    = ptext SLIT("*SCC*")
 271       pp_scc NotInsideSCC = ptext SLIT("noscc")
 272 \end{code}
 273