38544822d2e2821b77490cb6383c5528034f5f33
[ghc.git] / compiler / simplStg / StgStats.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[StgStats]{Gathers statistical information about programs}
5
6
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 -}
23
24 {-# LANGUAGE CPP #-}
25
26 module StgStats ( showStgStats ) where
27
28 #include "HsVersions.h"
29
30 import StgSyn
31
32 import Id (Id)
33 import Panic
34
35 import Data.Map (Map)
36 import qualified Data.Map as Map
37
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)
51
52 type Count = Int
53 type StatEnv = Map CounterType Count
54
55 emptySE :: StatEnv
56 emptySE = Map.empty
57
58 combineSE :: StatEnv -> StatEnv -> StatEnv
59 combineSE = Map.unionWith (+)
60
61 combineSEs :: [StatEnv] -> StatEnv
62 combineSEs = foldr combineSE emptySE
63
64 countOne :: CounterType -> StatEnv
65 countOne c = Map.singleton c 1
66
67 countN :: CounterType -> Int -> StatEnv
68 countN = Map.singleton
69
70 {-
71 ************************************************************************
72 * *
73 \subsection{Top-level list of bindings (a ``program'')}
74 * *
75 ************************************************************************
76 -}
77
78 showStgStats :: [StgBinding] -> String
79
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"
85
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 "
101
102 gatherStgStats :: [StgBinding] -> StatEnv
103
104 gatherStgStats binds
105 = combineSEs (map (statBinding True{-top-level-}) binds)
106
107 {-
108 ************************************************************************
109 * *
110 \subsection{Bindings}
111 * *
112 ************************************************************************
113 -}
114
115 statBinding :: Bool -- True <=> top-level; False <=> nested
116 -> StgBinding
117 -> StatEnv
118
119 statBinding top (StgNonRec b rhs)
120 = statRhs top (b, rhs)
121
122 statBinding top (StgRec pairs)
123 = combineSEs (map (statRhs top) pairs)
124
125 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
126
127 statRhs top (_, StgRhsCon _ _ _)
128 = countOne (ConstructorBinds top)
129
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 )
139
140 {-
141 ************************************************************************
142 * *
143 \subsection{Expressions}
144 * *
145 ************************************************************************
146 -}
147
148 statExpr :: StgExpr -> StatEnv
149
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
155
156 statExpr (StgLetNoEscape binds body)
157 = statBinding False{-not top-level-} binds `combineSE`
158 statExpr body `combineSE`
159 countOne LetNoEscapes
160
161 statExpr (StgLet binds body)
162 = statBinding False{-not top-level-} binds `combineSE`
163 statExpr body
164
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 ])
172
173 statExpr (StgLam {}) = panic "statExpr StgLam"