never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-2015
4 -}
5
6 -- | Functions to computing the statistics reflective of the "size"
7 -- of a Core expression
8 module GHC.Core.Stats (
9 -- * Expression and bindings size
10 coreBindsSize, exprSize,
11 CoreStats(..), coreBindsStats, exprStats,
12 ) where
13
14 import GHC.Prelude
15
16 import GHC.Types.Basic
17 import GHC.Core
18 import GHC.Utils.Outputable
19 import GHC.Core.Coercion
20 import GHC.Types.Tickish
21 import GHC.Types.Var
22 import GHC.Core.Type(Type, typeSize)
23 import GHC.Types.Id (isJoinId)
24
25 data CoreStats = CS { cs_tm :: !Int -- Terms
26 , cs_ty :: !Int -- Types
27 , cs_co :: !Int -- Coercions
28 , cs_vb :: !Int -- Local value bindings
29 , cs_jb :: !Int } -- Local join bindings
30
31
32 instance Outputable CoreStats where
33 ppr (CS { cs_tm = i1, cs_ty = i2, cs_co = i3, cs_vb = i4, cs_jb = i5 })
34 = braces (sep [text "terms:" <+> intWithCommas i1 <> comma,
35 text "types:" <+> intWithCommas i2 <> comma,
36 text "coercions:" <+> intWithCommas i3 <> comma,
37 text "joins:" <+> intWithCommas i5 <> char '/' <>
38 intWithCommas (i4 + i5) ])
39
40 plusCS :: CoreStats -> CoreStats -> CoreStats
41 plusCS (CS { cs_tm = p1, cs_ty = q1, cs_co = r1, cs_vb = v1, cs_jb = j1 })
42 (CS { cs_tm = p2, cs_ty = q2, cs_co = r2, cs_vb = v2, cs_jb = j2 })
43 = CS { cs_tm = p1+p2, cs_ty = q1+q2, cs_co = r1+r2, cs_vb = v1+v2
44 , cs_jb = j1+j2 }
45
46 zeroCS, oneTM :: CoreStats
47 zeroCS = CS { cs_tm = 0, cs_ty = 0, cs_co = 0, cs_vb = 0, cs_jb = 0 }
48 oneTM = zeroCS { cs_tm = 1 }
49
50 sumCS :: (a -> CoreStats) -> [a] -> CoreStats
51 sumCS f = foldl' (\s a -> plusCS s (f a)) zeroCS
52
53 coreBindsStats :: [CoreBind] -> CoreStats
54 coreBindsStats = sumCS (bindStats TopLevel)
55
56 bindStats :: TopLevelFlag -> CoreBind -> CoreStats
57 bindStats top_lvl (NonRec v r) = bindingStats top_lvl v r
58 bindStats top_lvl (Rec prs) = sumCS (\(v,r) -> bindingStats top_lvl v r) prs
59
60 bindingStats :: TopLevelFlag -> Var -> CoreExpr -> CoreStats
61 bindingStats top_lvl v r = letBndrStats top_lvl v `plusCS` exprStats r
62
63 bndrStats :: Var -> CoreStats
64 bndrStats v = oneTM `plusCS` tyStats (varType v)
65
66 letBndrStats :: TopLevelFlag -> Var -> CoreStats
67 letBndrStats top_lvl v
68 | isTyVar v || isTopLevel top_lvl = bndrStats v
69 | isJoinId v = oneTM { cs_jb = 1 } `plusCS` ty_stats
70 | otherwise = oneTM { cs_vb = 1 } `plusCS` ty_stats
71 where
72 ty_stats = tyStats (varType v)
73
74 exprStats :: CoreExpr -> CoreStats
75 exprStats (Var {}) = oneTM
76 exprStats (Lit {}) = oneTM
77 exprStats (Type t) = tyStats t
78 exprStats (Coercion c) = coStats c
79 exprStats (App f a) = exprStats f `plusCS` exprStats a
80 exprStats (Lam b e) = bndrStats b `plusCS` exprStats e
81 exprStats (Let b e) = bindStats NotTopLevel b `plusCS` exprStats e
82 exprStats (Case e b _ as) = exprStats e `plusCS` bndrStats b
83 `plusCS` sumCS altStats as
84 exprStats (Cast e co) = coStats co `plusCS` exprStats e
85 exprStats (Tick _ e) = exprStats e
86
87 altStats :: CoreAlt -> CoreStats
88 altStats (Alt _ bs r) = altBndrStats bs `plusCS` exprStats r
89
90 altBndrStats :: [Var] -> CoreStats
91 -- Charge one for the alternative, not for each binder
92 altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs
93
94 tyStats :: Type -> CoreStats
95 tyStats ty = zeroCS { cs_ty = typeSize ty }
96
97 coStats :: Coercion -> CoreStats
98 coStats co = zeroCS { cs_co = coercionSize co }
99
100 coreBindsSize :: [CoreBind] -> Int
101 -- We use coreBindStats for user printout
102 -- but this one is a quick and dirty basis for
103 -- the simplifier's tick limit
104 coreBindsSize bs = sum (map bindSize bs)
105
106 exprSize :: CoreExpr -> Int
107 -- ^ A measure of the size of the expressions, strictly greater than 0
108 -- Counts *leaves*, not internal nodes. Types and coercions are not counted.
109 exprSize (Var _) = 1
110 exprSize (Lit _) = 1
111 exprSize (App f a) = exprSize f + exprSize a
112 exprSize (Lam b e) = bndrSize b + exprSize e
113 exprSize (Let b e) = bindSize b + exprSize e
114 exprSize (Case e b _ as) = exprSize e + bndrSize b + 1 + sum (map altSize as)
115 exprSize (Cast e _) = 1 + exprSize e
116 exprSize (Tick n e) = tickSize n + exprSize e
117 exprSize (Type _) = 1
118 exprSize (Coercion _) = 1
119
120 tickSize :: CoreTickish -> Int
121 tickSize (ProfNote _ _ _) = 1
122 tickSize _ = 1
123
124 bndrSize :: Var -> Int
125 bndrSize _ = 1
126
127 bndrsSize :: [Var] -> Int
128 bndrsSize = sum . map bndrSize
129
130 bindSize :: CoreBind -> Int
131 bindSize (NonRec b e) = bndrSize b + exprSize e
132 bindSize (Rec prs) = sum (map pairSize prs)
133
134 pairSize :: (Var, CoreExpr) -> Int
135 pairSize (b,e) = bndrSize b + exprSize e
136
137 altSize :: CoreAlt -> Int
138 altSize (Alt _ bs e) = bndrsSize bs + exprSize e