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