ghc/compiler/simplStg/StgStats.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   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 Const            ( Con(..) )
  31 import FiniteMap        ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
  32 import Id (Id)
  33 \end{code}
  34
  35 \begin{code}
  36 data CounterType
  37   = Literals
  38   | Applications
  39   | ConstructorApps
  40   | PrimitiveApps
  41   | LetNoEscapes
  42   | AlgCases
  43   | PrimCases
  44   | FreeVariables
  45   | ConstructorBinds Bool{-True<=>top-level-}
  46   | ReEntrantBinds   Bool{-ditto-}
  47   | SingleEntryBinds Bool{-ditto-}
  48   | UpdatableBinds   Bool{-ditto-}
  49   deriving (Eq, Ord)
  50
  51 type Count      = Int
  52 type StatEnv    = FiniteMap CounterType Count
  53 \end{code}
  54
  55 \begin{code}
  56 emptySE :: StatEnv
  57 emptySE = emptyFM
  58
  59 combineSE :: StatEnv -> StatEnv -> StatEnv
  60 combineSE = plusFM_C (+)
  61
  62 combineSEs :: [StatEnv] -> StatEnv
  63 combineSEs = foldr combineSE emptySE
  64
  65 countOne :: CounterType -> StatEnv
  66 countOne c = unitFM c 1
  67
  68 countN :: CounterType -> Int -> StatEnv
  69 countN = unitFM
  70 \end{code}
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 \subsection{Top-level list of bindings (a ``program'')}
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 \begin{code}
  79 showStgStats :: [StgBinding] -> String
  80
  81 showStgStats prog
  82   = "STG Statistics:\n\n"
  83     ++ concat (map showc (fmToList (gatherStgStats prog)))
  84   where
  85     showc (x,n) = (showString (s x) . shows n) "\n"
  86
  87     s Literals                = "Literals                   "
  88     s Applications            = "Applications               "
  89     s ConstructorApps         = "ConstructorApps            "
  90     s PrimitiveApps           = "PrimitiveApps              "
  91     s LetNoEscapes            = "LetNoEscapes               "
  92     s AlgCases                = "AlgCases                   "
  93     s PrimCases               = "PrimCases                  "
  94     s FreeVariables           = "FreeVariables              "
  95     s (ConstructorBinds True) = "ConstructorBinds_Top       "
  96     s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
  97     s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
  98     s (UpdatableBinds True)   = "UpdatableBinds_Top         "
  99     s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
 100     s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
 101     s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
 102     s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 103
 104 gatherStgStats :: [StgBinding] -> StatEnv
 105
 106 gatherStgStats binds
 107   = combineSEs (map (statBinding True{-top-level-}) binds)
 108 \end{code}
 109
 110 %************************************************************************
 111 %*                                                                      *
 112 \subsection{Bindings}
 113 %*                                                                      *
 114 %************************************************************************
 115
 116 \begin{code}
 117 statBinding :: Bool -- True <=> top-level; False <=> nested
 118             -> StgBinding
 119             -> StatEnv
 120
 121 statBinding top (StgNonRec b rhs)
 122   = statRhs top (b, rhs)
 123
 124 statBinding top (StgRec pairs)
 125   = combineSEs (map (statRhs top) pairs)
 126
 127 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 128
 129 statRhs top (b, StgRhsCon cc con args)
 130   = countOne (ConstructorBinds top)
 131
 132 statRhs top (b, StgRhsClosure cc bi srt fv u args body)
 133   = statExpr body                       `combineSE`
 134     countN FreeVariables (length fv)    `combineSE`
 135     countOne (
 136       case u of
 137         ReEntrant   -> ReEntrantBinds   top
 138         Updatable   -> UpdatableBinds   top
 139         SingleEntry -> SingleEntryBinds top
 140     )
 141 \end{code}
 142
 143 %************************************************************************
 144 %*                                                                      *
 145 \subsection{Expressions}
 146 %*                                                                      *
 147 %************************************************************************
 148
 149 \begin{code}
 150 statExpr :: StgExpr -> StatEnv
 151
 152 statExpr (StgApp _ _)
 153   = countOne Applications
 154
 155 statExpr (StgCon (DataCon _) as _)
 156   = countOne ConstructorApps
 157
 158 statExpr (StgCon (PrimOp _) as _)
 159   = countOne PrimitiveApps
 160
 161 statExpr (StgCon (Literal _) as _)
 162   = countOne Literals
 163
 164 statExpr (StgSCC l e)
 165   = statExpr e
 166
 167 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 168   = statBinding False{-not top-level-} binds    `combineSE`
 169     statExpr body                               `combineSE`
 170     countOne LetNoEscapes
 171
 172 statExpr (StgLet binds body)
 173   = statBinding False{-not top-level-} binds    `combineSE`
 174     statExpr body
 175
 176 statExpr (StgCase expr lve lva bndr srt alts)
 177   = statExpr expr       `combineSE`
 178     stat_alts alts
 179     where
 180       stat_alts (StgAlgAlts ty alts def)
 181         = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
 182                                         `combineSE`
 183           stat_deflt def                `combineSE`
 184           countOne AlgCases
 185
 186       stat_alts (StgPrimAlts ty alts def)
 187         = combineSEs (map statExpr [ e | (_,e) <- alts ])
 188                                         `combineSE`
 189           stat_deflt def                `combineSE`
 190           countOne PrimCases
 191
 192       stat_deflt StgNoDefault = emptySE
 193
 194       stat_deflt (StgBindDefault expr) = statExpr expr
 195 \end{code}
 196