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 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 _srt 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 _ _)     = countOne Applications
 152 statExpr (StgLit _)       = countOne Literals
 153 statExpr (StgConApp _ _)  = countOne ConstructorApps
 154 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
 155 statExpr (StgSCC l e)     = statExpr e
 156
 157 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 158   = statBinding False{-not top-level-} binds    `combineSE`
 159     statExpr body                               `combineSE`
 160     countOne LetNoEscapes
 161
 162 statExpr (StgLet binds body)
 163   = statBinding False{-not top-level-} binds    `combineSE`
 164     statExpr body
 165
 166 statExpr (StgCase expr lve lva bndr srt alts)
 167   = statExpr expr       `combineSE`
 168     stat_alts alts
 169     where
 170       stat_alts (StgAlgAlts ty alts def)
 171         = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
 172                                         `combineSE`
 173           stat_deflt def                `combineSE`
 174           countOne AlgCases
 175
 176       stat_alts (StgPrimAlts ty alts def)
 177         = combineSEs (map statExpr [ e | (_,e) <- alts ])
 178                                         `combineSE`
 179           stat_deflt def                `combineSE`
 180           countOne PrimCases
 181
 182       stat_deflt StgNoDefault = emptySE
 183
 184       stat_deflt (StgBindDefault expr) = statExpr expr
 185 \end{code}
 186