module GHC.Debug.Count where

import           GHC.Debug.Types
import GHC.Debug.Client.Monad
import           GHC.Debug.Profile
import           GHC.Debug.Trace
import           GHC.Debug.ParTrace hiding (TraceFunctionsIO(..))
import GHC.Debug.ParTrace (TraceFunctionsIO(TraceFunctionsIO))
import Control.Monad.State


parCount :: [ClosurePtr] -> DebugM CensusStats
parCount :: [ClosurePtr] -> DebugM CensusStats
parCount = forall s a.
Monoid s =>
TraceFunctionsIO a s -> [ClosurePtrWithInfo a] -> DebugM s
traceParFromM TraceFunctionsIO () CensusStats
funcs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> ClosurePtr -> ClosurePtrWithInfo a
ClosurePtrWithInfo ())
  where
    nop :: b -> DebugM ()
nop = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    funcs :: TraceFunctionsIO () CensusStats
funcs = forall a s.
(GenPapPayload ClosurePtr -> DebugM ())
-> (GenSrtPayload ClosurePtr -> DebugM ())
-> (GenStackFrames SrtCont ClosurePtr -> DebugM ())
-> (ClosurePtr
    -> SizedClosure -> a -> DebugM (a, s, DebugM () -> DebugM ()))
-> (ClosurePtr -> a -> DebugM s)
-> (ConstrDesc -> DebugM ())
-> TraceFunctionsIO a s
TraceFunctionsIO forall {b}. b -> DebugM ()
nop forall {b}. b -> DebugM ()
nop forall {b}. b -> DebugM ()
nop ClosurePtr
-> SizedClosure
-> ()
-> DebugM ((), CensusStats, DebugM () -> DebugM ())
clos (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty))) forall {b}. b -> DebugM ()
nop

    clos :: ClosurePtr -> SizedClosure -> ()
              -> DebugM ((), CensusStats, DebugM () -> DebugM ())
    clos :: ClosurePtr
-> SizedClosure
-> ()
-> DebugM ((), CensusStats, DebugM () -> DebugM ())
clos ClosurePtr
_cp SizedClosure
sc ()
_ = do
      forall (m :: * -> *) a. Monad m => a -> m a
return ((), Size -> CensusStats
mkCS (forall srt pap string s b.
DebugClosureWithSize srt pap string s b -> Size
dcSize SizedClosure
sc), forall a. a -> a
id)

-- | Simple statistics about a heap, total objects, size and maximum object
-- size
count :: [ClosurePtr] -> DebugM CensusStats
count :: [ClosurePtr] -> DebugM CensusStats
count [ClosurePtr]
cps = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: (* -> *) -> * -> *).
C m =>
TraceFunctions m -> [ClosurePtr] -> m DebugM ()
traceFromM TraceFunctions (StateT CensusStats)
funcs [ClosurePtr]
cps) (Count -> Size -> Max Size -> CensusStats
CS Count
0 Size
0 Max Size
0)
  where
    funcs :: TraceFunctions (StateT CensusStats)
funcs = TraceFunctions {
               papTrace :: GenPapPayload ClosurePtr -> StateT CensusStats DebugM ()
papTrace = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
              , srtTrace :: GenSrtPayload ClosurePtr -> StateT CensusStats DebugM ()
srtTrace = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
              , stackTrace :: GenStackFrames SrtCont ClosurePtr -> StateT CensusStats DebugM ()
stackTrace = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
              , closTrace :: ClosurePtr
-> SizedClosure
-> StateT CensusStats DebugM ()
-> StateT CensusStats DebugM ()
closTrace = ClosurePtr
-> SizedClosure
-> StateT CensusStats DebugM ()
-> StateT CensusStats DebugM ()
closAccum
              , visitedVal :: ClosurePtr -> StateT CensusStats DebugM ()
visitedVal = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())
              , conDescTrace :: ConstrDesc -> StateT CensusStats DebugM ()
conDescTrace = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ())

            }

    closAccum  :: ClosurePtr
               -> SizedClosure
               ->  (StateT CensusStats DebugM) ()
               ->  (StateT CensusStats DebugM) ()
    closAccum :: ClosurePtr
-> SizedClosure
-> StateT CensusStats DebugM ()
-> StateT CensusStats DebugM ()
closAccum ClosurePtr
_cp SizedClosure
s StateT CensusStats DebugM ()
k = do
      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (SizedClosure -> CensusStats -> CensusStats
go SizedClosure
s)
      StateT CensusStats DebugM ()
k

    go :: SizedClosure -> CensusStats -> CensusStats
    go :: SizedClosure -> CensusStats -> CensusStats
go SizedClosure
sc CensusStats
cs = Size -> CensusStats
mkCS (forall srt pap string s b.
DebugClosureWithSize srt pap string s b -> Size
dcSize SizedClosure
sc) forall a. Semigroup a => a -> a -> a
<> CensusStats
cs