diff options
Diffstat (limited to 'compiler/GHC/Stg/Stats.hs')
| -rw-r--r-- | compiler/GHC/Stg/Stats.hs | 173 |
1 files changed, 173 insertions, 0 deletions
diff --git a/compiler/GHC/Stg/Stats.hs b/compiler/GHC/Stg/Stats.hs new file mode 100644 index 0000000000..c70184e60b --- /dev/null +++ b/compiler/GHC/Stg/Stats.hs @@ -0,0 +1,173 @@ +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + +\section[StgStats]{Gathers statistical information about programs} + + +The program gather statistics about +\begin{enumerate} +\item number of boxed cases +\item number of unboxed cases +\item number of let-no-escapes +\item number of non-updatable lets +\item number of updatable lets +\item number of applications +\item number of primitive applications +\item number of closures (does not include lets bound to constructors) +\item number of free variables in closures +%\item number of top-level functions +%\item number of top-level CAFs +\item number of constructors +\end{enumerate} +-} + +{-# LANGUAGE CPP #-} + +module GHC.Stg.Stats ( showStgStats ) where + +#include "HsVersions.h" + +import GhcPrelude + +import GHC.Stg.Syntax + +import Id (Id) +import Panic + +import Data.Map (Map) +import qualified Data.Map as Map + +data CounterType + = Literals + | Applications + | ConstructorApps + | PrimitiveApps + | LetNoEscapes + | StgCases + | FreeVariables + | ConstructorBinds Bool{-True<=>top-level-} + | ReEntrantBinds Bool{-ditto-} + | SingleEntryBinds Bool{-ditto-} + | UpdatableBinds Bool{-ditto-} + deriving (Eq, Ord) + +type Count = Int +type StatEnv = Map CounterType Count + +emptySE :: StatEnv +emptySE = Map.empty + +combineSE :: StatEnv -> StatEnv -> StatEnv +combineSE = Map.unionWith (+) + +combineSEs :: [StatEnv] -> StatEnv +combineSEs = foldr combineSE emptySE + +countOne :: CounterType -> StatEnv +countOne c = Map.singleton c 1 + +{- +************************************************************************ +* * +\subsection{Top-level list of bindings (a ``program'')} +* * +************************************************************************ +-} + +showStgStats :: [StgTopBinding] -> String + +showStgStats prog + = "STG Statistics:\n\n" + ++ concat (map showc (Map.toList (gatherStgStats prog))) + where + showc (x,n) = (showString (s x) . shows n) "\n" + + s Literals = "Literals " + s Applications = "Applications " + s ConstructorApps = "ConstructorApps " + s PrimitiveApps = "PrimitiveApps " + s LetNoEscapes = "LetNoEscapes " + s StgCases = "StgCases " + s FreeVariables = "FreeVariables " + s (ConstructorBinds True) = "ConstructorBinds_Top " + s (ReEntrantBinds True) = "ReEntrantBinds_Top " + s (SingleEntryBinds True) = "SingleEntryBinds_Top " + s (UpdatableBinds True) = "UpdatableBinds_Top " + s (ConstructorBinds _) = "ConstructorBinds_Nested " + s (ReEntrantBinds _) = "ReEntrantBindsBinds_Nested " + s (SingleEntryBinds _) = "SingleEntryBinds_Nested " + s (UpdatableBinds _) = "UpdatableBinds_Nested " + +gatherStgStats :: [StgTopBinding] -> StatEnv +gatherStgStats binds = combineSEs (map statTopBinding binds) + +{- +************************************************************************ +* * +\subsection{Bindings} +* * +************************************************************************ +-} + +statTopBinding :: StgTopBinding -> StatEnv +statTopBinding (StgTopStringLit _ _) = countOne Literals +statTopBinding (StgTopLifted bind) = statBinding True bind + +statBinding :: Bool -- True <=> top-level; False <=> nested + -> StgBinding + -> StatEnv + +statBinding top (StgNonRec b rhs) + = statRhs top (b, rhs) + +statBinding top (StgRec pairs) + = combineSEs (map (statRhs top) pairs) + +statRhs :: Bool -> (Id, StgRhs) -> StatEnv + +statRhs top (_, StgRhsCon _ _ _) + = countOne (ConstructorBinds top) + +statRhs top (_, StgRhsClosure _ _ u _ body) + = statExpr body `combineSE` + countOne ( + case u of + ReEntrant -> ReEntrantBinds top + Updatable -> UpdatableBinds top + SingleEntry -> SingleEntryBinds top + ) + +{- +************************************************************************ +* * +\subsection{Expressions} +* * +************************************************************************ +-} + +statExpr :: StgExpr -> StatEnv + +statExpr (StgApp _ _) = countOne Applications +statExpr (StgLit _) = countOne Literals +statExpr (StgConApp _ _ _)= countOne ConstructorApps +statExpr (StgOpApp _ _ _) = countOne PrimitiveApps +statExpr (StgTick _ e) = statExpr e + +statExpr (StgLetNoEscape _ binds body) + = statBinding False{-not top-level-} binds `combineSE` + statExpr body `combineSE` + countOne LetNoEscapes + +statExpr (StgLet _ binds body) + = statBinding False{-not top-level-} binds `combineSE` + statExpr body + +statExpr (StgCase expr _ _ alts) + = statExpr expr `combineSE` + stat_alts alts `combineSE` + countOne StgCases + where + stat_alts alts + = combineSEs (map statExpr [ e | (_,_,e) <- alts ]) + +statExpr (StgLam {}) = panic "statExpr StgLam" |