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