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