Improve isReflexiveCo performance
[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 GhcPrelude
31
32 import StgSyn
33
34 import Id (Id)
35 import Panic
36
37 import Data.Map (Map)
38 import qualified Data.Map as Map
39
40 data CounterType
41 = Literals
42 | Applications
43 | ConstructorApps
44 | PrimitiveApps
45 | LetNoEscapes
46 | StgCases
47 | FreeVariables
48 | ConstructorBinds Bool{-True<=>top-level-}
49 | ReEntrantBinds Bool{-ditto-}
50 | SingleEntryBinds Bool{-ditto-}
51 | UpdatableBinds Bool{-ditto-}
52 deriving (Eq, Ord)
53
54 type Count = Int
55 type StatEnv = Map CounterType Count
56
57 emptySE :: StatEnv
58 emptySE = Map.empty
59
60 combineSE :: StatEnv -> StatEnv -> StatEnv
61 combineSE = Map.unionWith (+)
62
63 combineSEs :: [StatEnv] -> StatEnv
64 combineSEs = foldr combineSE emptySE
65
66 countOne :: CounterType -> StatEnv
67 countOne c = Map.singleton c 1
68
69 countN :: CounterType -> Int -> StatEnv
70 countN = Map.singleton
71
72 {-
73 ************************************************************************
74 * *
75 \subsection{Top-level list of bindings (a ``program'')}
76 * *
77 ************************************************************************
78 -}
79
80 showStgStats :: [StgTopBinding] -> String
81
82 showStgStats prog
83 = "STG Statistics:\n\n"
84 ++ concat (map showc (Map.toList (gatherStgStats prog)))
85 where
86 showc (x,n) = (showString (s x) . shows n) "\n"
87
88 s Literals = "Literals "
89 s Applications = "Applications "
90 s ConstructorApps = "ConstructorApps "
91 s PrimitiveApps = "PrimitiveApps "
92 s LetNoEscapes = "LetNoEscapes "
93 s StgCases = "StgCases "
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 "
103
104 gatherStgStats :: [StgTopBinding] -> StatEnv
105 gatherStgStats binds = combineSEs (map statTopBinding binds)
106
107 {-
108 ************************************************************************
109 * *
110 \subsection{Bindings}
111 * *
112 ************************************************************************
113 -}
114
115 statTopBinding :: StgTopBinding -> StatEnv
116 statTopBinding (StgTopStringLit _ _) = countOne Literals
117 statTopBinding (StgTopLifted bind) = statBinding True bind
118
119 statBinding :: Bool -- True <=> top-level; False <=> nested
120 -> StgBinding
121 -> StatEnv
122
123 statBinding top (StgNonRec b rhs)
124 = statRhs top (b, rhs)
125
126 statBinding top (StgRec pairs)
127 = combineSEs (map (statRhs top) pairs)
128
129 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
130
131 statRhs top (_, StgRhsCon _ _ _)
132 = countOne (ConstructorBinds top)
133
134 statRhs top (_, StgRhsClosure _ _ fv u _ body)
135 = statExpr body `combineSE`
136 countN FreeVariables (length fv) `combineSE`
137 countOne (
138 case u of
139 ReEntrant -> ReEntrantBinds top
140 Updatable -> UpdatableBinds top
141 SingleEntry -> SingleEntryBinds top
142 )
143
144 {-
145 ************************************************************************
146 * *
147 \subsection{Expressions}
148 * *
149 ************************************************************************
150 -}
151
152 statExpr :: StgExpr -> StatEnv
153
154 statExpr (StgApp _ _) = countOne Applications
155 statExpr (StgLit _) = countOne Literals
156 statExpr (StgConApp _ _ _)= countOne ConstructorApps
157 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
158 statExpr (StgTick _ e) = statExpr e
159
160 statExpr (StgLetNoEscape binds body)
161 = statBinding False{-not top-level-} binds `combineSE`
162 statExpr body `combineSE`
163 countOne LetNoEscapes
164
165 statExpr (StgLet binds body)
166 = statBinding False{-not top-level-} binds `combineSE`
167 statExpr body
168
169 statExpr (StgCase expr _ _ alts)
170 = statExpr expr `combineSE`
171 stat_alts alts `combineSE`
172 countOne StgCases
173 where
174 stat_alts alts
175 = combineSEs (map statExpr [ e | (_,_,e) <- alts ])
176
177 statExpr (StgLam {}) = panic "statExpr StgLam"