ghc/compiler/simplStg/StgStats.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[StgStats]{Gathers statistical information about programs}
   5
   6
   7 The program gather statistics about
   8 \begin{enumerate}
   9 \item number of boxed cases
  10 \item number of unboxed cases
  11 \item number of let-no-escapes
  12 \item number of non-updatable lets
  13 \item number of updatable lets
  14 \item number of applications
  15 \item number of primitive applications
  16 \item number of closures (does not include lets bound to constructors)
  17 \item number of free variables in closures
  18 %\item number of top-level functions
  19 %\item number of top-level CAFs
  20 \item number of constructors
  21 \end{enumerate}
  22
  23 \begin{code}
  24 module StgStats ( showStgStats ) where
  25
  26 #include "HsVersions.h"
  27
  28 import StgSyn
  29
  30 import FiniteMap        ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
  31 import Id (Id)
  32 \end{code}
  33
  34 \begin{code}
  35 data CounterType
  36   = Literals
  37   | Applications
  38   | ConstructorApps
  39   | PrimitiveApps
  40   | LetNoEscapes
  41   | AlgCases
  42   | PrimCases
  43   | FreeVariables
  44   | ConstructorBinds Bool{-True<=>top-level-}
  45   | ReEntrantBinds   Bool{-ditto-}
  46   | SingleEntryBinds Bool{-ditto-}
  47   | UpdatableBinds   Bool{-ditto-}
  48   deriving (Eq, Ord)
  49
  50 type Count      = Int
  51 type StatEnv    = FiniteMap CounterType Count
  52 \end{code}
  53
  54 \begin{code}
  55 emptySE :: StatEnv
  56 emptySE = emptyFM
  57
  58 combineSE :: StatEnv -> StatEnv -> StatEnv
  59 combineSE = plusFM_C (+)
  60
  61 combineSEs :: [StatEnv] -> StatEnv
  62 combineSEs = foldr combineSE emptySE
  63
  64 countOne :: CounterType -> StatEnv
  65 countOne c = unitFM c 1
  66
  67 countN :: CounterType -> Int -> StatEnv
  68 countN = unitFM
  69 \end{code}
  70
  71 %************************************************************************
  72 %*                                                                      *
  73 \subsection{Top-level list of bindings (a ``program'')}
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 showStgStats :: [StgBinding] -> String
  79
  80 showStgStats prog
  81   = "STG Statistics:\n\n"
  82     ++ concat (map showc (fmToList (gatherStgStats prog)))
  83   where
  84     showc (x,n) = (showString (s x) . shows n) "\n"
  85
  86     s Literals                = "Literals                   "
  87     s Applications            = "Applications               "
  88     s ConstructorApps         = "ConstructorApps            "
  89     s PrimitiveApps           = "PrimitiveApps              "
  90     s LetNoEscapes            = "LetNoEscapes               "
  91     s AlgCases                = "AlgCases                   "
  92     s PrimCases               = "PrimCases                  "
  93     s FreeVariables           = "FreeVariables              "
  94     s (ConstructorBinds True) = "ConstructorBinds_Top       "
  95     s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
  96     s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
  97     s (UpdatableBinds True)   = "UpdatableBinds_Top         "
  98     s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
  99     s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
 100     s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
 101     s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 102
 103 gatherStgStats :: [StgBinding] -> StatEnv
 104
 105 gatherStgStats binds
 106   = combineSEs (map (statBinding True{-top-level-}) binds)
 107 \end{code}
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection{Bindings}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 statBinding :: Bool -- True <=> top-level; False <=> nested
 117             -> StgBinding
 118             -> StatEnv
 119
 120 statBinding top (StgNonRec b rhs)
 121   = statRhs top (b, rhs)
 122
 123 statBinding top (StgRec pairs)
 124   = combineSEs (map (statRhs top) pairs)
 125
 126 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 127
 128 statRhs top (b, StgRhsCon cc con args)
 129   = countOne (ConstructorBinds top)
 130
 131 statRhs top (b, StgRhsClosure cc bi fv u args body)
 132   = statExpr body                       `combineSE`
 133     countN FreeVariables (length fv)    `combineSE`
 134     countOne (
 135       case u of
 136         ReEntrant   -> ReEntrantBinds   top
 137         Updatable   -> UpdatableBinds   top
 138         SingleEntry -> SingleEntryBinds top
 139     )
 140 \end{code}
 141
 142 %************************************************************************
 143 %*                                                                      *
 144 \subsection{Expressions}
 145 %*                                                                      *
 146 %************************************************************************
 147
 148 \begin{code}
 149 statExpr :: StgExpr -> StatEnv
 150
 151 statExpr (StgApp _ [] lvs)
 152   = countOne Literals
 153 statExpr (StgApp _ _ lvs)
 154   = countOne Applications
 155
 156 statExpr (StgCon con as lvs)
 157   = countOne ConstructorApps
 158
 159 statExpr (StgPrim op as lvs)
 160   = countOne PrimitiveApps
 161
 162 statExpr (StgSCC ty l e)
 163   = statExpr e
 164
 165 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 166   = statBinding False{-not top-level-} binds    `combineSE`
 167     statExpr body                               `combineSE`
 168     countOne LetNoEscapes
 169
 170 statExpr (StgLet binds body)
 171   = statBinding False{-not top-level-} binds    `combineSE`
 172     statExpr body
 173
 174 statExpr (StgCase expr lve lva uniq alts)
 175   = statExpr expr       `combineSE`
 176     stat_alts alts
 177     where
 178       stat_alts (StgAlgAlts ty alts def)
 179         = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
 180                                         `combineSE`
 181           stat_deflt def                `combineSE`
 182           countOne AlgCases
 183
 184       stat_alts (StgPrimAlts ty alts def)
 185         = combineSEs (map statExpr [ e | (_,e) <- alts ])
 186                                         `combineSE`
 187           stat_deflt def                `combineSE`
 188           countOne PrimCases
 189
 190       stat_deflt StgNoDefault = emptySE
 191
 192       stat_deflt (StgBindDefault b u expr) = statExpr expr
 193 \end{code}
 194