Renamer now preserves location for IEThingWith list items
[ghc.git] / compiler / profiling / ProfInit.hs
1 -- -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow, 2011
4 --
5 -- Generate code to initialise cost centres
6 --
7 -- -----------------------------------------------------------------------------
8
9 module ProfInit (profilingInitCode) where
10
11 import CLabel
12 import CostCentre
13 import DynFlags
14 import Outputable
15 import Module
16
17 -- -----------------------------------------------------------------------------
18 -- Initialising cost centres
19
20 -- We must produce declarations for the cost-centres defined in this
21 -- module;
22
23 profilingInitCode :: Module -> CollectedCCs -> SDoc
24 profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs)
25 = sdocWithDynFlags $ \dflags ->
26 if not (gopt Opt_SccProfilingOn dflags)
27 then empty
28 else vcat
29 $ map emit_cc_decl local_CCs
30 ++ map emit_ccs_decl singleton_CCSs
31 ++ [emit_cc_list local_CCs]
32 ++ [emit_ccs_list singleton_CCSs]
33 ++ [ text "static void prof_init_" <> ppr this_mod
34 <> text "(void) __attribute__((constructor));"
35 , text "static void prof_init_" <> ppr this_mod <> text "(void)"
36 , braces (vcat
37 [ text "registerCcList" <> parens local_cc_list_label <> semi
38 , text "registerCcsList" <> parens singleton_cc_list_label <> semi
39 ])
40 ]
41 where
42 emit_cc_decl cc =
43 text "extern CostCentre" <+> cc_lbl <> text "[];"
44 where cc_lbl = ppr (mkCCLabel cc)
45 local_cc_list_label = text "local_cc_" <> ppr this_mod
46 emit_cc_list ccs =
47 text "static CostCentre *" <> local_cc_list_label <> text "[] ="
48 <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma
49 | cc <- ccs
50 ] ++ [text "NULL"])
51 <> semi
52
53 emit_ccs_decl ccs =
54 text "extern CostCentreStack" <+> ccs_lbl <> text "[];"
55 where ccs_lbl = ppr (mkCCSLabel ccs)
56 singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod
57 emit_ccs_list ccs =
58 text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] ="
59 <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma
60 | cc <- ccs
61 ] ++ [text "NULL"])
62 <> semi