{-# LANGUAGE DeriveDataTypeable #-}
module GHC.Types.CostCentre (
CostCentre(..), CcName, CCFlavour(..),
CostCentreStack,
CollectedCCs, emptyCollectedCCs, collectCC,
currentCCS, dontCareCCS,
isCurrentCCS,
maybeSingletonCCS,
mkUserCC, mkAutoCC, mkAllCafsCC,
mkSingletonCCS,
isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,
pprCostCentreCore,
costCentreUserName, costCentreUserNameFS,
costCentreSrcSpan,
cmpCostCentre
) where
import GHC.Prelude
import GHC.Utils.Binary
import GHC.Types.Var
import GHC.Types.Name
import GHC.Unit.Module
import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Types.CostCentre.State
import Data.Data
data CostCentre
= NormalCC {
CostCentre -> CCFlavour
cc_flavour :: CCFlavour,
CostCentre -> CcName
cc_name :: CcName,
CostCentre -> Module
cc_mod :: Module,
CostCentre -> SrcSpan
cc_loc :: SrcSpan
}
| AllCafsCC {
cc_mod :: Module,
cc_loc :: SrcSpan
}
deriving Typeable CostCentre
DataType
Constr
Typeable CostCentre
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre)
-> (CostCentre -> Constr)
-> (CostCentre -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CostCentre))
-> ((forall b. Data b => b -> b) -> CostCentre -> CostCentre)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r)
-> (forall u. (forall d. Data d => d -> u) -> CostCentre -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CostCentre -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre)
-> Data CostCentre
CostCentre -> DataType
CostCentre -> Constr
(forall b. Data b => b -> b) -> CostCentre -> CostCentre
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cAllCafsCC :: Constr
$cNormalCC :: Constr
$tCostCentre :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapMp :: (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapM :: (forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapQi :: Int -> (forall d. Data d => d -> u) -> CostCentre -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
gmapQ :: (forall d. Data d => d -> u) -> CostCentre -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
$cgmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CostCentre)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
dataTypeOf :: CostCentre -> DataType
$cdataTypeOf :: CostCentre -> DataType
toConstr :: CostCentre -> Constr
$ctoConstr :: CostCentre -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
$cp1Data :: Typeable CostCentre
Data
type CcName = FastString
data CCFlavour = CafCC
| ExprCC !CostCentreIndex
| DeclCC !CostCentreIndex
| HpcCC !CostCentreIndex
deriving (CCFlavour -> CCFlavour -> Bool
(CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool) -> Eq CCFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CCFlavour -> CCFlavour -> Bool
$c/= :: CCFlavour -> CCFlavour -> Bool
== :: CCFlavour -> CCFlavour -> Bool
$c== :: CCFlavour -> CCFlavour -> Bool
Eq, Eq CCFlavour
Eq CCFlavour
-> (CCFlavour -> CCFlavour -> Ordering)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> CCFlavour)
-> (CCFlavour -> CCFlavour -> CCFlavour)
-> Ord CCFlavour
CCFlavour -> CCFlavour -> Bool
CCFlavour -> CCFlavour -> Ordering
CCFlavour -> CCFlavour -> CCFlavour
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CCFlavour -> CCFlavour -> CCFlavour
$cmin :: CCFlavour -> CCFlavour -> CCFlavour
max :: CCFlavour -> CCFlavour -> CCFlavour
$cmax :: CCFlavour -> CCFlavour -> CCFlavour
>= :: CCFlavour -> CCFlavour -> Bool
$c>= :: CCFlavour -> CCFlavour -> Bool
> :: CCFlavour -> CCFlavour -> Bool
$c> :: CCFlavour -> CCFlavour -> Bool
<= :: CCFlavour -> CCFlavour -> Bool
$c<= :: CCFlavour -> CCFlavour -> Bool
< :: CCFlavour -> CCFlavour -> Bool
$c< :: CCFlavour -> CCFlavour -> Bool
compare :: CCFlavour -> CCFlavour -> Ordering
$ccompare :: CCFlavour -> CCFlavour -> Ordering
$cp1Ord :: Eq CCFlavour
Ord, Typeable CCFlavour
DataType
Constr
Typeable CCFlavour
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour)
-> (CCFlavour -> Constr)
-> (CCFlavour -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour))
-> ((forall b. Data b => b -> b) -> CCFlavour -> CCFlavour)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r)
-> (forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> CCFlavour -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour)
-> Data CCFlavour
CCFlavour -> DataType
CCFlavour -> Constr
(forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cHpcCC :: Constr
$cDeclCC :: Constr
$cExprCC :: Constr
$cCafCC :: Constr
$tCCFlavour :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapMp :: (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapM :: (forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapQi :: Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
gmapQ :: (forall d. Data d => d -> u) -> CCFlavour -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
$cgmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
dataTypeOf :: CCFlavour -> DataType
$cdataTypeOf :: CCFlavour -> DataType
toConstr :: CCFlavour -> Constr
$ctoConstr :: CCFlavour -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
$cp1Data :: Typeable CCFlavour
Data)
flavourIndex :: CCFlavour -> Int
flavourIndex :: CCFlavour -> Int
flavourIndex CCFlavour
CafCC = Int
0
flavourIndex (ExprCC CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x
flavourIndex (DeclCC CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x
flavourIndex (HpcCC CostCentreIndex
x) = CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
x
instance Eq CostCentre where
CostCentre
c1 == :: CostCentre -> CostCentre -> Bool
== CostCentre
c2 = case CostCentre
c1 CostCentre -> CostCentre -> Ordering
`cmpCostCentre` CostCentre
c2 of { Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False }
instance Ord CostCentre where
compare :: CostCentre -> CostCentre -> Ordering
compare = CostCentre -> CostCentre -> Ordering
cmpCostCentre
cmpCostCentre :: CostCentre -> CostCentre -> Ordering
cmpCostCentre :: CostCentre -> CostCentre -> Ordering
cmpCostCentre (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m1}) (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m2})
= Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Module
m2
cmpCostCentre NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f1, cc_mod :: CostCentre -> Module
cc_mod = Module
m1, cc_name :: CostCentre -> CcName
cc_name = CcName
n1}
NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f2, cc_mod :: CostCentre -> Module
cc_mod = Module
m2, cc_name :: CostCentre -> CcName
cc_name = CcName
n2}
= (Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Module
m2) Ordering -> Ordering -> Ordering
`thenCmp` (CcName
n1 CcName -> CcName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CcName
n2) Ordering -> Ordering -> Ordering
`thenCmp` (CCFlavour
f1 CCFlavour -> CCFlavour -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CCFlavour
f2)
cmpCostCentre CostCentre
other_1 CostCentre
other_2
= let
tag1 :: Int
tag1 = CostCentre -> Int
tag_CC CostCentre
other_1
tag2 :: Int
tag2 = CostCentre -> Int
tag_CC CostCentre
other_2
in
if Int
tag1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tag2 then Ordering
LT else Ordering
GT
where
tag_CC :: CostCentre -> Int
tag_CC :: CostCentre -> Int
tag_CC (NormalCC {}) = Int
0
tag_CC (AllCafsCC {}) = Int
1
isCafCC :: CostCentre -> Bool
isCafCC :: CostCentre -> Bool
isCafCC (AllCafsCC {}) = Bool
True
isCafCC (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
CafCC}) = Bool
True
isCafCC CostCentre
_ = Bool
False
isSccCountCC :: CostCentre -> Bool
isSccCountCC :: CostCentre -> Bool
isSccCountCC CostCentre
cc | CostCentre -> Bool
isCafCC CostCentre
cc = Bool
False
| Bool
otherwise = Bool
True
sccAbleCC :: CostCentre -> Bool
sccAbleCC :: CostCentre -> Bool
sccAbleCC CostCentre
cc | CostCentre -> Bool
isCafCC CostCentre
cc = Bool
False
| Bool
otherwise = Bool
True
ccFromThisModule :: CostCentre -> Module -> Bool
ccFromThisModule :: CostCentre -> Module -> Bool
ccFromThisModule CostCentre
cc Module
m = CostCentre -> Module
cc_mod CostCentre
cc Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
m
mkUserCC :: FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre
mkUserCC :: CcName -> Module -> SrcSpan -> CCFlavour -> CostCentre
mkUserCC CcName
cc_name Module
mod SrcSpan
loc CCFlavour
flavour
= NormalCC :: CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
NormalCC { cc_name :: CcName
cc_name = CcName
cc_name, cc_mod :: Module
cc_mod = Module
mod, cc_loc :: SrcSpan
cc_loc = SrcSpan
loc,
cc_flavour :: CCFlavour
cc_flavour = CCFlavour
flavour
}
mkAutoCC :: Id -> Module -> CostCentre
mkAutoCC :: Id -> Module -> CostCentre
mkAutoCC Id
id Module
mod
= NormalCC :: CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
NormalCC { cc_name :: CcName
cc_name = CcName
str, cc_mod :: Module
cc_mod = Module
mod,
cc_loc :: SrcSpan
cc_loc = Name -> SrcSpan
nameSrcSpan (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id),
cc_flavour :: CCFlavour
cc_flavour = CCFlavour
CafCC
}
where
name :: Name
name = Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id
str :: CcName
str | Name -> Bool
isExternalName Name
name = OccName -> CcName
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
id)
| Bool
otherwise = OccName -> CcName
occNameFS (Id -> OccName
forall a. NamedThing a => a -> OccName
getOccName Id
id)
CcName -> CcName -> CcName
`appendFS`
String -> CcName
mkFastString (Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Unique -> String
forall a. Show a => a -> String
show (Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique Name
name))
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC :: Module -> SrcSpan -> CostCentre
mkAllCafsCC Module
m SrcSpan
loc = AllCafsCC :: Module -> SrcSpan -> CostCentre
AllCafsCC { cc_mod :: Module
cc_mod = Module
m, cc_loc :: SrcSpan
cc_loc = SrcSpan
loc }
data CostCentreStack
= CurrentCCS
| DontCareCCS
| SingletonCCS CostCentre
deriving (CostCentreStack -> CostCentreStack -> Bool
(CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> Eq CostCentreStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CostCentreStack -> CostCentreStack -> Bool
$c/= :: CostCentreStack -> CostCentreStack -> Bool
== :: CostCentreStack -> CostCentreStack -> Bool
$c== :: CostCentreStack -> CostCentreStack -> Bool
Eq, Eq CostCentreStack
Eq CostCentreStack
-> (CostCentreStack -> CostCentreStack -> Ordering)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> Bool)
-> (CostCentreStack -> CostCentreStack -> CostCentreStack)
-> (CostCentreStack -> CostCentreStack -> CostCentreStack)
-> Ord CostCentreStack
CostCentreStack -> CostCentreStack -> Bool
CostCentreStack -> CostCentreStack -> Ordering
CostCentreStack -> CostCentreStack -> CostCentreStack
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmin :: CostCentreStack -> CostCentreStack -> CostCentreStack
max :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmax :: CostCentreStack -> CostCentreStack -> CostCentreStack
>= :: CostCentreStack -> CostCentreStack -> Bool
$c>= :: CostCentreStack -> CostCentreStack -> Bool
> :: CostCentreStack -> CostCentreStack -> Bool
$c> :: CostCentreStack -> CostCentreStack -> Bool
<= :: CostCentreStack -> CostCentreStack -> Bool
$c<= :: CostCentreStack -> CostCentreStack -> Bool
< :: CostCentreStack -> CostCentreStack -> Bool
$c< :: CostCentreStack -> CostCentreStack -> Bool
compare :: CostCentreStack -> CostCentreStack -> Ordering
$ccompare :: CostCentreStack -> CostCentreStack -> Ordering
$cp1Ord :: Eq CostCentreStack
Ord)
type CollectedCCs
= ( [CostCentre]
, [CostCentreStack]
)
emptyCollectedCCs :: CollectedCCs
emptyCollectedCCs :: CollectedCCs
emptyCollectedCCs = ([], [])
collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs
collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs
collectCC CostCentre
cc CostCentreStack
ccs ([CostCentre]
c, [CostCentreStack]
cs) = (CostCentre
cc CostCentre -> [CostCentre] -> [CostCentre]
forall a. a -> [a] -> [a]
: [CostCentre]
c, CostCentreStack
ccs CostCentreStack -> [CostCentreStack] -> [CostCentreStack]
forall a. a -> [a] -> [a]
: [CostCentreStack]
cs)
currentCCS, dontCareCCS :: CostCentreStack
currentCCS :: CostCentreStack
currentCCS = CostCentreStack
CurrentCCS
dontCareCCS :: CostCentreStack
dontCareCCS = CostCentreStack
DontCareCCS
isCurrentCCS :: CostCentreStack -> Bool
isCurrentCCS :: CostCentreStack -> Bool
isCurrentCCS CostCentreStack
CurrentCCS = Bool
True
isCurrentCCS CostCentreStack
_ = Bool
False
isCafCCS :: CostCentreStack -> Bool
isCafCCS :: CostCentreStack -> Bool
isCafCCS (SingletonCCS CostCentre
cc) = CostCentre -> Bool
isCafCC CostCentre
cc
isCafCCS CostCentreStack
_ = Bool
False
maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
maybeSingletonCCS (SingletonCCS CostCentre
cc) = CostCentre -> Maybe CostCentre
forall a. a -> Maybe a
Just CostCentre
cc
maybeSingletonCCS CostCentreStack
_ = Maybe CostCentre
forall a. Maybe a
Nothing
mkSingletonCCS :: CostCentre -> CostCentreStack
mkSingletonCCS :: CostCentre -> CostCentreStack
mkSingletonCCS CostCentre
cc = CostCentre -> CostCentreStack
SingletonCCS CostCentre
cc
instance Outputable CostCentreStack where
ppr :: CostCentreStack -> SDoc
ppr CostCentreStack
CurrentCCS = String -> SDoc
text String
"CCCS"
ppr CostCentreStack
DontCareCCS = String -> SDoc
text String
"CCS_DONT_CARE"
ppr (SingletonCCS CostCentre
cc) = CostCentre -> SDoc
forall a. Outputable a => a -> SDoc
ppr CostCentre
cc SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_ccs"
instance Outputable CostCentre where
ppr :: CostCentre -> SDoc
ppr CostCentre
cc = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
if PprStyle -> Bool
codeStyle PprStyle
sty
then CostCentre -> SDoc
ppCostCentreLbl CostCentre
cc
else String -> SDoc
text (CostCentre -> String
costCentreUserName CostCentre
cc)
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore :: CostCentre -> SDoc
pprCostCentreCore (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m})
= String -> SDoc
text String
"__sccC" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m)
pprCostCentreCore (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
flavour, cc_name :: CostCentre -> CcName
cc_name = CcName
n,
cc_mod :: CostCentre -> Module
cc_mod = Module
m, cc_loc :: CostCentre -> SrcSpan
cc_loc = SrcSpan
loc})
= String -> SDoc
text String
"__scc" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
braces ([SDoc] -> SDoc
hsep [
Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'.' SDoc -> SDoc -> SDoc
<> CcName -> SDoc
ftext CcName
n,
CCFlavour -> SDoc
pprFlavourCore CCFlavour
flavour,
SDoc -> SDoc
whenPprDebug (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc)
])
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore :: CCFlavour -> SDoc
pprFlavourCore CCFlavour
CafCC = String -> SDoc
text String
"__C"
pprFlavourCore CCFlavour
f = Int -> SDoc
pprIdxCore (Int -> SDoc) -> Int -> SDoc
forall a b. (a -> b) -> a -> b
$ CCFlavour -> Int
flavourIndex CCFlavour
f
pprIdxCore :: Int -> SDoc
pprIdxCore :: Int -> SDoc
pprIdxCore Int
0 = SDoc
empty
pprIdxCore Int
idx = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
idx
ppCostCentreLbl :: CostCentre -> SDoc
ppCostCentreLbl :: CostCentre -> SDoc
ppCostCentreLbl (AllCafsCC {cc_mod :: CostCentre -> Module
cc_mod = Module
m}) = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_CAFs_cc"
ppCostCentreLbl (NormalCC {cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
f, cc_name :: CostCentre -> CcName
cc_name = CcName
n, cc_mod :: CostCentre -> Module
cc_mod = Module
m})
= Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> FastZString -> SDoc
ztext (CcName -> FastZString
zEncodeFS CcName
n) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<>
CCFlavour -> SDoc
ppFlavourLblComponent CCFlavour
f SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"_cc"
ppFlavourLblComponent :: CCFlavour -> SDoc
ppFlavourLblComponent :: CCFlavour -> SDoc
ppFlavourLblComponent CCFlavour
CafCC = String -> SDoc
text String
"CAF"
ppFlavourLblComponent (ExprCC CostCentreIndex
i) = String -> SDoc
text String
"EXPR" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i
ppFlavourLblComponent (DeclCC CostCentreIndex
i) = String -> SDoc
text String
"DECL" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i
ppFlavourLblComponent (HpcCC CostCentreIndex
i) = String -> SDoc
text String
"HPC" SDoc -> SDoc -> SDoc
<> CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
i
ppIdxLblComponent :: CostCentreIndex -> SDoc
ppIdxLblComponent :: CostCentreIndex -> SDoc
ppIdxLblComponent CostCentreIndex
n =
case CostCentreIndex -> Int
unCostCentreIndex CostCentreIndex
n of
Int
0 -> SDoc
empty
Int
n -> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
costCentreUserName :: CostCentre -> String
costCentreUserName :: CostCentre -> String
costCentreUserName = CcName -> String
unpackFS (CcName -> String)
-> (CostCentre -> CcName) -> CostCentre -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostCentre -> CcName
costCentreUserNameFS
costCentreUserNameFS :: CostCentre -> FastString
costCentreUserNameFS :: CostCentre -> CcName
costCentreUserNameFS (AllCafsCC {}) = String -> CcName
mkFastString String
"CAF"
costCentreUserNameFS (NormalCC {cc_name :: CostCentre -> CcName
cc_name = CcName
name, cc_flavour :: CostCentre -> CCFlavour
cc_flavour = CCFlavour
is_caf})
= case CCFlavour
is_caf of
CCFlavour
CafCC -> String -> CcName
mkFastString String
"CAF:" CcName -> CcName -> CcName
`appendFS` CcName
name
CCFlavour
_ -> CcName
name
costCentreSrcSpan :: CostCentre -> SrcSpan
costCentreSrcSpan :: CostCentre -> SrcSpan
costCentreSrcSpan = CostCentre -> SrcSpan
cc_loc
instance Binary CCFlavour where
put_ :: BinHandle -> CCFlavour -> IO ()
put_ BinHandle
bh CCFlavour
CafCC = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (ExprCC CostCentreIndex
i) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CostCentreIndex
i
put_ BinHandle
bh (DeclCC CostCentreIndex
i) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CostCentreIndex
i
put_ BinHandle
bh (HpcCC CostCentreIndex
i) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
BinHandle -> CostCentreIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CostCentreIndex
i
get :: BinHandle -> IO CCFlavour
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do CCFlavour -> IO CCFlavour
forall (m :: * -> *) a. Monad m => a -> m a
return CCFlavour
CafCC
Word8
1 -> CostCentreIndex -> CCFlavour
ExprCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
2 -> CostCentreIndex -> CCFlavour
DeclCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Word8
_ -> CostCentreIndex -> CCFlavour
HpcCC (CostCentreIndex -> CCFlavour)
-> IO CostCentreIndex -> IO CCFlavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO CostCentreIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
instance Binary CostCentre where
put_ :: BinHandle -> CostCentre -> IO ()
put_ BinHandle
bh (NormalCC CCFlavour
aa CcName
ab Module
ac SrcSpan
_ad) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
BinHandle -> CCFlavour -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CCFlavour
aa
BinHandle -> CcName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CcName
ab
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
ac
put_ BinHandle
bh (AllCafsCC Module
ae SrcSpan
_af) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
ae
get :: BinHandle -> IO CostCentre
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do CCFlavour
aa <- BinHandle -> IO CCFlavour
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
CcName
ab <- BinHandle -> IO CcName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
Module
ac <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
CostCentre -> IO CostCentre
forall (m :: * -> *) a. Monad m => a -> m a
return (CCFlavour -> CcName -> Module -> SrcSpan -> CostCentre
NormalCC CCFlavour
aa CcName
ab Module
ac SrcSpan
noSrcSpan)
Word8
_ -> do Module
ae <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
CostCentre -> IO CostCentre
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> SrcSpan -> CostCentre
AllCafsCC Module
ae SrcSpan
noSrcSpan)