Allow top-level string literals in Core (#8472)
[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 :: [StgTopBinding] -> 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 :: [StgTopBinding] -> StatEnv
103 gatherStgStats binds = combineSEs (map statTopBinding binds)
104
105 {-
106 ************************************************************************
107 * *
108 \subsection{Bindings}
109 * *
110 ************************************************************************
111 -}
112
113 statTopBinding :: StgTopBinding -> StatEnv
114 statTopBinding (StgTopStringLit _ _) = countOne Literals
115 statTopBinding (StgTopLifted bind) = statBinding True bind
116
117 statBinding :: Bool -- True <=> top-level; False <=> nested
118 -> StgBinding
119 -> StatEnv
120
121 statBinding top (StgNonRec b rhs)
122 = statRhs top (b, rhs)
123
124 statBinding top (StgRec pairs)
125 = combineSEs (map (statRhs top) pairs)
126
127 statRhs :: Bool -> (Id, StgRhs) -> StatEnv
128
129 statRhs top (_, StgRhsCon _ _ _)
130 = countOne (ConstructorBinds top)
131
132 statRhs top (_, StgRhsClosure _ _ fv u _ body)
133 = statExpr body `combineSE`
134 countN FreeVariables (length fv) `combineSE`
135 countOne (
136 case u of
137 ReEntrant -> ReEntrantBinds top
138 Updatable -> UpdatableBinds top
139 SingleEntry -> SingleEntryBinds top
140 )
141
142 {-
143 ************************************************************************
144 * *
145 \subsection{Expressions}
146 * *
147 ************************************************************************
148 -}
149
150 statExpr :: StgExpr -> StatEnv
151
152 statExpr (StgApp _ _) = countOne Applications
153 statExpr (StgLit _) = countOne Literals
154 statExpr (StgConApp _ _ _)= countOne ConstructorApps
155 statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
156 statExpr (StgTick _ e) = statExpr e
157
158 statExpr (StgLetNoEscape binds body)
159 = statBinding False{-not top-level-} binds `combineSE`
160 statExpr body `combineSE`
161 countOne LetNoEscapes
162
163 statExpr (StgLet binds body)
164 = statBinding False{-not top-level-} binds `combineSE`
165 statExpr body
166
167 statExpr (StgCase expr _ _ alts)
168 = statExpr expr `combineSE`
169 stat_alts alts `combineSE`
170 countOne StgCases
171 where
172 stat_alts alts
173 = combineSEs (map statExpr [ e | (_,_,e) <- alts ])
174
175 statExpr (StgLam {}) = panic "statExpr StgLam"