{-# LANGUAGE DeriveGeneric #-}

module GHC.Exts.Heap.ProfInfo.Types where

import Prelude
import Data.Word
import GHC.Generics

-- | This is a somewhat faithful representation of StgTSOProfInfo. See
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/TSO.h>
-- for more details on this data structure.
newtype StgTSOProfInfo = StgTSOProfInfo {
    StgTSOProfInfo -> Maybe CostCentreStack
cccs :: Maybe CostCentreStack
} deriving (Int -> StgTSOProfInfo -> ShowS
[StgTSOProfInfo] -> ShowS
StgTSOProfInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StgTSOProfInfo] -> ShowS
$cshowList :: [StgTSOProfInfo] -> ShowS
show :: StgTSOProfInfo -> String
$cshow :: StgTSOProfInfo -> String
showsPrec :: Int -> StgTSOProfInfo -> ShowS
$cshowsPrec :: Int -> StgTSOProfInfo -> ShowS
Show, forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo
forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StgTSOProfInfo x -> StgTSOProfInfo
$cfrom :: forall x. StgTSOProfInfo -> Rep StgTSOProfInfo x
Generic, StgTSOProfInfo -> StgTSOProfInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c/= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
== :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c== :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
Eq, Eq StgTSOProfInfo
StgTSOProfInfo -> StgTSOProfInfo -> Bool
StgTSOProfInfo -> StgTSOProfInfo -> Ordering
StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
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 :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
$cmin :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
max :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
$cmax :: StgTSOProfInfo -> StgTSOProfInfo -> StgTSOProfInfo
>= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c>= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
> :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c> :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
<= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c<= :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
< :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
$c< :: StgTSOProfInfo -> StgTSOProfInfo -> Bool
compare :: StgTSOProfInfo -> StgTSOProfInfo -> Ordering
$ccompare :: StgTSOProfInfo -> StgTSOProfInfo -> Ordering
Ord)

-- | This is a somewhat faithful representation of CostCentreStack. See
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h>
-- for more details on this data structure.
data CostCentreStack = CostCentreStack {
    CostCentreStack -> Int
ccs_ccsID :: Int,
    CostCentreStack -> CostCentre
ccs_cc :: CostCentre,
    CostCentreStack -> Maybe CostCentreStack
ccs_prevStack :: Maybe CostCentreStack,
    CostCentreStack -> Maybe IndexTable
ccs_indexTable :: Maybe IndexTable,
    CostCentreStack -> Maybe CostCentreStack
ccs_root :: Maybe CostCentreStack,
    CostCentreStack -> Word
ccs_depth :: Word,
    CostCentreStack -> Word64
ccs_scc_count :: Word64,
    CostCentreStack -> Word
ccs_selected :: Word,
    CostCentreStack -> Word
ccs_time_ticks :: Word,
    CostCentreStack -> Word64
ccs_mem_alloc :: Word64,
    CostCentreStack -> Word64
ccs_inherited_alloc :: Word64,
    CostCentreStack -> Word
ccs_inherited_ticks :: Word
} deriving (Int -> CostCentreStack -> ShowS
[CostCentreStack] -> ShowS
CostCentreStack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostCentreStack] -> ShowS
$cshowList :: [CostCentreStack] -> ShowS
show :: CostCentreStack -> String
$cshow :: CostCentreStack -> String
showsPrec :: Int -> CostCentreStack -> ShowS
$cshowsPrec :: Int -> CostCentreStack -> ShowS
Show, forall x. Rep CostCentreStack x -> CostCentreStack
forall x. CostCentreStack -> Rep CostCentreStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CostCentreStack x -> CostCentreStack
$cfrom :: forall x. CostCentreStack -> Rep CostCentreStack x
Generic, CostCentreStack -> CostCentreStack -> Bool
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
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
Ord)

-- | This is a somewhat faithful representation of CostCentre. See
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h>
-- for more details on this data structure.
data CostCentre = CostCentre {
    CostCentre -> Int
cc_ccID :: Int,
    CostCentre -> String
cc_label :: String,
    CostCentre -> String
cc_module :: String,
    CostCentre -> Maybe String
cc_srcloc :: Maybe String,
    CostCentre -> Word64
cc_mem_alloc :: Word64,
    CostCentre -> Word
cc_time_ticks :: Word,
    CostCentre -> Bool
cc_is_caf :: Bool,
    CostCentre -> Maybe CostCentre
cc_link :: Maybe CostCentre
} deriving (Int -> CostCentre -> ShowS
[CostCentre] -> ShowS
CostCentre -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CostCentre] -> ShowS
$cshowList :: [CostCentre] -> ShowS
show :: CostCentre -> String
$cshow :: CostCentre -> String
showsPrec :: Int -> CostCentre -> ShowS
$cshowsPrec :: Int -> CostCentre -> ShowS
Show, forall x. Rep CostCentre x -> CostCentre
forall x. CostCentre -> Rep CostCentre x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CostCentre x -> CostCentre
$cfrom :: forall x. CostCentre -> Rep CostCentre x
Generic, CostCentre -> CostCentre -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CostCentre -> CostCentre -> Bool
$c/= :: CostCentre -> CostCentre -> Bool
== :: CostCentre -> CostCentre -> Bool
$c== :: CostCentre -> CostCentre -> Bool
Eq, Eq CostCentre
CostCentre -> CostCentre -> Bool
CostCentre -> CostCentre -> Ordering
CostCentre -> CostCentre -> CostCentre
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 :: CostCentre -> CostCentre -> CostCentre
$cmin :: CostCentre -> CostCentre -> CostCentre
max :: CostCentre -> CostCentre -> CostCentre
$cmax :: CostCentre -> CostCentre -> CostCentre
>= :: CostCentre -> CostCentre -> Bool
$c>= :: CostCentre -> CostCentre -> Bool
> :: CostCentre -> CostCentre -> Bool
$c> :: CostCentre -> CostCentre -> Bool
<= :: CostCentre -> CostCentre -> Bool
$c<= :: CostCentre -> CostCentre -> Bool
< :: CostCentre -> CostCentre -> Bool
$c< :: CostCentre -> CostCentre -> Bool
compare :: CostCentre -> CostCentre -> Ordering
$ccompare :: CostCentre -> CostCentre -> Ordering
Ord)

-- | This is a somewhat faithful representation of IndexTable. See
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h>
-- for more details on this data structure.
data IndexTable = IndexTable {
    IndexTable -> CostCentre
it_cc :: CostCentre,
    IndexTable -> Maybe CostCentreStack
it_ccs :: Maybe CostCentreStack,
    IndexTable -> Maybe IndexTable
it_next :: Maybe IndexTable,
    IndexTable -> Bool
it_back_edge :: Bool
} deriving (Int -> IndexTable -> ShowS
[IndexTable] -> ShowS
IndexTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexTable] -> ShowS
$cshowList :: [IndexTable] -> ShowS
show :: IndexTable -> String
$cshow :: IndexTable -> String
showsPrec :: Int -> IndexTable -> ShowS
$cshowsPrec :: Int -> IndexTable -> ShowS
Show, forall x. Rep IndexTable x -> IndexTable
forall x. IndexTable -> Rep IndexTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndexTable x -> IndexTable
$cfrom :: forall x. IndexTable -> Rep IndexTable x
Generic, IndexTable -> IndexTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexTable -> IndexTable -> Bool
$c/= :: IndexTable -> IndexTable -> Bool
== :: IndexTable -> IndexTable -> Bool
$c== :: IndexTable -> IndexTable -> Bool
Eq, Eq IndexTable
IndexTable -> IndexTable -> Bool
IndexTable -> IndexTable -> Ordering
IndexTable -> IndexTable -> IndexTable
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 :: IndexTable -> IndexTable -> IndexTable
$cmin :: IndexTable -> IndexTable -> IndexTable
max :: IndexTable -> IndexTable -> IndexTable
$cmax :: IndexTable -> IndexTable -> IndexTable
>= :: IndexTable -> IndexTable -> Bool
$c>= :: IndexTable -> IndexTable -> Bool
> :: IndexTable -> IndexTable -> Bool
$c> :: IndexTable -> IndexTable -> Bool
<= :: IndexTable -> IndexTable -> Bool
$c<= :: IndexTable -> IndexTable -> Bool
< :: IndexTable -> IndexTable -> Bool
$c< :: IndexTable -> IndexTable -> Bool
compare :: IndexTable -> IndexTable -> Ordering
$ccompare :: IndexTable -> IndexTable -> Ordering
Ord)