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, FiniteMap )
33 import Id (SYN_IE(Id))
46 | ConstructorBinds Bool{-True<=>top-level-}
47 | ReEntrantBinds Bool{-ditto-}
48 | SingleEntryBinds Bool{-ditto-}
49 | UpdatableBinds Bool{-ditto-}
53 type StatEnv = FiniteMap CounterType Count
60 combineSE :: StatEnv -> StatEnv -> StatEnv
61 combineSE = plusFM_C (+)
63 combineSEs :: [StatEnv] -> StatEnv
64 combineSEs = foldr combineSE emptySE
66 countOne :: CounterType -> StatEnv
67 countOne c = unitFM c 1
69 countN :: CounterType -> Int -> StatEnv
73 %************************************************************************
75 \subsection{Top-level list of bindings (a ``program'')}
77 %************************************************************************
80 showStgStats :: [StgBinding] -> String
83 = "STG Statistics:\n\n"
84 ++ concat (map showc (fmToList (gatherStgStats prog)))
86 showc (x,n) = (showString (s x) . shows n) "\n"
88 s Literals = "Literals "
89 s Applications = "Applications "
90 s ConstructorApps = "ConstructorApps "
91 s PrimitiveApps = "PrimitiveApps "
92 s LetNoEscapes = "LetNoEscapes "
93 s AlgCases = "AlgCases "
94 s PrimCases = "PrimCases "
95 s FreeVariables = "FreeVariables "
96 s (ConstructorBinds True) = "ConstructorBinds_Top "
97 s (ReEntrantBinds True) = "ReEntrantBinds_Top "
98 s (SingleEntryBinds True) = "SingleEntryBinds_Top "
99 s (UpdatableBinds True) = "UpdatableBinds_Top "
100 s (ConstructorBinds _) = "ConstructorBinds_Nested "
101 s (ReEntrantBinds _) = "ReEntrantBindsBinds_Nested "
102 s (SingleEntryBinds _) = "SingleEntryBinds_Nested "
103 s (UpdatableBinds _) = "UpdatableBinds_Nested "
105 gatherStgStats :: [StgBinding] -> StatEnv
108 = combineSEs (map (statBinding True{-top-level-}) binds)
111 %************************************************************************
113 \subsection{Bindings}
115 %************************************************************************
118 statBinding :: Bool -- True <=> top-level; False <=> nested
122 statBinding top (StgNonRec b rhs)
123 = statRhs top (b, rhs)
125 statBinding top (StgRec pairs)
126 = combineSEs (map (statRhs top) pairs)
128 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
130 statRhs top (b, StgRhsCon cc con args)
131 = countOne (ConstructorBinds top)
133 statRhs top (b, StgRhsClosure cc bi fv u args body)
134 = statExpr body `combineSE`
135 countN FreeVariables (length fv) `combineSE`
138 ReEntrant -> ReEntrantBinds top
139 Updatable -> UpdatableBinds top
140 SingleEntry -> SingleEntryBinds top
144 %************************************************************************
146 \subsection{Expressions}
148 %************************************************************************
151 statExpr :: StgExpr -> StatEnv
153 statExpr (StgApp _ [] lvs)
155 statExpr (StgApp _ _ lvs)
156 = countOne Applications
158 statExpr (StgCon con as lvs)
159 = countOne ConstructorApps
161 statExpr (StgPrim op as lvs)
162 = countOne PrimitiveApps
164 statExpr (StgSCC ty l e)
167 statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
168 = statBinding False{-not top-level-} binds `combineSE`
169 statExpr body `combineSE`
170 countOne LetNoEscapes
172 statExpr (StgLet binds body)
173 = statBinding False{-not top-level-} binds `combineSE`
176 statExpr (StgCase expr lve lva uniq alts)
177 = statExpr expr `combineSE`
180 stat_alts (StgAlgAlts ty alts def)
181 = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
183 stat_deflt def `combineSE`
186 stat_alts (StgPrimAlts ty alts def)
187 = combineSEs (map statExpr [ e | (_,e) <- alts ])
189 stat_deflt def `combineSE`
192 stat_deflt StgNoDefault = emptySE
194 stat_deflt (StgBindDefault b u expr) = statExpr expr