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