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, FiniteMap )
  33 import Id (SYN_IE(Id))
  34 \end{code}
  35
  36 \begin{code}
  37 data CounterType
  38   = Literals
  39   | Applications
  40   | ConstructorApps
  41   | PrimitiveApps
  42   | LetNoEscapes
  43   | AlgCases
  44   | PrimCases
  45   | FreeVariables
  46   | ConstructorBinds Bool{-True<=>top-level-}
  47   | ReEntrantBinds   Bool{-ditto-}
  48   | SingleEntryBinds Bool{-ditto-}
  49   | UpdatableBinds   Bool{-ditto-}
  50   deriving (Eq, Ord)
  51
  52 type Count      = Int
  53 type StatEnv    = FiniteMap CounterType Count
  54 \end{code}
  55
  56 \begin{code}
  57 emptySE :: StatEnv
  58 emptySE = emptyFM
  59
  60 combineSE :: StatEnv -> StatEnv -> StatEnv
  61 combineSE = plusFM_C (+)
  62
  63 combineSEs :: [StatEnv] -> StatEnv
  64 combineSEs = foldr combineSE emptySE
  65
  66 countOne :: CounterType -> StatEnv
  67 countOne c = unitFM c 1
  68
  69 countN :: CounterType -> Int -> StatEnv
  70 countN = unitFM
  71 \end{code}
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{Top-level list of bindings (a ``program'')}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 \begin{code}
  80 showStgStats :: [StgBinding] -> String
  81
  82 showStgStats prog
  83   = "STG Statistics:\n\n"
  84     ++ concat (map showc (fmToList (gatherStgStats prog)))
  85   where
  86     showc (x,n) = (showString (s x) . shows n) "\n"
  87
  88     s Literals                = "Literals                   "
  89     s Applications            = "Applications               "
  90     s ConstructorApps         = "ConstructorApps            "
  91     s PrimitiveApps           = "PrimitiveApps              "
  92     s LetNoEscapes            = "LetNoEscapes               "
  93     s AlgCases                = "AlgCases                   "
  94     s PrimCases               = "PrimCases                  "
  95     s FreeVariables           = "FreeVariables              "
  96     s (ConstructorBinds True) = "ConstructorBinds_Top       "
  97     s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
  98     s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
  99     s (UpdatableBinds True)   = "UpdatableBinds_Top         "
 100     s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
 101     s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
 102     s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
 103     s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 104
 105 gatherStgStats :: [StgBinding] -> StatEnv
 106
 107 gatherStgStats binds
 108   = combineSEs (map (statBinding True{-top-level-}) binds)
 109 \end{code}
 110
 111 %************************************************************************
 112 %*                                                                      *
 113 \subsection{Bindings}
 114 %*                                                                      *
 115 %************************************************************************
 116
 117 \begin{code}
 118 statBinding :: Bool -- True <=> top-level; False <=> nested
 119             -> StgBinding
 120             -> StatEnv
 121
 122 statBinding top (StgNonRec b rhs)
 123   = statRhs top (b, rhs)
 124
 125 statBinding top (StgRec pairs)
 126   = combineSEs (map (statRhs top) pairs)
 127
 128 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 129
 130 statRhs top (b, StgRhsCon cc con args)
 131   = countOne (ConstructorBinds top)
 132
 133 statRhs top (b, StgRhsClosure cc bi fv u args body)
 134   = statExpr body                       `combineSE`
 135     countN FreeVariables (length fv)    `combineSE`
 136     countOne (
 137       case u of
 138         ReEntrant   -> ReEntrantBinds   top
 139         Updatable   -> UpdatableBinds   top
 140         SingleEntry -> SingleEntryBinds top
 141     )
 142 \end{code}
 143
 144 %************************************************************************
 145 %*                                                                      *
 146 \subsection{Expressions}
 147 %*                                                                      *
 148 %************************************************************************
 149
 150 \begin{code}
 151 statExpr :: StgExpr -> StatEnv
 152
 153 statExpr (StgApp _ [] lvs)
 154   = countOne Literals
 155 statExpr (StgApp _ _ lvs)
 156   = countOne Applications
 157
 158 statExpr (StgCon con as lvs)
 159   = countOne ConstructorApps
 160
 161 statExpr (StgPrim op as lvs)
 162   = countOne PrimitiveApps
 163
 164 statExpr (StgSCC ty 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 uniq 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 b u expr) = statExpr expr
 195 \end{code}
 196