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