2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
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 #include "HsVersions.h"
26 module StgStats ( showStgStats ) where
32 import FiniteMap ( emptyFM, plusFM_C, unitFM, fmToList )
45 | ConstructorBinds Bool{-True<=>top-level-}
46 | ReEntrantBinds Bool{-ditto-}
47 | SingleEntryBinds Bool{-ditto-}
48 | UpdatableBinds Bool{-ditto-}
52 type StatEnv = FiniteMap CounterType Count
59 combineSE :: StatEnv -> StatEnv -> StatEnv
60 combineSE = plusFM_C (+)
62 combineSEs :: [StatEnv] -> StatEnv
63 combineSEs = foldr combineSE emptySE
65 countOne :: CounterType -> StatEnv
66 countOne c = unitFM c 1
68 countN :: CounterType -> Int -> StatEnv
72 %************************************************************************
74 \subsection{Top-level list of bindings (a ``program'')}
76 %************************************************************************
79 showStgStats :: [StgBinding] -> String
82 = "STG Statistics:\n\n"
83 ++ concat (map showc (fmToList (gatherStgStats prog)))
85 showc (x,n) = (showString (s x) . shows n) "\n"
87 s Literals = "Literals "
88 s Applications = "Applications "
89 s ConstructorApps = "ConstructorApps "
90 s PrimitiveApps = "PrimitiveApps "
91 s LetNoEscapes = "LetNoEscapes "
92 s AlgCases = "AlgCases "
93 s PrimCases = "PrimCases "
94 s FreeVariables = "FreeVariables "
95 s (ConstructorBinds True) = "ConstructorBinds_Top "
96 s (ReEntrantBinds True) = "ReEntrantBinds_Top "
97 s (SingleEntryBinds True) = "SingleEntryBinds_Top "
98 s (UpdatableBinds True) = "UpdatableBinds_Top "
99 s (ConstructorBinds _) = "ConstructorBinds_Nested "
100 s (ReEntrantBinds _) = "ReEntrantBindsBinds_Nested "
101 s (SingleEntryBinds _) = "SingleEntryBinds_Nested "
102 s (UpdatableBinds _) = "UpdatableBinds_Nested "
104 gatherStgStats :: [StgBinding] -> StatEnv
107 = combineSEs (map (statBinding True{-top-level-}) binds)
110 %************************************************************************
112 \subsection{Bindings}
114 %************************************************************************
117 statBinding :: Bool -- True <=> top-level; False <=> nested
121 statBinding top (StgNonRec b rhs)
122 = statRhs top (b, rhs)
124 statBinding top (StgRec pairs)
125 = combineSEs (map (statRhs top) pairs)
127 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
129 statRhs top (b, StgRhsCon cc con args)
130 = countOne (ConstructorBinds top)
132 statRhs top (b, StgRhsClosure cc bi fv u args body)
133 = statExpr body `combineSE`
134 countN FreeVariables (length fv) `combineSE`
137 ReEntrant -> ReEntrantBinds top
138 Updatable -> UpdatableBinds top
139 SingleEntry -> SingleEntryBinds top
143 %************************************************************************
145 \subsection{Expressions}
147 %************************************************************************
150 statExpr :: StgExpr -> StatEnv
152 statExpr (StgApp _ [] lvs)
154 statExpr (StgApp _ _ lvs)
155 = countOne Applications
157 statExpr (StgCon con as lvs)
158 = countOne ConstructorApps
160 statExpr (StgPrim op as lvs)
161 = countOne PrimitiveApps
163 statExpr (StgSCC ty l e)
166 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
167 = statBinding False{-not top-level-} binds `combineSE`
168 statExpr body `combineSE`
169 countOne LetNoEscapes
171 statExpr (StgLet binds body)
172 = statBinding False{-not top-level-} binds `combineSE`
175 statExpr (StgCase expr lve lva uniq alts)
176 = statExpr expr `combineSE`
179 stat_alts (StgAlgAlts ty alts def)
180 = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
182 stat_deflt def `combineSE`
185 stat_alts (StgPrimAlts ty alts def)
186 = combineSEs (map statExpr [ e | (_,e) <- alts ])
188 stat_deflt def `combineSE`
191 stat_deflt StgNoDefault = emptySE
193 stat_deflt (StgBindDefault b u expr) = statExpr expr