{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Debug.ObjectEquiv(objectEquiv, objectEquivAnalysis, printObjectEquiv, EquivMap) where
import GHC.Debug.Client.Monad
import GHC.Debug.Client
import GHC.Debug.Trace
import GHC.Debug.Profile
import GHC.Debug.Types.Graph (ppClosure)
import GHC.Debug.Types(ClosurePtr(..))
import Control.Monad.State
import Data.List (sortBy)
import Data.Ord
import Debug.Trace
import qualified Data.OrdPSQ as PS
import qualified Data.IntMap.Strict as IM
import Data.List.NonEmpty(NonEmpty(..))
type CensusByObjectEquiv = IM.IntMap CensusStats
limit :: Int
limit :: Int
limit = Int
100_000
of_interest :: Int
of_interest :: Int
of_interest = Int
1000
type EquivMap = PS.OrdPSQ PtrClosure
Int
ClosurePtr
type Equiv2Map = IM.IntMap
ClosurePtr
data ObjectEquivState = ObjectEquivState {
ObjectEquivState -> EquivMap
emap :: !EquivMap
, ObjectEquivState -> Equiv2Map
emap2 :: !Equiv2Map
, ObjectEquivState -> CensusByObjectEquiv
_census :: !CensusByObjectEquiv
}
addEquiv :: ClosurePtr -> PtrClosure -> ObjectEquivState -> ObjectEquivState
addEquiv :: ClosurePtr -> PtrClosure -> ObjectEquivState -> ObjectEquivState
addEquiv ClosurePtr
cp PtrClosure
pc (ObjectEquivState -> ObjectEquivState
trimMap -> ObjectEquivState
o) =
let (Either ClosurePtr ClosurePtr
res, EquivMap
new_m) = (Maybe (Int, ClosurePtr)
-> (Either ClosurePtr ClosurePtr, Maybe (Int, ClosurePtr)))
-> PtrClosure
-> EquivMap
-> (Either ClosurePtr ClosurePtr, EquivMap)
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
PS.alter Maybe (Int, ClosurePtr)
-> (Either ClosurePtr ClosurePtr, Maybe (Int, ClosurePtr))
g PtrClosure
pc (ObjectEquivState -> EquivMap
emap ObjectEquivState
o)
new_emap2 :: Equiv2Map
new_emap2 = case Either ClosurePtr ClosurePtr
res of
Left ClosurePtr
_ -> ObjectEquivState -> Equiv2Map
emap2 ObjectEquivState
o
Right ClosurePtr
new_cp -> ClosurePtr -> ClosurePtr -> Equiv2Map -> Equiv2Map
addNewMap ClosurePtr
cp ClosurePtr
new_cp (ObjectEquivState -> Equiv2Map
emap2 ObjectEquivState
o)
in ( ObjectEquivState
o { emap = new_m
, emap2 = new_emap2 })
where
g :: Maybe (Int, ClosurePtr)
-> (Either ClosurePtr ClosurePtr, Maybe (Int, ClosurePtr))
g Maybe (Int, ClosurePtr)
Nothing = (ClosurePtr -> Either ClosurePtr ClosurePtr
forall a b. a -> Either a b
Left ClosurePtr
cp, (Int, ClosurePtr) -> Maybe (Int, ClosurePtr)
forall a. a -> Maybe a
Just (Int
0, ClosurePtr
cp))
g (Just (Int
p, ClosurePtr
v)) = (ClosurePtr -> Either ClosurePtr ClosurePtr
forall a b. b -> Either a b
Right ClosurePtr
v, (Int, ClosurePtr) -> Maybe (Int, ClosurePtr)
forall a. a -> Maybe a
Just (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, ClosurePtr
v))
addNewMap :: ClosurePtr -> ClosurePtr -> Equiv2Map -> Equiv2Map
addNewMap :: ClosurePtr -> ClosurePtr -> Equiv2Map -> Equiv2Map
addNewMap (ClosurePtr Word64
cp) ClosurePtr
equiv_cp Equiv2Map
o = Int -> ClosurePtr -> Equiv2Map -> Equiv2Map
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cp) ClosurePtr
equiv_cp Equiv2Map
o
trimMap :: ObjectEquivState -> ObjectEquivState
trimMap :: ObjectEquivState -> ObjectEquivState
trimMap ObjectEquivState
o = if ObjectEquivState -> Int
checkSize ObjectEquivState
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit
then let new_o :: ObjectEquivState
new_o = ObjectEquivState
o { emap = snd $ PS.atMostView of_interest (emap o) }
in Int -> ObjectEquivState -> ObjectEquivState
forall a b. Show a => a -> b -> b
traceShow (ObjectEquivState -> Int
checkSize ObjectEquivState
new_o) ObjectEquivState
new_o
else ObjectEquivState
o
checkSize :: ObjectEquivState -> Int
checkSize :: ObjectEquivState -> Int
checkSize (ObjectEquivState EquivMap
e1 Equiv2Map
_ CensusByObjectEquiv
_) = EquivMap -> Int
forall k p v. OrdPSQ k p v -> Int
PS.size EquivMap
e1
type PtrClosure = DebugClosureWithSize SrtPayload PapPayload ConstrDesc StackFrames ClosurePtr
censusObjectEquiv :: [ClosurePtr] -> DebugM ObjectEquivState
censusObjectEquiv :: [ClosurePtr] -> DebugM ObjectEquivState
censusObjectEquiv [ClosurePtr]
cps = ((), ObjectEquivState) -> ObjectEquivState
forall a b. (a, b) -> b
snd (((), ObjectEquivState) -> ObjectEquivState)
-> DebugM ((), ObjectEquivState) -> DebugM ObjectEquivState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ObjectEquivState DebugM ()
-> ObjectEquivState -> DebugM ((), ObjectEquivState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (TraceFunctions (StateT ObjectEquivState)
-> [ClosurePtr] -> StateT ObjectEquivState DebugM ()
forall (m :: (* -> *) -> * -> *).
C m =>
TraceFunctions m -> [ClosurePtr] -> m DebugM ()
traceFromM TraceFunctions (StateT ObjectEquivState)
funcs [ClosurePtr]
cps) (EquivMap -> Equiv2Map -> CensusByObjectEquiv -> ObjectEquivState
ObjectEquivState EquivMap
forall k p v. OrdPSQ k p v
PS.empty Equiv2Map
forall a. IntMap a
IM.empty CensusByObjectEquiv
forall a. IntMap a
IM.empty)
where
funcs :: TraceFunctions (StateT ObjectEquivState)
funcs = TraceFunctions {
papTrace :: GenPapPayload ClosurePtr -> StateT ObjectEquivState DebugM ()
papTrace = StateT ObjectEquivState DebugM ()
-> GenPapPayload ClosurePtr -> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
forall a. a -> StateT ObjectEquivState DebugM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
, srtTrace :: GenSrtPayload ClosurePtr -> StateT ObjectEquivState DebugM ()
srtTrace = StateT ObjectEquivState DebugM ()
-> GenSrtPayload ClosurePtr -> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
forall a. a -> StateT ObjectEquivState DebugM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
, stackTrace :: GenStackFrames SrtCont ClosurePtr
-> StateT ObjectEquivState DebugM ()
stackTrace = StateT ObjectEquivState DebugM ()
-> GenStackFrames SrtCont ClosurePtr
-> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
forall a. a -> StateT ObjectEquivState DebugM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
, closTrace :: ClosurePtr
-> SizedClosure
-> StateT ObjectEquivState DebugM ()
-> StateT ObjectEquivState DebugM ()
closTrace = ClosurePtr
-> SizedClosure
-> StateT ObjectEquivState DebugM ()
-> StateT ObjectEquivState DebugM ()
closAccum
, visitedVal :: ClosurePtr -> StateT ObjectEquivState DebugM ()
visitedVal = StateT ObjectEquivState DebugM ()
-> ClosurePtr -> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
forall a. a -> StateT ObjectEquivState DebugM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
, conDescTrace :: ConstrDesc -> StateT ObjectEquivState DebugM ()
conDescTrace = StateT ObjectEquivState DebugM ()
-> ConstrDesc -> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
forall a. a -> StateT ObjectEquivState DebugM a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
}
closAccum :: ClosurePtr
-> SizedClosure
-> (StateT ObjectEquivState DebugM) ()
-> (StateT ObjectEquivState DebugM) ()
closAccum :: ClosurePtr
-> SizedClosure
-> StateT ObjectEquivState DebugM ()
-> StateT ObjectEquivState DebugM ()
closAccum ClosurePtr
cp SizedClosure
s StateT ObjectEquivState DebugM ()
k = do
PtrClosure
s' <- DebugM PtrClosure -> StateT ObjectEquivState DebugM PtrClosure
forall (m :: * -> *) a.
Monad m =>
m a -> StateT ObjectEquivState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DebugM PtrClosure -> StateT ObjectEquivState DebugM PtrClosure)
-> DebugM PtrClosure -> StateT ObjectEquivState DebugM PtrClosure
forall a b. (a -> b) -> a -> b
$ (SrtCont -> DebugM (GenSrtPayload ClosurePtr))
-> (PayloadCont -> DebugM (GenPapPayload ClosurePtr))
-> (SrtCont -> DebugM ConstrDesc)
-> (StackCont -> DebugM (GenStackFrames SrtCont ClosurePtr))
-> (ClosurePtr -> DebugM ClosurePtr)
-> SizedClosure
-> DebugM PtrClosure
forall (f :: * -> *) a b c d e g h i j k.
Applicative f =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> DebugClosureWithExtra Size a c e h j
-> f (DebugClosureWithExtra Size b d g i k)
forall (m :: * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d e g
h i j k.
(Quintraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> m a c e h j
-> f (m b d g i k)
quintraverse SrtCont -> DebugM (GenSrtPayload ClosurePtr)
dereferenceSRT PayloadCont -> DebugM (GenPapPayload ClosurePtr)
dereferencePapPayload SrtCont -> DebugM ConstrDesc
dereferenceConDesc StackCont -> DebugM (GenStackFrames SrtCont ClosurePtr)
dereferenceStack ClosurePtr -> DebugM ClosurePtr
forall a. a -> DebugM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SizedClosure
s
PtrClosure
s'' <- (GenSrtPayload ClosurePtr
-> StateT ObjectEquivState DebugM (GenSrtPayload ClosurePtr))
-> (GenPapPayload ClosurePtr
-> StateT ObjectEquivState DebugM (GenPapPayload ClosurePtr))
-> (ConstrDesc -> StateT ObjectEquivState DebugM ConstrDesc)
-> (GenStackFrames SrtCont ClosurePtr
-> StateT
ObjectEquivState DebugM (GenStackFrames SrtCont ClosurePtr))
-> (ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> PtrClosure
-> StateT ObjectEquivState DebugM PtrClosure
forall (f :: * -> *) a b c d e g h i j k.
Applicative f =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> DebugClosureWithExtra Size a c e h j
-> f (DebugClosureWithExtra Size b d g i k)
forall (m :: * -> * -> * -> * -> * -> *) (f :: * -> *) a b c d e g
h i j k.
(Quintraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> (j -> f k)
-> m a c e h j
-> f (m b d g i k)
quintraverse ((ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> GenSrtPayload ClosurePtr
-> StateT ObjectEquivState DebugM (GenSrtPayload ClosurePtr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenSrtPayload a -> f (GenSrtPayload b)
traverse ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr
forall {m :: * -> *}.
MonadState ObjectEquivState m =>
ClosurePtr -> m ClosurePtr
rep_c) ((ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> GenPapPayload ClosurePtr
-> StateT ObjectEquivState DebugM (GenPapPayload ClosurePtr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenPapPayload a -> f (GenPapPayload b)
traverse ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr
forall {m :: * -> *}.
MonadState ObjectEquivState m =>
ClosurePtr -> m ClosurePtr
rep_c) ConstrDesc -> StateT ObjectEquivState DebugM ConstrDesc
forall a. a -> StateT ObjectEquivState DebugM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> GenStackFrames SrtCont ClosurePtr
-> StateT
ObjectEquivState DebugM (GenStackFrames SrtCont ClosurePtr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenStackFrames SrtCont a -> f (GenStackFrames SrtCont b)
traverse ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr
forall {m :: * -> *}.
MonadState ObjectEquivState m =>
ClosurePtr -> m ClosurePtr
rep_c) ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr
forall {m :: * -> *}.
MonadState ObjectEquivState m =>
ClosurePtr -> m ClosurePtr
rep_c PtrClosure
s'
(ObjectEquivState -> ObjectEquivState)
-> StateT ObjectEquivState DebugM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (ClosurePtr -> PtrClosure -> ObjectEquivState -> ObjectEquivState
addEquiv ClosurePtr
cp PtrClosure
s'')
StateT ObjectEquivState DebugM ()
k
rep_c :: ClosurePtr -> m ClosurePtr
rep_c cp :: ClosurePtr
cp@(ClosurePtr Word64
k) = do
Equiv2Map
m <- (ObjectEquivState -> Equiv2Map) -> m Equiv2Map
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ObjectEquivState -> Equiv2Map
emap2
case Int -> Equiv2Map -> Maybe ClosurePtr
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
k) Equiv2Map
m of
Just ClosurePtr
cp' -> ClosurePtr -> m ClosurePtr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ClosurePtr
cp'
Maybe ClosurePtr
Nothing -> ClosurePtr -> m ClosurePtr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ClosurePtr
cp
printObjectEquiv :: EquivMap -> IO ()
printObjectEquiv :: EquivMap -> IO ()
printObjectEquiv EquivMap
c = do
let cmp :: (a, b, c) -> b
cmp (a
_, b
b,c
_) = b
b
res :: [(PtrClosure, Int, ClosurePtr)]
res = ((PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr) -> Ordering)
-> [(PtrClosure, Int, ClosurePtr)]
-> [(PtrClosure, Int, ClosurePtr)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr) -> Ordering)
-> (PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr)
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((PtrClosure, Int, ClosurePtr) -> Int)
-> (PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (PtrClosure, Int, ClosurePtr) -> Int
forall {a} {b} {c}. (a, b, c) -> b
cmp)) (EquivMap -> [(PtrClosure, Int, ClosurePtr)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
PS.toList EquivMap
c)
showLine :: (DebugClosureWithSize (GenSrtPayload c) p ConstrDesc s c, a, a)
-> [Char]
showLine (DebugClosureWithSize (GenSrtPayload c) p ConstrDesc s c
k, a
p, a
v) =
[[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [a -> [Char]
forall a. Show a => a -> [Char]
show a
v, [Char]
":", a -> [Char]
forall a. Show a => a -> [Char]
show a
p,[Char]
":", (Int -> c -> [Char])
-> Int -> DebugClosure (GenSrtPayload c) p ConstrDesc s c -> [Char]
forall c p s.
(Int -> c -> [Char])
-> Int -> DebugClosure (GenSrtPayload c) p ConstrDesc s c -> [Char]
ppClosure (\Int
_ -> c -> [Char]
forall a. Show a => a -> [Char]
show) Int
0 (DebugClosureWithSize (GenSrtPayload c) p ConstrDesc s c
-> DebugClosure (GenSrtPayload c) p ConstrDesc s c
forall srt pap string s b.
DebugClosureWithSize srt pap string s b
-> DebugClosure srt pap string s b
noSize DebugClosureWithSize (GenSrtPayload c) p ConstrDesc s c
k)]
((PtrClosure, Int, ClosurePtr) -> IO ())
-> [(PtrClosure, Int, ClosurePtr)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
putStrLn ([Char] -> IO ())
-> ((PtrClosure, Int, ClosurePtr) -> [Char])
-> (PtrClosure, Int, ClosurePtr)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PtrClosure, Int, ClosurePtr) -> [Char]
forall {a} {a} {c} {p} {s}.
(Show a, Show a, Show c) =>
(DebugClosureWithSize (GenSrtPayload c) p ConstrDesc s c, a, a)
-> [Char]
showLine) [(PtrClosure, Int, ClosurePtr)]
res
objectEquivAnalysis :: DebugM (EquivMap, HeapGraph Size)
objectEquivAnalysis :: DebugM (EquivMap, HeapGraph Size)
objectEquivAnalysis = do
DebugM [RawBlock]
precacheBlocks
[ClosurePtr]
rs <- DebugM [ClosurePtr]
gcRoots
Int -> DebugM ()
forall (m :: * -> *) a. (DebugMonad m, Show a) => a -> m ()
traceWrite ([ClosurePtr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClosurePtr]
rs)
EquivMap
r1 <- ObjectEquivState -> EquivMap
emap (ObjectEquivState -> EquivMap)
-> DebugM ObjectEquivState -> DebugM EquivMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClosurePtr] -> DebugM ObjectEquivState
censusObjectEquiv [ClosurePtr]
rs
let elems :: EquivMap
elems = ([(PtrClosure, Int, ClosurePtr)], EquivMap) -> EquivMap
forall a b. (a, b) -> b
snd (([(PtrClosure, Int, ClosurePtr)], EquivMap) -> EquivMap)
-> ([(PtrClosure, Int, ClosurePtr)], EquivMap) -> EquivMap
forall a b. (a -> b) -> a -> b
$ Int -> EquivMap -> ([(PtrClosure, Int, ClosurePtr)], EquivMap)
forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
PS.atMostView Int
of_interest EquivMap
r1
cmp :: (a, b, c) -> b
cmp (a
_, b
b,c
_) = b
b
cps :: [ClosurePtr]
cps = ((PtrClosure, Int, ClosurePtr) -> ClosurePtr)
-> [(PtrClosure, Int, ClosurePtr)] -> [ClosurePtr]
forall a b. (a -> b) -> [a] -> [b]
map (\(PtrClosure
_, Int
_, ClosurePtr
cp) -> ClosurePtr
cp) (((PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr) -> Ordering)
-> [(PtrClosure, Int, ClosurePtr)]
-> [(PtrClosure, Int, ClosurePtr)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr) -> Ordering)
-> (PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr)
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((PtrClosure, Int, ClosurePtr) -> Int)
-> (PtrClosure, Int, ClosurePtr)
-> (PtrClosure, Int, ClosurePtr)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (PtrClosure, Int, ClosurePtr) -> Int
forall {a} {b} {c}. (a, b, c) -> b
cmp)) (EquivMap -> [(PtrClosure, Int, ClosurePtr)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
PS.toList EquivMap
elems))
HeapGraph Size
r2 <- case [ClosurePtr]
cps of
[] -> [Char] -> DebugM (HeapGraph Size)
forall a. HasCallStack => [Char] -> a
error [Char]
"None"
(ClosurePtr
c:[ClosurePtr]
cs) -> Maybe Int -> NonEmpty ClosurePtr -> DebugM (HeapGraph Size)
multiBuildHeapGraph (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) (ClosurePtr
c ClosurePtr -> [ClosurePtr] -> NonEmpty ClosurePtr
forall a. a -> [a] -> NonEmpty a
:| [ClosurePtr]
cs)
return (EquivMap
r1, HeapGraph Size
r2)
objectEquiv :: Debuggee -> IO ()
objectEquiv :: Debuggee -> IO ()
objectEquiv = DebugM (EquivMap, HeapGraph Size)
-> ((EquivMap, HeapGraph Size) -> IO ()) -> Debuggee -> IO ()
forall a r. DebugM a -> (a -> IO r) -> Debuggee -> IO r
runAnalysis DebugM (EquivMap, HeapGraph Size)
objectEquivAnalysis (((EquivMap, HeapGraph Size) -> IO ()) -> Debuggee -> IO ())
-> ((EquivMap, HeapGraph Size) -> IO ()) -> Debuggee -> IO ()
forall a b. (a -> b) -> a -> b
$ \(EquivMap
rmap, HeapGraph Size
hg) -> do
EquivMap -> IO ()
printObjectEquiv EquivMap
rmap
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Size -> [Char]) -> HeapGraph Size -> [Char]
forall a. (a -> [Char]) -> HeapGraph a -> [Char]
ppHeapGraph Size -> [Char]
forall a. Show a => a -> [Char]
show HeapGraph Size
hg