2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[StgStats]{Gathers statistical information about programs}
7 The program gather statistics about
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
24 module StgStats ( showStgStats ) where
26 #include "HsVersions.h"
30 import FiniteMap ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
43 | ConstructorBinds Bool{-True<=>top-level-}
44 | ReEntrantBinds Bool{-ditto-}
45 | SingleEntryBinds Bool{-ditto-}
46 | UpdatableBinds Bool{-ditto-}
50 type StatEnv = FiniteMap CounterType Count
57 combineSE :: StatEnv -> StatEnv -> StatEnv
58 combineSE = plusFM_C (+)
60 combineSEs :: [StatEnv] -> StatEnv
61 combineSEs = foldr combineSE emptySE
63 countOne :: CounterType -> StatEnv
64 countOne c = unitFM c 1
66 countN :: CounterType -> Int -> StatEnv
70 %************************************************************************
72 \subsection{Top-level list of bindings (a ``program'')}
74 %************************************************************************
77 showStgStats :: [StgBinding] -> String
80 = "STG Statistics:\n\n"
81 ++ concat (map showc (fmToList (gatherStgStats prog)))
83 showc (x,n) = (showString (s x) . shows n) "\n"
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 "
101 gatherStgStats :: [StgBinding] -> StatEnv
104 = combineSEs (map (statBinding True{-top-level-}) binds)
107 %************************************************************************
109 \subsection{Bindings}
111 %************************************************************************
114 statBinding :: Bool -- True <=> top-level; False <=> nested
118 statBinding top (StgNonRec b rhs)
119 = statRhs top (b, rhs)
121 statBinding top (StgRec pairs)
122 = combineSEs (map (statRhs top) pairs)
124 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
126 statRhs top (b, StgRhsCon cc con args)
127 = countOne (ConstructorBinds top)
129 statRhs top (b, StgRhsClosure cc bi fv u _srt args body)
130 = statExpr body `combineSE`
131 countN FreeVariables (length fv) `combineSE`
134 ReEntrant -> ReEntrantBinds top
135 Updatable -> UpdatableBinds top
136 SingleEntry -> SingleEntryBinds top
140 %************************************************************************
142 \subsection{Expressions}
144 %************************************************************************
147 statExpr :: StgExpr -> StatEnv
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
156 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
157 = statBinding False{-not top-level-} binds `combineSE`
158 statExpr body `combineSE`
159 countOne LetNoEscapes
161 statExpr (StgLet binds body)
162 = statBinding False{-not top-level-} binds `combineSE`
165 statExpr (StgCase expr lve lva bndr srt alt_type alts)
166 = statExpr expr `combineSE`
167 stat_alts alts `combineSE`
171 = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])