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 #include "HsVersions.h"
  25
  26 module StgStats ( showStgStats ) where
  27
  28 IMP_Ubiq(){-uitous-}
  29
  30 import StgSyn
  31
  32 import FiniteMap        ( emptyFM, plusFM_C, unitFM, fmToList )
  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 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 _ [] lvs)
 153   = countOne Literals
 154 statExpr (StgApp _ _ lvs)
 155   = countOne Applications
 156
 157 statExpr (StgCon con as lvs)
 158   = countOne ConstructorApps
 159
 160 statExpr (StgPrim op as lvs)
 161   = countOne PrimitiveApps
 162
 163 statExpr (StgSCC ty l e)
 164   = statExpr e
 165
 166 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 167   = statBinding False{-not top-level-} binds    `combineSE`
 168     statExpr body                               `combineSE`
 169     countOne LetNoEscapes
 170
 171 statExpr (StgLet binds body)
 172   = statBinding False{-not top-level-} binds    `combineSE`
 173     statExpr body
 174
 175 statExpr (StgCase expr lve lva uniq alts)
 176   = statExpr expr       `combineSE`
 177     stat_alts alts
 178     where
 179       stat_alts (StgAlgAlts ty alts def)
 180         = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
 181                                         `combineSE`
 182           stat_deflt def                `combineSE`
 183           countOne AlgCases
 184
 185       stat_alts (StgPrimAlts ty alts def)
 186         = combineSEs (map statExpr [ e | (_,e) <- alts ])
 187                                         `combineSE`
 188           stat_deflt def                `combineSE`
 189           countOne PrimCases
 190
 191       stat_deflt StgNoDefault = emptySE
 192
 193       stat_deflt (StgBindDefault b u expr) = statExpr expr
 194 \end{code}
 195