module GHC.Debug.Thunks where

import GHC.Debug.Types
import GHC.Debug.Client.Monad
import GHC.Debug.Profile.Types
import qualified Data.Map.Strict as Map
import Control.Monad.RWS
import GHC.Debug.Trace
import GHC.Debug.Client.Query


thunkAnalysis :: [ClosurePtr] -> DebugM (Map.Map (Maybe SourceInformation) Count)
thunkAnalysis :: [ClosurePtr] -> DebugM (Map (Maybe SourceInformation) Count)
thunkAnalysis [ClosurePtr]
rroots = (\(()
_, Map (Maybe SourceInformation) Count
r, ()
_) -> Map (Maybe SourceInformation) Count
r) (((), Map (Maybe SourceInformation) Count, ())
 -> Map (Maybe SourceInformation) Count)
-> DebugM ((), Map (Maybe SourceInformation) Count, ())
-> DebugM (Map (Maybe SourceInformation) Count)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
-> ()
-> Map (Maybe SourceInformation) Count
-> DebugM ((), Map (Maybe SourceInformation) Count, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (TraceFunctions (RWST () () (Map (Maybe SourceInformation) Count))
-> [ClosurePtr]
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
forall (m :: (* -> *) -> * -> *).
C m =>
TraceFunctions m -> [ClosurePtr] -> m DebugM ()
traceFromM TraceFunctions (RWST () () (Map (Maybe SourceInformation) Count))
funcs [ClosurePtr]
rroots) () (Map (Maybe SourceInformation) Count
forall k a. Map k a
Map.empty)
  where
    funcs :: TraceFunctions (RWST () () (Map (Maybe SourceInformation) Count))
funcs = (ClosurePtr
 -> SizedClosure
 -> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
 -> RWST () () (Map (Maybe SourceInformation) Count) DebugM ())
-> TraceFunctions
     (RWST () () (Map (Maybe SourceInformation) Count))
forall (m :: (* -> *) -> * -> *).
C m =>
(ClosurePtr -> SizedClosure -> m DebugM () -> m DebugM ())
-> TraceFunctions m
justClosures ClosurePtr
-> SizedClosure
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
closAccum

    getSourceLoc :: DebugClosureWithSize ccs srt pap string s b
-> DebugM (Maybe SourceInformation)
getSourceLoc DebugClosureWithSize ccs srt pap string s b
c = InfoTablePtr -> DebugM (Maybe SourceInformation)
getSourceInfo (StgInfoTableWithPtr -> InfoTablePtr
tableId (DebugClosure ccs srt pap string s b -> StgInfoTableWithPtr
forall ccs srt pap string s b.
DebugClosure ccs srt pap string s b -> StgInfoTableWithPtr
info (DebugClosureWithSize ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
forall ccs srt pap string s b.
DebugClosureWithSize ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
noSize DebugClosureWithSize ccs srt pap string s b
c)))

    closAccum  :: ClosurePtr
               -> SizedClosure
               -> (RWST () () (Map.Map (Maybe SourceInformation) Count) DebugM) ()
               -> (RWST () () (Map.Map (Maybe SourceInformation) Count) DebugM) ()
    closAccum :: ClosurePtr
-> SizedClosure
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
closAccum ClosurePtr
_ SizedClosure
sc RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
k = do
          case (SizedClosure
-> DebugClosure
     CCSPtr InfoTablePtr PayloadCont InfoTablePtr StackCont ClosurePtr
forall ccs srt pap string s b.
DebugClosureWithSize ccs srt pap string s b
-> DebugClosure ccs srt pap string s b
noSize SizedClosure
sc) of
            ThunkClosure {} ->  do
              Maybe SourceInformation
loc <- DebugM (Maybe SourceInformation)
-> RWST
     ()
     ()
     (Map (Maybe SourceInformation) Count)
     DebugM
     (Maybe SourceInformation)
forall (m :: * -> *) a.
Monad m =>
m a -> RWST () () (Map (Maybe SourceInformation) Count) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DebugM (Maybe SourceInformation)
 -> RWST
      ()
      ()
      (Map (Maybe SourceInformation) Count)
      DebugM
      (Maybe SourceInformation))
-> DebugM (Maybe SourceInformation)
-> RWST
     ()
     ()
     (Map (Maybe SourceInformation) Count)
     DebugM
     (Maybe SourceInformation)
forall a b. (a -> b) -> a -> b
$ SizedClosure -> DebugM (Maybe SourceInformation)
forall {ccs} {srt} {pap} {string} {s} {b}.
DebugClosureWithSize ccs srt pap string s b
-> DebugM (Maybe SourceInformation)
getSourceLoc SizedClosure
sc
              (Map (Maybe SourceInformation) Count
 -> Map (Maybe SourceInformation) Count)
-> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Count -> Count -> Count)
-> Maybe SourceInformation
-> Count
-> Map (Maybe SourceInformation) Count
-> Map (Maybe SourceInformation) Count
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Count -> Count -> Count
forall a. Semigroup a => a -> a -> a
(<>) Maybe SourceInformation
loc (Int -> Count
Count Int
1))
              RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
k
            DebugClosure
  CCSPtr InfoTablePtr PayloadCont InfoTablePtr StackCont ClosurePtr
_ -> RWST () () (Map (Maybe SourceInformation) Count) DebugM ()
k