X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprofiling%2FCostCentre.lhs;h=bc3a5d169d5051a7c48b4edc00e9183bbffa693b;hb=e07e2550074ddc7d96e2092e56add418403bd29a;hp=3ee46a88dbdfc549cde2d6362375514b1ccfb534;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index 3ee46a8..bc3a5d1 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -32,8 +32,8 @@ module CostCentre ( #include "HsVersions.h" import Var ( Id ) -import Name ( getOccName, occNameFS ) -import Module ( Module, moduleFS ) +import Name +import Module ( Module ) import Outputable import FastTypes import FastString @@ -206,9 +206,16 @@ mkUserCC cc_name mod mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre mkAutoCC id mod is_caf - = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = mod, + = NormalCC { cc_name = str, cc_mod = mod, cc_is_dupd = OriginalCC, cc_is_caf = is_caf } + where + name = getName id + -- beware: we might be making an auto CC for a compiler-generated + -- thing (like a CAF when -caf-all is on), so include the uniq. + -- See bug #249, tests prof001, prof002 + str | isSystemName name = mkFastString (showSDoc (ppr name)) + | otherwise = occNameFS (getOccName id) mkAllCafsCC m = AllCafsCC { cc_mod = m } @@ -339,12 +346,12 @@ instance Outputable CostCentre where -- Printing in an interface file or in Core generally pprCostCentreCore (AllCafsCC {cc_mod = m}) - = text "__sccC" <+> braces (ppr_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 [ ftext (zEncodeFS n), - ppr_mod m, + ppr m, pp_dup dup, pp_caf caf ]) @@ -355,13 +362,11 @@ pp_dup other = empty pp_caf CafCC = text "__C" pp_caf other = empty -ppr_mod m = ftext (zEncodeFS (moduleFS m)) - -- Printing as a C label 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_mod m <> ftext (zEncodeFS n) <> + = ppr m <> char '_' <> ftext (zEncodeFS n) <> text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc" -- This is the name to go in the user-displayed string,