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