X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprofiling%2FCostCentre.lhs;h=38c5a82036578ef5b8740b749e6d0edb9af31efd;hp=3ee46a88dbdfc549cde2d6362375514b1ccfb534;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index 3ee46a8..38c5a82 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -4,6 +4,13 @@ \section[CostCentre]{The @CostCentre@ data type} \begin{code} +{-# OPTIONS_GHC -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- for details + module CostCentre ( CostCentre(..), CcName, IsDupdCC(..), IsCafCC(..), -- All abstract except to friend: ParseIface.y @@ -32,8 +39,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 +213,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 +353,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 +369,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,