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}
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
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
| 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}
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
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 ");"
]
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
])
-- 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}
= 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
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
projects / ghc-hetmet.git / blobdiff