{-# 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.Types.CostCentre.State
import GHC.Utils.Panic.Plain
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
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 -> Constr
CostCentre -> DataType
(forall b. Data b => b -> b) -> CostCentre -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CostCentre -> c CostCentre
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CostCentre
$ctoConstr :: CostCentre -> Constr
toConstr :: CostCentre -> Constr
$cdataTypeOf :: CostCentre -> DataType
dataTypeOf :: CostCentre -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CostCentre)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CostCentre)
$cgmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
gmapT :: (forall b. Data b => b -> b) -> CostCentre -> CostCentre
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CostCentre -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CostCentre -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CostCentre -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CostCentre -> m CostCentre
Data
type CcName = FastString
data CCFlavour = CafCC 
               | ExprCC !CostCentreIndex 
               | DeclCC !CostCentreIndex 
               | HpcCC !CostCentreIndex 
               | LateCC !CostCentreIndex 
               deriving (CCFlavour -> CCFlavour -> Bool
(CCFlavour -> CCFlavour -> Bool)
-> (CCFlavour -> CCFlavour -> Bool) -> Eq CCFlavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CCFlavour -> CCFlavour -> Bool
== :: CCFlavour -> CCFlavour -> Bool
$c/= :: CCFlavour -> CCFlavour -> Bool
/= :: 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
$ccompare :: CCFlavour -> CCFlavour -> Ordering
compare :: CCFlavour -> CCFlavour -> Ordering
$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
>= :: CCFlavour -> CCFlavour -> Bool
$cmax :: CCFlavour -> CCFlavour -> CCFlavour
max :: CCFlavour -> CCFlavour -> CCFlavour
$cmin :: CCFlavour -> CCFlavour -> CCFlavour
min :: CCFlavour -> CCFlavour -> CCFlavour
Ord, Typeable CCFlavour
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 -> Constr
CCFlavour -> DataType
(forall b. Data b => b -> b) -> CCFlavour -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CCFlavour -> c CCFlavour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CCFlavour
$ctoConstr :: CCFlavour -> Constr
toConstr :: CCFlavour -> Constr
$cdataTypeOf :: CCFlavour -> DataType
dataTypeOf :: CCFlavour -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CCFlavour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CCFlavour)
$cgmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
gmapT :: (forall b. Data b => b -> b) -> CCFlavour -> CCFlavour
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CCFlavour -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CCFlavour -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CCFlavour -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m CCFlavour
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CCFlavour -> m 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
flavourIndex (LateCC 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}
    
  = [Ordering] -> Ordering
forall a. Monoid a => [a] -> a
mconcat
      [ Module
m1 Module -> Module -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Module
m2
      , CcName
n1 CcName -> CcName -> Ordering
`lexicalCompareFS` CcName
n2 
      , 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 { 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 { 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 { 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
$c== :: CostCentreStack -> CostCentreStack -> Bool
== :: CostCentreStack -> CostCentreStack -> Bool
$c/= :: CostCentreStack -> CostCentreStack -> Bool
/= :: 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
$ccompare :: CostCentreStack -> CostCentreStack -> Ordering
compare :: CostCentreStack -> CostCentreStack -> Ordering
$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
>= :: CostCentreStack -> CostCentreStack -> Bool
$cmax :: CostCentreStack -> CostCentreStack -> CostCentreStack
max :: CostCentreStack -> CostCentreStack -> CostCentreStack
$cmin :: CostCentreStack -> CostCentreStack -> CostCentreStack
min :: CostCentreStack -> CostCentreStack -> 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
ppFlavourLblComponent (LateCC CostCentreIndex
i) = String -> SDoc
text String
"LATECC" 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 =
            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
    put_ BinHandle
bh (LateCC CostCentreIndex
i) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
            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 -> CCFlavour -> IO CCFlavour
forall a. a -> IO a
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
3 -> 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
              Word8
4 -> CostCentreIndex -> CCFlavour
LateCC (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
_ -> String -> IO CCFlavour
forall a. String -> a
panic String
"Invalid CCFlavour"
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> SrcSpan -> CostCentre
AllCafsCC Module
ae SrcSpan
noSrcSpan)