X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprofiling%2FCostCentre.lhs;h=78642e21bfbe2730c2317dd6b751e9cce2cef4b9;hb=0b6113b8a28a25fc08a0e9daf72bd0715d2dbc78;hp=8aeba31447e74b82129ff42adfea9003226d8821;hpb=e1db55d8bd07c79bae30f548e597f709dd029155;p=ghc-hetmet.git diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs index 8aeba31..78642e2 100644 --- a/ghc/compiler/profiling/CostCentre.lhs +++ b/ghc/compiler/profiling/CostCentre.lhs @@ -31,8 +31,12 @@ import Var ( Id ) import Name ( UserFS, EncodedFS, encodeFS, decode, getOccName, occNameFS ) -import Module ( Module, pprModule, moduleUserString ) +import Module ( Module, ModuleName, moduleName, + moduleNameUserString + ) import Outputable +import CStrings ( pprStringInCStyle ) +import FastTypes import Util ( thenCmp ) \end{code} @@ -96,26 +100,19 @@ data CostCentreStack A Cost Centre is the argument of an _scc_ expression. \begin{code} -type Group = FAST_STRING -- "Group" that this CC is in; eg directory - data CostCentre = NoCostCentre -- Having this constructor avoids having -- to use "Maybe CostCentre" all the time. | NormalCC { - cc_name :: CcName, -- Name of the cost centre itself - cc_mod :: Module, -- Name of module defining this CC. - cc_grp :: Group, -- "Group" that this CC is in. - cc_is_dupd :: IsDupdCC, -- see below - cc_is_caf :: IsCafCC -- see below + cc_name :: CcName, -- Name of the cost centre itself + cc_mod :: ModuleName, -- Name of module defining this CC. + cc_is_dupd :: IsDupdCC, -- see below + cc_is_caf :: IsCafCC -- see below } | AllCafsCC { - cc_mod :: Module, -- Name of module defining this CC. - cc_grp :: Group -- "Group" that this CC is in - -- Again, one "big" CAF cc per module, where all - -- CAF costs are attributed unless the user asked for - -- per-individual-CAF cost attribution. + cc_mod :: ModuleName -- Name of module defining this CC. } type CcName = EncodedFS @@ -183,23 +180,21 @@ currentOrSubsumedCCS _ = False Building cost centres \begin{code} -mkUserCC :: UserFS -> Module -> Group -> CostCentre +mkUserCC :: UserFS -> Module -> CostCentre -mkUserCC cc_name module_name group_name - = NormalCC { cc_name = encodeFS cc_name, - cc_mod = module_name, cc_grp = group_name, +mkUserCC cc_name mod + = NormalCC { cc_name = encodeFS cc_name, cc_mod = moduleName mod, cc_is_dupd = OriginalCC, cc_is_caf = NotCafCC {-might be changed-} } -mkAutoCC :: Id -> Module -> Group -> IsCafCC -> CostCentre +mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre -mkAutoCC id module_name group_name is_caf - = NormalCC { cc_name = occNameFS (getOccName id), - cc_mod = module_name, cc_grp = group_name, +mkAutoCC id mod is_caf + = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = moduleName mod, cc_is_dupd = OriginalCC, cc_is_caf = is_caf } -mkAllCafsCC m g = AllCafsCC { cc_mod = m, cc_grp = g } +mkAllCafsCC m = AllCafsCC { cc_mod = moduleName m } mkSingletonCCS :: CostCentre -> CostCentreStack mkSingletonCCS cc = SingletonCCS cc @@ -248,7 +243,7 @@ sccAbleCostCentre cc | isCafCC cc = False | otherwise = True ccFromThisModule :: CostCentre -> Module -> Bool -ccFromThisModule cc m = cc_mod cc == m +ccFromThisModule cc m = cc_mod cc == moduleName m \end{code} \begin{code} @@ -273,10 +268,10 @@ cmpCostCentre other_1 other_2 tag1 = tag_CC other_1 tag2 = tag_CC other_2 in - if tag1 _LT_ tag2 then LT else GT + if tag1 <# tag2 then LT else GT where - tag_CC (NormalCC {}) = (ILIT(1) :: FAST_INT) - tag_CC (AllCafsCC {}) = ILIT(2) + tag_CC (NormalCC {}) = (_ILIT 1 :: FastInt) + tag_CC (AllCafsCC {}) = _ILIT 2 cmp_caf NotCafCC CafCC = LT cmp_caf NotCafCC NotCafCC = EQ @@ -298,19 +293,15 @@ instance Outputable CostCentreStack where NoCCS -> ptext SLIT("NO_CCS") CurrentCCS -> ptext SLIT("CCCS") OverheadCCS -> ptext SLIT("CCS_OVERHEAD") - DontCareCCS -> ptext SLIT("CCS_DONTZuCARE") + DontCareCCS -> ptext SLIT("CCS_DONT_CARE") SubsumedCCS -> ptext SLIT("CCS_SUBSUMED") - SingletonCCS cc -> ptext SLIT("CCS_") <> ppr cc + SingletonCCS cc -> ppr cc <> ptext SLIT("_ccs") pprCostCentreStackDecl :: CostCentreStack -> SDoc pprCostCentreStackDecl ccs@(SingletonCCS cc) - = let - is_subsumed = ccSubsumed cc - in - hcat [ ptext SLIT("CCS_DECLARE"), char '(', + = hcat [ ptext SLIT("CCS_DECLARE"), char '(', ppr ccs, comma, -- better be codeStyle ppCostCentreLbl cc, comma, - ptext is_subsumed, comma, empty, -- Now always externally visible text ");" ] @@ -341,14 +332,13 @@ instance Outputable CostCentre where else text (costCentreUserName cc) -- Printing in an interface file or in Core generally -pprCostCentreCore (AllCafsCC {cc_mod = m, cc_grp = g}) - = text "__sccC" <+> braces (pprModule m <+> doubleQuotes (ptext g)) -pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m, cc_grp = g, +pprCostCentreCore (AllCafsCC {cc_mod = m}) + = text "__sccC" <+> braces (ppr m) +pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = caf, cc_is_dupd = dup}) = text "__scc" <+> braces (hsep [ ptext n, - pprModule m, - doubleQuotes (ptext g), + ppr m, pp_dup dup, pp_caf caf ]) @@ -361,15 +351,17 @@ pp_caf other = empty -- Printing as a C label -ppCostCentreLbl (NoCostCentre) = text "CC_NONE" -ppCostCentreLbl (AllCafsCC {cc_mod = m}) = text "CC_CAFs_" <> pprModule m -ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m}) = text "CC_" <> pprModule m <> ptext n +ppCostCentreLbl (NoCostCentre) = text "NONE_cc" +ppCostCentreLbl (AllCafsCC {cc_mod = m}) = ppr m <> text "_CAFs_cc" +ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf}) + = ppr m <> ptext n <> + text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc" -- This is the name to go in the user-displayed string, -- recorded in the cost centre declaration costCentreUserName (NoCostCentre) = "NO_CC" -costCentreUserName (AllCafsCC {}) = "CAFs_in_..." -costCentreUserName (NormalCC {cc_name = name, cc_is_caf = is_caf}) +costCentreUserName (AllCafsCC {}) = "CAF" +costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf}) = case is_caf of { CafCC -> "CAF:"; _ -> "" } ++ decode (_UNPK_ name) \end{code} @@ -384,11 +376,10 @@ pprCostCentreDecl is_local cc = if is_local then hcat [ ptext SLIT("CC_DECLARE"),char '(', - cc_ident, comma, - doubleQuotes (text (costCentreUserName cc)), comma, - doubleQuotes (text (moduleUserString mod_name)), comma, - doubleQuotes (ptext grp_name), comma, - ptext is_subsumed, comma, + cc_ident, comma, + pprStringInCStyle (costCentreUserName cc), comma, + pprStringInCStyle (moduleNameUserString mod_name), comma, + ptext is_subsumed, comma, empty, -- Now always externally visible text ");"] else @@ -396,7 +387,6 @@ pprCostCentreDecl is_local cc where cc_ident = ppCostCentreLbl cc mod_name = cc_mod cc - grp_name = cc_grp cc is_subsumed = ccSubsumed cc ccSubsumed :: CostCentre -> FAST_STRING -- subsumed value