ghc/compiler/simplCore/BinderInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[BinderInfo]{Information attached to binders by SubstAnal}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 \begin{code}
  11 module BinderInfo (
  12         BinderInfo(..),
  13
  14         addBinderInfo, orBinderInfo,
  15
  16         deadOccurrence, funOccurrence, noBinderInfo,
  17
  18         markLazy, markMany, markInsideLam, markInsideSCC,
  19         getBinderInfoArity,
  20         setBinderInfoArityToZero,
  21
  22         occInfoToInlinePrag
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27 import IdInfo           ( InlinePragInfo(..), OccInfo(..) )
  28 import Util             ( panic )
  29 import GlaExts          ( Int(..), (+#) )
  30 import Outputable
  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       !OccInfo
  54
  55       !InsideSCC
  56
  57       !Int      -- Number of mutually-exclusive case alternatives
  58                 -- in which it occurs
  59
  60                 -- Note that we only worry about the case-alt counts
  61                 -- if the OneOcc is substitutable -- that's the only
  62                 -- time we *use* the info; we could be more clever for
  63                 -- other cases if we really had to. (WDP/PS)
  64
  65       !Int      -- number of arguments on stack when called; minimum guarantee
  66
  67 -- In general, we are feel free to substitute unless
  68 -- (a) is in an argument position (ArgOcc)
  69 -- (b) is inside a lambda [or type lambda?] (DupDanger)
  70 -- (c) is inside an SCC expression (InsideSCC)
  71 -- (d) is in the RHS of a binding for a variable with an INLINE pragma
  72 --      (because the RHS will be inlined regardless of its size)
  73 --      [again, DupDanger]
  74
  75 data InsideSCC
  76   = InsideSCC       -- Inside an SCC; so be careful when substituting.
  77   | NotInsideSCC    -- It's ok.
  78
  79 noBinderInfo = ManyOcc 0        -- A non-committal value
  80 \end{code}
  81
  82 \begin{code}
  83 occInfoToInlinePrag :: BinderInfo -> InlinePragInfo
  84 occInfoToInlinePrag DeadCode                                = IAmDead
  85 occInfoToInlinePrag (OneOcc occ_info NotInsideSCC n_alts _) = ICanSafelyBeINLINEd occ_info (n_alts==1)
  86 occInfoToInlinePrag other                                   = NoInlinePragInfo
  87 \end{code}
  88
  89
  90
  91 Construction
  92 ~~~~~~~~~~~~~
  93 \begin{code}
  94 deadOccurrence :: BinderInfo
  95 deadOccurrence = DeadCode
  96
  97 funOccurrence :: Int -> BinderInfo
  98 funOccurrence = OneOcc StrictOcc NotInsideSCC 1
  99
 100 markLazy, markMany, markInsideLam, markInsideSCC :: BinderInfo -> BinderInfo
 101
 102 markMany (OneOcc _ _ _ ar) = ManyOcc ar
 103 markMany (ManyOcc ar)      = ManyOcc ar
 104 markMany DeadCode          = panic "markMany"
 105
 106 markInsideLam (OneOcc _ in_scc n_alts ar) = OneOcc InsideLam in_scc n_alts ar
 107 markInsideLam other                       = other
 108
 109 markInsideSCC (OneOcc dup_danger _ n_alts ar) = OneOcc dup_danger InsideSCC n_alts ar
 110 markInsideSCC other                           = other
 111
 112 markLazy (OneOcc StrictOcc scc n_alts ar) = OneOcc LazyOcc scc n_alts ar
 113 markLazy other                            = other
 114
 115 addBinderInfo, orBinderInfo :: BinderInfo -> BinderInfo -> BinderInfo
 116
 117 addBinderInfo DeadCode info2 = info2
 118 addBinderInfo info1 DeadCode = info1
 119 addBinderInfo info1 info2
 120  = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 121
 122 -- (orBinderInfo orig new) is used
 123 -- when combining occurrence info from branches of a case
 124
 125 orBinderInfo DeadCode info2 = info2
 126 orBinderInfo info1 DeadCode = info1
 127 orBinderInfo (OneOcc dup1 scc1 n_alts1 ar_1)
 128              (OneOcc dup2 scc2 n_alts2 ar_2)
 129   = let
 130      scc  = or_sccs  scc1  scc2
 131      dup  = or_dups  dup1  dup2
 132      alts = n_alts1 + n_alts2
 133      ar   = min ar_1 ar_2
 134    in
 135    OneOcc dup scc alts ar
 136
 137 orBinderInfo info1 info2
 138  = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 139
 140 or_dups InsideLam _         = InsideLam
 141 or_dups _         InsideLam = InsideLam
 142 or_dups StrictOcc StrictOcc = StrictOcc
 143 or_dups _         _         = LazyOcc
 144
 145 or_sccs InsideSCC _ = InsideSCC
 146 or_sccs _ InsideSCC = InsideSCC
 147 or_sccs _ _         = NotInsideSCC
 148
 149 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 150 setBinderInfoArityToZero DeadCode    = DeadCode
 151 setBinderInfoArityToZero (ManyOcc _) = ManyOcc 0
 152 setBinderInfoArityToZero (OneOcc dd sc i _) = OneOcc dd sc i 0
 153 \end{code}
 154
 155 \begin{code}
 156 getBinderInfoArity (DeadCode) = 0
 157 getBinderInfoArity (ManyOcc i) = i
 158 getBinderInfoArity (OneOcc _ _ _ i) = i
 159 \end{code}
 160
 161 \begin{code}
 162 instance Outputable BinderInfo where
 163   ppr DeadCode     = ptext SLIT("Dead")
 164   ppr (ManyOcc ar) = hcat [ ptext SLIT("Many-"), int ar ]
 165   ppr (OneOcc dup_danger in_scc n_alts ar)
 166     = hcat [ ptext SLIT("One-"), ppr dup_danger,
 167                   char '-', pp_scc in_scc,  char '-', int n_alts,
 168                   char '-', int ar ]
 169     where
 170       pp_scc InsideSCC    = ptext SLIT("*SCC*")
 171       pp_scc NotInsideSCC = ptext SLIT("noscc")
 172 \end{code}
 173