1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[StgStats]{Gathers statistical information about programs}
7 The program gather statistics about
8 \begin{enumerate}
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
21 \end{enumerate}
22 -}
24 {-# LANGUAGE CPP #-}
26 module StgStats ( showStgStats ) where
28 #include "HsVersions.h"
30 import StgSyn
32 import Id (Id)
33 import Panic
35 import Data.Map (Map)
36 import qualified Data.Map as Map
38 data CounterType
39 = Literals
40 | Applications
41 | ConstructorApps
42 | PrimitiveApps
43 | LetNoEscapes
44 | StgCases
45 | FreeVariables
46 | ConstructorBinds Bool{-True<=>top-level-}
47 | ReEntrantBinds Bool{-ditto-}
48 | SingleEntryBinds Bool{-ditto-}
49 | UpdatableBinds Bool{-ditto-}
50 deriving (Eq, Ord)
52 type Count = Int
53 type StatEnv = Map CounterType Count
55 emptySE :: StatEnv
56 emptySE = Map.empty
58 combineSE :: StatEnv -> StatEnv -> StatEnv
59 combineSE = Map.unionWith (+)
61 combineSEs :: [StatEnv] -> StatEnv
62 combineSEs = foldr combineSE emptySE
64 countOne :: CounterType -> StatEnv
65 countOne c = Map.singleton c 1
67 countN :: CounterType -> Int -> StatEnv
68 countN = Map.singleton
70 {-
71 ************************************************************************
72 * *
73 \subsection{Top-level list of bindings (a program'')}
74 * *
75 ************************************************************************
76 -}
78 showStgStats :: [StgBinding] -> String
80 showStgStats prog
81 = "STG Statistics:\n\n"
82 ++ concat (map showc (Map.toList (gatherStgStats prog)))
83 where
84 showc (x,n) = (showString (s x) . shows n) "\n"
86 s Literals = "Literals "
87 s Applications = "Applications "
88 s ConstructorApps = "ConstructorApps "
89 s PrimitiveApps = "PrimitiveApps "
90 s LetNoEscapes = "LetNoEscapes "
91 s StgCases = "StgCases "
92 s FreeVariables = "FreeVariables "
93 s (ConstructorBinds True) = "ConstructorBinds_Top "
94 s (ReEntrantBinds True) = "ReEntrantBinds_Top "
95 s (SingleEntryBinds True) = "SingleEntryBinds_Top "
96 s (UpdatableBinds True) = "UpdatableBinds_Top "
97 s (ConstructorBinds _) = "ConstructorBinds_Nested "
98 s (ReEntrantBinds _) = "ReEntrantBindsBinds_Nested "
99 s (SingleEntryBinds _) = "SingleEntryBinds_Nested "
100 s (UpdatableBinds _) = "UpdatableBinds_Nested "
102 gatherStgStats :: [StgBinding] -> StatEnv
104 gatherStgStats binds
105 = combineSEs (map (statBinding True{-top-level-}) binds)
107 {-
108 ************************************************************************
109 * *
110 \subsection{Bindings}
111 * *
112 ************************************************************************
113 -}
115 statBinding :: Bool -- True <=> top-level; False <=> nested
116 -> StgBinding
117 -> StatEnv
119 statBinding top (StgNonRec b rhs)
120 = statRhs top (b, rhs)
122 statBinding top (StgRec pairs)
123 = combineSEs (map (statRhs top) pairs)
125 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
127 statRhs top (_, StgRhsCon _ _ _)
128 = countOne (ConstructorBinds top)
130 statRhs top (_, StgRhsClosure _ _ fv u _ body)
131 = statExpr body combineSE
132 countN FreeVariables (length fv) combineSE
133 countOne (
134 case u of
135 ReEntrant -> ReEntrantBinds top
136 Updatable -> UpdatableBinds top
137 SingleEntry -> SingleEntryBinds top
138 )
140 {-
141 ************************************************************************
142 * *
143 \subsection{Expressions}
144 * *
145 ************************************************************************
146 -}
148 statExpr :: StgExpr -> StatEnv
150 statExpr (StgApp _ _) = countOne Applications
151 statExpr (StgLit _) = countOne Literals
152 statExpr (StgConApp _ _ _)= countOne ConstructorApps
153 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
154 statExpr (StgTick _ e) = statExpr e
156 statExpr (StgLetNoEscape 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
163 statExpr body
165 statExpr (StgCase expr _ _ alts)
166 = statExpr expr combineSE
167 stat_alts alts combineSE
168 countOne StgCases
169 where
170 stat_alts alts
171 = combineSEs (map statExpr [ e | (_,_,e) <- alts ])
173 statExpr (StgLam {}) = panic "statExpr StgLam"