never executed always true always false
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE TypeFamilies #-}
3
4 -- |
5 -- Statistics for per-module compilations
6 --
7 -- (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
8 --
9
10 module GHC.Hs.Stats ( ppSourceStats ) where
11
12 import GHC.Prelude
13
14 import GHC.Data.Bag
15 import GHC.Hs
16 import GHC.Types.SrcLoc
17
18 import GHC.Utils.Outputable
19 import GHC.Utils.Misc
20 import GHC.Utils.Panic
21
22 import Data.Char
23
24 -- | Source Statistics
25 ppSourceStats :: Bool -> Located HsModule -> SDoc
26 ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = imports, hsmodDecls = ldecls }))
27 = (if short then hcat else vcat)
28 (map pp_val
29 [("ExportAll ", export_all), -- 1 if no export list
30 ("ExportDecls ", export_ds),
31 ("ExportModules ", export_ms),
32 ("Imports ", imp_no),
33 (" ImpSafe ", imp_safe),
34 (" ImpQual ", imp_qual),
35 (" ImpAs ", imp_as),
36 (" ImpAll ", imp_all),
37 (" ImpPartial ", imp_partial),
38 (" ImpHiding ", imp_hiding),
39 ("FixityDecls ", fixity_sigs),
40 ("DefaultDecls ", default_ds),
41 ("TypeDecls ", type_ds),
42 ("DataDecls ", data_ds),
43 ("NewTypeDecls ", newt_ds),
44 ("TypeFamilyDecls ", type_fam_ds),
45 ("DataConstrs ", data_constrs),
46 ("DataDerivings ", data_derivs),
47 ("ClassDecls ", class_ds),
48 ("ClassMethods ", class_method_ds),
49 ("DefaultMethods ", default_method_ds),
50 ("InstDecls ", inst_ds),
51 ("InstMethods ", inst_method_ds),
52 ("InstType ", inst_type_ds),
53 ("InstData ", inst_data_ds),
54 ("TypeSigs ", bind_tys),
55 ("ClassOpSigs ", generic_sigs),
56 ("ValBinds ", val_bind_ds),
57 ("FunBinds ", fn_bind_ds),
58 ("PatSynBinds ", patsyn_ds),
59 ("InlineMeths ", method_inlines),
60 ("InlineBinds ", bind_inlines),
61 ("SpecialisedMeths ", method_specs),
62 ("SpecialisedBinds ", bind_specs)
63 ])
64 where
65 decls = map unLoc ldecls
66
67 pp_val (_, 0) = empty
68 pp_val (str, n)
69 | not short = hcat [text str, int n]
70 | otherwise = hcat [text (trim str), equals, int n, semi]
71
72 trim ls = takeWhile (not.isSpace) (dropWhile isSpace ls)
73
74 (fixity_sigs, bind_tys, bind_specs, bind_inlines, generic_sigs)
75 = count_sigs [d | SigD _ d <- decls]
76 -- NB: this omits fixity decls on local bindings and
77 -- in class decls. ToDo
78
79 tycl_decls = [d | TyClD _ d <- decls]
80 (class_ds, type_ds, data_ds, newt_ds, type_fam_ds) =
81 countTyClDecls tycl_decls
82
83 inst_decls = [d | InstD _ d <- decls]
84 inst_ds = length inst_decls
85 default_ds = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls
86 val_decls = [d | ValD _ d <- decls]
87
88 real_exports = case exports of { Nothing -> []; Just (L _ es) -> es }
89 n_exports = length real_exports
90 export_ms = count (\ e -> case unLoc e of { IEModuleContents{} -> True
91 ; _ -> False})
92 real_exports
93 export_ds = n_exports - export_ms
94 export_all = case exports of { Nothing -> 1; _ -> 0 }
95
96 (val_bind_ds, fn_bind_ds, patsyn_ds)
97 = sum3 (map count_bind val_decls)
98
99 (imp_no, imp_safe, imp_qual, imp_as, imp_all, imp_partial, imp_hiding)
100 = sum7 (map import_info imports)
101 (data_constrs, data_derivs)
102 = sum2 (map data_info tycl_decls)
103 (class_method_ds, default_method_ds)
104 = sum2 (map class_info tycl_decls)
105 (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds)
106 = sum5 (map inst_info inst_decls)
107
108 count_bind (PatBind { pat_lhs = L _ (VarPat{}) }) = (1,0,0)
109 count_bind (PatBind {}) = (0,1,0)
110 count_bind (FunBind {}) = (0,1,0)
111 count_bind (PatSynBind {}) = (0,0,1)
112 count_bind b = pprPanic "count_bind: Unhandled binder" (ppr b)
113
114 count_sigs sigs = sum5 (map sig_info sigs)
115
116 sig_info (FixSig {}) = (1,0,0,0,0)
117 sig_info (TypeSig {}) = (0,1,0,0,0)
118 sig_info (SpecSig {}) = (0,0,1,0,0)
119 sig_info (InlineSig {}) = (0,0,0,1,0)
120 sig_info (ClassOpSig {}) = (0,0,0,0,1)
121 sig_info _ = (0,0,0,0,0)
122
123 import_info :: LImportDecl GhcPs -> (Int, Int, Int, Int, Int, Int, Int)
124 import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
125 , ideclAs = as, ideclHiding = spec }))
126 = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
127
128 safe_info False = 0
129 safe_info True = 1
130 qual_info NotQualified = 0
131 qual_info _ = 1
132 as_info Nothing = 0
133 as_info (Just _) = 1
134 spec_info Nothing = (0,0,0,0,1,0,0)
135 spec_info (Just (False, _)) = (0,0,0,0,0,1,0)
136 spec_info (Just (True, _)) = (0,0,0,0,0,0,1)
137
138 data_info (DataDecl { tcdDataDefn = HsDataDefn
139 { dd_cons = cs
140 , dd_derivs = derivs}})
141 = ( length cs
142 , foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s)
143 0 derivs )
144 data_info _ = (0,0)
145
146 class_info decl@(ClassDecl {})
147 = (classops, addpr (sum3 (map count_bind methods)))
148 where
149 methods = map unLoc $ bagToList (tcdMeths decl)
150 (_, classops, _, _, _) = count_sigs (map unLoc (tcdSigs decl))
151 class_info _ = (0,0)
152
153 inst_info :: InstDecl GhcPs -> (Int, Int, Int, Int, Int)
154 inst_info (TyFamInstD {}) = (0,0,0,1,0)
155 inst_info (DataFamInstD {}) = (0,0,0,0,1)
156 inst_info (ClsInstD { cid_inst = ClsInstDecl {cid_binds = inst_meths
157 , cid_sigs = inst_sigs
158 , cid_tyfam_insts = ats
159 , cid_datafam_insts = adts } })
160 = case count_sigs (map unLoc inst_sigs) of
161 (_,_,ss,is,_) ->
162 (addpr (sum3 (map count_bind methods)),
163 ss, is, length ats, length adts)
164 where
165 methods = map unLoc $ bagToList inst_meths
166
167 -- TODO: use Sum monoid
168 addpr :: (Int,Int,Int) -> Int
169 sum2 :: [(Int, Int)] -> (Int, Int)
170 sum3 :: [(Int, Int, Int)] -> (Int, Int, Int)
171 sum5 :: [(Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int)
172 sum7 :: [(Int, Int, Int, Int, Int, Int, Int)] -> (Int, Int, Int, Int, Int, Int, Int)
173 add7 :: (Int, Int, Int, Int, Int, Int, Int) -> (Int, Int, Int, Int, Int, Int, Int)
174 -> (Int, Int, Int, Int, Int, Int, Int)
175
176 addpr (x,y,z) = x+y+z
177 sum2 = foldr add2 (0,0)
178 where
179 add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2)
180 sum3 = foldr add3 (0,0,0)
181 where
182 add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3)
183 sum5 = foldr add5 (0,0,0,0,0)
184 where
185 add5 (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5)
186 sum7 = foldr add7 (0,0,0,0,0,0,0)
187
188 add7 (x1,x2,x3,x4,x5,x6,x7) (y1,y2,y3,y4,y5,y6,y7) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6,x7+y7)