noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS,
noCostCentre, noCCAttached,
noCCSAttached, isCurrentCCS, isSubsumedCCS, currentOrSubsumedCCS,
- isDerivedFromCurrentCCS,
+ isDerivedFromCurrentCCS, maybeSingletonCCS,
+ decomposeCCS,
mkUserCC, mkAutoCC, mkAllCafsCC,
- mkSingletonCCS, cafifyCC, dupifyCC, pushCCOnCCS,
- isCafCC, isDupdCC, isEmptyCC, isCafCCS,
+ mkSingletonCCS, dupifyCC, pushCCOnCCS,
+ isCafCCS, isCafCC,
isSccCountCostCentre,
sccAbleCostCentre,
ccFromThisModule,
- pprCostCentreDecl, pprCostCentreStackDecl, pprCostCentreCore,
+ pprCostCentreCore,
+ costCentreUserName,
cmpCostCentre -- used for removing dups in a list
) where
#include "HsVersions.h"
import Var ( Id )
-import Name ( UserFS, EncodedFS, encodeFS, decode,
- getOccName, occNameFS
- )
-import Module ( Module, ModuleName, moduleName,
- moduleNameUserString
- )
+import Name ( getOccName, occNameFS )
+import Module ( Module, moduleFS )
import Outputable
-import CStrings ( pprStringInCStyle )
import FastTypes
import FastString
import Util ( thenCmp )
| NormalCC {
cc_name :: CcName, -- Name of the cost centre itself
- cc_mod :: ModuleName, -- Name of module defining this CC.
+ cc_mod :: Module, -- Name of module defining this CC.
cc_is_dupd :: IsDupdCC, -- see below
cc_is_caf :: IsCafCC -- see below
}
| AllCafsCC {
- cc_mod :: ModuleName -- Name of module defining this CC.
+ cc_mod :: Module -- Name of module defining this CC.
}
-type CcName = EncodedFS
+type CcName = FastString
data IsDupdCC
= OriginalCC -- This says how the CC is *used*. Saying that
currentOrSubsumedCCS SubsumedCCS = True
currentOrSubsumedCCS CurrentCCS = True
currentOrSubsumedCCS _ = False
+
+maybeSingletonCCS (PushCC cc NoCCS) = Just cc
+maybeSingletonCCS _ = Nothing
\end{code}
Building cost centres
\begin{code}
-mkUserCC :: UserFS -> Module -> CostCentre
+mkUserCC :: FastString -> Module -> CostCentre
mkUserCC cc_name mod
- = NormalCC { cc_name = encodeFS cc_name, cc_mod = moduleName mod,
+ = NormalCC { cc_name = cc_name, cc_mod = mod,
cc_is_dupd = OriginalCC, cc_is_caf = NotCafCC {-might be changed-}
}
mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre
mkAutoCC id mod is_caf
- = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = moduleName mod,
+ = NormalCC { cc_name = occNameFS (getOccName id), cc_mod = mod,
cc_is_dupd = OriginalCC, cc_is_caf = is_caf
}
-mkAllCafsCC m = AllCafsCC { cc_mod = moduleName m }
+mkAllCafsCC m = AllCafsCC { cc_mod = m }
pushCCOnCCS :: CostCentre -> CostCentreStack -> CostCentreStack
pushCCOnCCS = PushCC
-cafifyCC, dupifyCC :: CostCentre -> CostCentre
-cafifyCC cc@(NormalCC {cc_is_caf = is_caf})
- = ASSERT(not_a_caf_already is_caf)
- cc {cc_is_caf = CafCC}
- where
- not_a_caf_already CafCC = False
- not_a_caf_already _ = True
-cafifyCC cc = pprPanic "cafifyCC" (ppr cc)
-
dupifyCC cc = cc {cc_is_dupd = DupdCC}
-isEmptyCC, isCafCC, isDupdCC :: CostCentre -> Bool
-
-isEmptyCC (NoCostCentre) = True
-isEmptyCC _ = False
+isCafCC, isDupdCC :: CostCentre -> Bool
isCafCC (AllCafsCC {}) = True
isCafCC (NormalCC {cc_is_caf = CafCC}) = True
| otherwise = True
ccFromThisModule :: CostCentre -> Module -> Bool
-ccFromThisModule cc m = cc_mod cc == moduleName m
+ccFromThisModule cc m = cc_mod cc == m
\end{code}
\begin{code}
cmp_caf NotCafCC NotCafCC = EQ
cmp_caf CafCC CafCC = EQ
cmp_caf CafCC NotCafCC = GT
+
+decomposeCCS :: CostCentreStack -> ([CostCentre],CostCentreStack)
+decomposeCCS (PushCC cc ccs) = (cc:more, ccs')
+ where (more,ccs') = decomposeCCS ccs
+decomposeCCS ccs = ([],ccs)
\end{code}
-----------------------------------------------------------------------------
ppr SubsumedCCS = ptext SLIT("CCS_SUBSUMED")
ppr (PushCC cc NoCCS) = ppr cc <> ptext SLIT("_ccs")
ppr (PushCC cc ccs) = ptext SLIT("PushCostCentre") <>
- parens (ppr ccs <> comma <> ppr cc)
-
--- print the static declaration for a singleton CCS.
-pprCostCentreStackDecl :: CostCentreStack -> SDoc
-pprCostCentreStackDecl ccs@(PushCC cc NoCCS)
- = hcat [ ptext SLIT("CCS_DECLARE"), char '(',
- ppr ccs, comma, -- better be codeStyle
- ppCostCentreLbl cc, comma,
- empty, -- Now always externally visible
- text ");"
- ]
-
-pprCostCentreStackDecl ccs
- = pprPanic "pprCostCentreStackDecl: " (ppr ccs)
+ parens (ppr ccs <> comma <>
+ parens(ptext SLIT("void *")) <> ppr cc)
\end{code}
-----------------------------------------------------------------------------
-- Printing in an interface file or in Core generally
pprCostCentreCore (AllCafsCC {cc_mod = m})
- = text "__sccC" <+> braces (ppr m)
+ = text "__sccC" <+> braces (ppr_mod m)
pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m,
cc_is_caf = caf, cc_is_dupd = dup})
= text "__scc" <+> braces (hsep [
- ftext n,
- ppr m,
+ ftext (zEncodeFS n),
+ ppr_mod m,
pp_dup dup,
pp_caf caf
])
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 m <> ftext n <>
+ = ppr_mod m <> ftext (zEncodeFS n) <>
text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc"
-- This is the name to go in the user-displayed string,
costCentreUserName (NoCostCentre) = "NO_CC"
costCentreUserName (AllCafsCC {}) = "CAF"
costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf})
- = case is_caf of { CafCC -> "CAF:"; _ -> "" } ++ decode (unpackFS name)
-\end{code}
-
-Cost Centre Declarations
-
-\begin{code}
-#ifdef DEBUG
-pprCostCentreDecl is_local (NoCostCentre)
- = panic "pprCostCentreDecl: no cost centre!"
-#endif
-pprCostCentreDecl is_local cc
- = if is_local then
- hcat [
- ptext SLIT("CC_DECLARE"),char '(',
- cc_ident, comma,
- pprStringInCStyle (costCentreUserName cc), comma,
- pprStringInCStyle (moduleNameUserString mod_name), comma,
- is_subsumed, comma,
- empty, -- Now always externally visible
- text ");"]
- else
- hcat [ ptext SLIT("CC_EXTERN"),char '(', cc_ident, text ");" ]
- where
- cc_ident = ppCostCentreLbl cc
- mod_name = cc_mod cc
- is_subsumed = ccSubsumed cc
-
-ccSubsumed :: CostCentre -> SDoc -- subsumed value
-ccSubsumed cc | isCafCC cc = ptext SLIT("CC_IS_CAF")
- | otherwise = ptext SLIT("CC_IS_BORING")
+ = case is_caf of { CafCC -> "CAF:"; _ -> "" } ++ unpackFS name
\end{code}