Don't track free variables in STG syntax by default
[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 {-
70 ************************************************************************
71 * *
72 \subsection{Top-level list of bindings (a ``program'')}
73 * *
74 ************************************************************************
75 -}
76
77 showStgStats :: [StgTopBinding] -> String
78
79 showStgStats prog
80 = "STG Statistics:\n\n"
81 ++ concat (map showc (Map.toList (gatherStgStats prog)))
82 where
83 showc (x,n) = (showString (s x) . shows n) "\n"
84
85 s Literals = "Literals "
86 s Applications = "Applications "
87 s ConstructorApps = "ConstructorApps "
88 s PrimitiveApps = "PrimitiveApps "
89 s LetNoEscapes = "LetNoEscapes "
90 s StgCases = "StgCases "
91 s FreeVariables = "FreeVariables "
92 s (ConstructorBinds True) = "ConstructorBinds_Top "
93 s (ReEntrantBinds True) = "ReEntrantBinds_Top "
94 s (SingleEntryBinds True) = "SingleEntryBinds_Top "
95 s (UpdatableBinds True) = "UpdatableBinds_Top "
96 s (ConstructorBinds _) = "ConstructorBinds_Nested "
97 s (ReEntrantBinds _) = "ReEntrantBindsBinds_Nested "
98 s (SingleEntryBinds _) = "SingleEntryBinds_Nested "
99 s (UpdatableBinds _) = "UpdatableBinds_Nested "
100
101 gatherStgStats :: [StgTopBinding] -> StatEnv
102 gatherStgStats binds = combineSEs (map statTopBinding binds)
103
104 {-
105 ************************************************************************
106 * *
107 \subsection{Bindings}
108 * *
109 ************************************************************************
110 -}
111
112 statTopBinding :: StgTopBinding -> StatEnv
113 statTopBinding (StgTopStringLit _ _) = countOne Literals
114 statTopBinding (StgTopLifted bind) = statBinding True bind
115
116 statBinding :: Bool -- True <=> top-level; False <=> nested
117 -> StgBinding
118 -> StatEnv
119
120 statBinding top (StgNonRec b rhs)
121 = statRhs top (b, rhs)
122
123 statBinding top (StgRec pairs)
124 = combineSEs (map (statRhs top) pairs)
125
126 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
127
128 statRhs top (_, StgRhsCon _ _ _)
129 = countOne (ConstructorBinds top)
130
131 statRhs top (_, StgRhsClosure _ _ u _ body)
132 = statExpr body `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"