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 {-# OPTIONS_GHC -w #-}
  25 -- The above warning supression flag is a temporary kludge.
  26 -- While working on this module you are encouraged to remove it and fix
  27 -- any warnings in the module. See
  28 --     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
  29 -- for details
  30
  31 module StgStats ( showStgStats ) where
  32
  33 #include "HsVersions.h"
  34
  35 import StgSyn
  36
  37 import FiniteMap        ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
  38 import Id (Id)
  39 \end{code}
  40
  41 \begin{code}
  42 data CounterType
  43   = Literals
  44   | Applications
  45   | ConstructorApps
  46   | PrimitiveApps
  47   | LetNoEscapes
  48   | StgCases
  49   | FreeVariables
  50   | ConstructorBinds Bool{-True<=>top-level-}
  51   | ReEntrantBinds   Bool{-ditto-}
  52   | SingleEntryBinds Bool{-ditto-}
  53   | UpdatableBinds   Bool{-ditto-}
  54   deriving (Eq, Ord)
  55
  56 type Count      = Int
  57 type StatEnv    = FiniteMap CounterType Count
  58 \end{code}
  59
  60 \begin{code}
  61 emptySE :: StatEnv
  62 emptySE = emptyFM
  63
  64 combineSE :: StatEnv -> StatEnv -> StatEnv
  65 combineSE = plusFM_C (+)
  66
  67 combineSEs :: [StatEnv] -> StatEnv
  68 combineSEs = foldr combineSE emptySE
  69
  70 countOne :: CounterType -> StatEnv
  71 countOne c = unitFM c 1
  72
  73 countN :: CounterType -> Int -> StatEnv
  74 countN = unitFM
  75 \end{code}
  76
  77 %************************************************************************
  78 %*                                                                      *
  79 \subsection{Top-level list of bindings (a ``program'')}
  80 %*                                                                      *
  81 %************************************************************************
  82
  83 \begin{code}
  84 showStgStats :: [StgBinding] -> String
  85
  86 showStgStats prog
  87   = "STG Statistics:\n\n"
  88     ++ concat (map showc (fmToList (gatherStgStats prog)))
  89   where
  90     showc (x,n) = (showString (s x) . shows n) "\n"
  91
  92     s Literals                = "Literals                   "
  93     s Applications            = "Applications               "
  94     s ConstructorApps         = "ConstructorApps            "
  95     s PrimitiveApps           = "PrimitiveApps              "
  96     s LetNoEscapes            = "LetNoEscapes               "
  97     s StgCases                = "StgCases                   "
  98     s FreeVariables           = "FreeVariables              "
  99     s (ConstructorBinds True) = "ConstructorBinds_Top       "
 100     s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
 101     s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
 102     s (UpdatableBinds True)   = "UpdatableBinds_Top         "
 103     s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
 104     s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
 105     s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
 106     s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
 107
 108 gatherStgStats :: [StgBinding] -> StatEnv
 109
 110 gatherStgStats binds
 111   = combineSEs (map (statBinding True{-top-level-}) binds)
 112 \end{code}
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection{Bindings}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 statBinding :: Bool -- True <=> top-level; False <=> nested
 122             -> StgBinding
 123             -> StatEnv
 124
 125 statBinding top (StgNonRec b rhs)
 126   = statRhs top (b, rhs)
 127
 128 statBinding top (StgRec pairs)
 129   = combineSEs (map (statRhs top) pairs)
 130
 131 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 132
 133 statRhs top (b, StgRhsCon cc con args)
 134   = countOne (ConstructorBinds top)
 135
 136 statRhs top (b, StgRhsClosure cc bi fv u _srt args body)
 137   = statExpr body                       `combineSE`
 138     countN FreeVariables (length fv)    `combineSE`
 139     countOne (
 140       case u of
 141         ReEntrant   -> ReEntrantBinds   top
 142         Updatable   -> UpdatableBinds   top
 143         SingleEntry -> SingleEntryBinds top
 144     )
 145 \end{code}
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 \subsection{Expressions}
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 \begin{code}
 154 statExpr :: StgExpr -> StatEnv
 155
 156 statExpr (StgApp _ _)     = countOne Applications
 157 statExpr (StgLit _)       = countOne Literals
 158 statExpr (StgConApp _ _)  = countOne ConstructorApps
 159 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
 160 statExpr (StgSCC l e)     = statExpr e
 161 statExpr (StgTick m n e)  = statExpr e
 162
 163 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
 164   = statBinding False{-not top-level-} binds    `combineSE`
 165     statExpr body                               `combineSE`
 166     countOne LetNoEscapes
 167
 168 statExpr (StgLet binds body)
 169   = statBinding False{-not top-level-} binds    `combineSE`
 170     statExpr body
 171
 172 statExpr (StgCase expr lve lva bndr srt alt_type alts)
 173   = statExpr expr       `combineSE`
 174     stat_alts alts      `combineSE`
 175     countOne StgCases
 176   where
 177     stat_alts alts
 178         = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
 179 \end{code}
 180