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 {-# 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
31 module StgStats ( showStgStats ) where
33 -- XXX This define is a bit of a hack, and should be done more nicely
34 #define FAST_STRING_NOT_NEEDED 1
35 #include "HsVersions.h"
39 import FiniteMap ( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
52 | ConstructorBinds Bool{-True<=>top-level-}
53 | ReEntrantBinds Bool{-ditto-}
54 | SingleEntryBinds Bool{-ditto-}
55 | UpdatableBinds Bool{-ditto-}
59 type StatEnv = FiniteMap CounterType Count
66 combineSE :: StatEnv -> StatEnv -> StatEnv
67 combineSE = plusFM_C (+)
69 combineSEs :: [StatEnv] -> StatEnv
70 combineSEs = foldr combineSE emptySE
72 countOne :: CounterType -> StatEnv
73 countOne c = unitFM c 1
75 countN :: CounterType -> Int -> StatEnv
79 %************************************************************************
81 \subsection{Top-level list of bindings (a ``program'')}
83 %************************************************************************
86 showStgStats :: [StgBinding] -> String
89 = "STG Statistics:\n\n"
90 ++ concat (map showc (fmToList (gatherStgStats prog)))
92 showc (x,n) = (showString (s x) . shows n) "\n"
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 "
110 gatherStgStats :: [StgBinding] -> StatEnv
113 = combineSEs (map (statBinding True{-top-level-}) binds)
116 %************************************************************************
118 \subsection{Bindings}
120 %************************************************************************
123 statBinding :: Bool -- True <=> top-level; False <=> nested
127 statBinding top (StgNonRec b rhs)
128 = statRhs top (b, rhs)
130 statBinding top (StgRec pairs)
131 = combineSEs (map (statRhs top) pairs)
133 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
135 statRhs top (_, StgRhsCon _ _ _)
136 = countOne (ConstructorBinds top)
138 statRhs top (_, StgRhsClosure _ _ fv u _ _ body)
139 = statExpr body `combineSE`
140 countN FreeVariables (length fv) `combineSE`
143 ReEntrant -> ReEntrantBinds top
144 Updatable -> UpdatableBinds top
145 SingleEntry -> SingleEntryBinds top
149 %************************************************************************
151 \subsection{Expressions}
153 %************************************************************************
156 statExpr :: StgExpr -> StatEnv
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
165 statExpr (StgLetNoEscape _ _ binds body)
166 = statBinding False{-not top-level-} binds `combineSE`
167 statExpr body `combineSE`
168 countOne LetNoEscapes
170 statExpr (StgLet binds body)
171 = statBinding False{-not top-level-} binds `combineSE`
174 statExpr (StgCase expr _ _ _ _ _ alts)
175 = statExpr expr `combineSE`
176 stat_alts alts `combineSE`
180 = combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])