ghc/compiler/simplStg/StgStats.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   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 #include "HsVersions.h"
  25
  26 module StgStats ( showStgStats ) where
  27
  28 import StgSyn
  29
  30 import FiniteMap
  31
  32 import Util
  33 \end{code}
  34
  35 \begin{code}
  36 data CounterType
  37   = AlgCases
  38   | PrimCases
  39   | LetNoEscapes
  40   | NonUpdatableLets
  41   | UpdatableLets
  42   | Applications
  43   | PrimitiveApps
  44   | FreeVariables
  45   | Closures    -- does not include lets bound to constructors
  46 --| UpdatableTopLevelDefs
  47 --| NonUpdatableTopLevelDefs
  48   | Constructors
  49   deriving (Eq, Ord, Text)
  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 = singletonFM c 1
  67
  68 countN :: CounterType -> Int -> StatEnv
  69 countN = singletonFM
  70 \end{code}
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 \subsection{Top-level list of bindings (a ``program'')}
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 \begin{code}
  79 showStgStats :: PlainStgProgram -> String
  80 showStgStats prog = concat (map showc (fmToList (gatherStgStats prog)))
  81   where
  82     showc (AlgCases,n)         = "AlgCases               " ++ show n ++ "\n"
  83     showc (PrimCases,n)        = "PrimCases              " ++ show n ++ "\n"
  84     showc (LetNoEscapes,n)     = "LetNoEscapes           " ++ show n ++ "\n"
  85     showc (NonUpdatableLets,n) = "NonUpdatableLets       " ++ show n ++ "\n"
  86     showc (UpdatableLets,n)    = "UpdatableLets          " ++ show n ++ "\n"
  87     showc (Applications,n)     = "Applications           " ++ show n ++ "\n"
  88     showc (PrimitiveApps,n)    = "PrimitiveApps          " ++ show n ++ "\n"
  89     showc (Closures,n)         = "Closures               " ++ show n ++ "\n"
  90     showc (FreeVariables,n)    = "Free Vars in Closures  " ++ show n ++ "\n"
  91     showc (Constructors,n)     = "Constructors           " ++ show n ++ "\n"
  92
  93 gatherStgStats :: PlainStgProgram -> StatEnv
  94
  95 gatherStgStats binds
  96   = combineSEs (map statBinding binds)
  97 \end{code}
  98
  99 %************************************************************************
 100 %*                                                                      *
 101 \subsection{Bindings}
 102 %*                                                                      *
 103 %************************************************************************
 104
 105 \begin{code}
 106 statBinding :: PlainStgBinding -> StatEnv
 107
 108 statBinding (StgNonRec b rhs)
 109   = statRhs (b, rhs)
 110
 111 statBinding (StgRec pairs)
 112   = combineSEs (map statRhs pairs)
 113
 114 statRhs :: (Id, PlainStgRhs) -> StatEnv
 115
 116 statRhs (b, StgRhsCon cc con args)
 117   = countOne Constructors               `combineSE`
 118     countOne NonUpdatableLets
 119
 120 statRhs (b, StgRhsClosure cc bi fv u args body)
 121   = statExpr body                       `combineSE`
 122     countN FreeVariables (length fv)    `combineSE`
 123     countOne Closures                   `combineSE`
 124     (case u of
 125        Updatable -> countOne UpdatableLets
 126        _         -> countOne NonUpdatableLets)
 127
 128 \end{code}
 129
 130 %************************************************************************
 131 %*                                                                      *
 132 \subsection{Expressions}
 133 %*                                                                      *
 134 %************************************************************************
 135
 136 \begin{code}
 137 statExpr :: PlainStgExpr -> StatEnv
 138
 139 statExpr (StgApp _ [] lvs)
 140   = emptySE
 141 statExpr (StgApp _ _ lvs)
 142   = countOne Applications
 143
 144 statExpr (StgConApp con as lvs)
 145   = countOne Constructors
 146
 147 statExpr (StgPrimApp op as lvs)
 148   = countOne PrimitiveApps
 149
 150 statExpr (StgSCC ty l e)
 151   = statExpr e
 152
 153 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 154   = statBinding binds   `combineSE`
 155     statExpr body       `combineSE`
 156     countOne LetNoEscapes
 157
 158 statExpr (StgLet binds body)
 159   = statBinding binds   `combineSE`
 160     statExpr body
 161
 162 statExpr (StgCase expr lve lva uniq alts)
 163   = statExpr expr       `combineSE`
 164     stat_alts alts
 165     where
 166       stat_alts (StgAlgAlts ty alts def)
 167         = combineSEs (map stat_alg_alt alts)    `combineSE`
 168           stat_deflt def                        `combineSE`
 169           countOne AlgCases
 170         where
 171           stat_alg_alt (id, bs, use_mask, e)
 172             = statExpr e
 173
 174       stat_alts (StgPrimAlts ty alts def)
 175         = combineSEs (map stat_prim_alt alts)   `combineSE`
 176           stat_deflt def                        `combineSE`
 177           countOne PrimCases
 178         where
 179           stat_prim_alt (l, e)
 180             = statExpr e
 181
 182       stat_deflt StgNoDefault
 183         = emptySE
 184
 185       stat_deflt (StgBindDefault b u expr)
 186         = statExpr expr
 187 \end{code}
 188