{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
-- | Attempt to find duplicate objects on the heap. The analysis is not
-- exact but attempts to find closures which are identical, and could be
-- shared.
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

-- | How big to allow the priority queue to grow to
limit :: Int
limit :: Int
limit = Int
100_000
-- | How many times an object must appear per 100 000 closures to be
-- "interesting" and kept for the future.
of_interest :: Int
of_interest :: Int
of_interest = Int
1000

-- Pick a representative ClosurePtr for each object
type EquivMap = PS.OrdPSQ PtrClosure -- Object
                           Int
                           ClosurePtr -- Representative of equivalence class

type Equiv2Map = IM.IntMap -- Pointer
                  ClosurePtr -- Representative of equivalence class

data ObjectEquivState = ObjectEquivState  {
                            ObjectEquivState -> EquivMap
emap   :: !EquivMap
                          , ObjectEquivState -> Equiv2Map
emap2 :: !Equiv2Map
                          , ObjectEquivState -> CensusByObjectEquiv
_census :: !CensusByObjectEquiv
                          }
-- Don't need to add identity mapping in emap2 because lookup failure is
-- the identity anyway.
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
                                     -- Only remap objects which have a hit
                                     -- in the cache
                                     Right ClosurePtr
new_cp -> ClosurePtr -> ClosurePtr -> Equiv2Map -> Equiv2Map
addNewMap ClosurePtr
cp ClosurePtr
new_cp (ObjectEquivState -> Equiv2Map
emap2 ObjectEquivState
o)
                  in ( ObjectEquivState
o { emap :: EquivMap
emap = EquivMap
new_m
                      , emap2 :: Equiv2Map
emap2 = Equiv2Map
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

-- Trim down map to keep objects which have only been seen 100 times or
-- more within the last 10 000 seen objects
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 :: EquivMap
emap = ([(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 (ObjectEquivState -> EquivMap
emap ObjectEquivState
o) }
                   in Int -> ObjectEquivState -> ObjectEquivState
forall a b. Show a => a -> b -> b
traceShow (ObjectEquivState -> Int
checkSize ObjectEquivState
new_o) ObjectEquivState
new_o
                   -- TODO: Here would be good to also keep everything
                   -- which is referenced by the kept closures, otherwise
                   -- you end up with duplicates in the map

              else ObjectEquivState
o

-- | O(1) due to psqueues implementation
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 PapPayload ConstrDesc StackFrames ClosurePtr

-- | General function for performing a heap census in constant memory
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 (m :: * -> *) a. Monad m => a -> m a
return ())
              , stackTrace :: GenStackFrames ClosurePtr -> StateT ObjectEquivState DebugM ()
stackTrace = StateT ObjectEquivState DebugM ()
-> GenStackFrames ClosurePtr -> StateT ObjectEquivState DebugM ()
forall a b. a -> b -> a
const (() -> StateT ObjectEquivState DebugM ()
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 (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 (m :: * -> *) a. Monad m => a -> m a
return ())

            }
    -- Add cos
    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
      -- Step 0: Check to see whether there is already an equivalence class
      -- for this cp
      -- Step 1: Decode a bit more of the object, so we can see all the
      -- pointers.
      PtrClosure
s' <- DebugM PtrClosure -> StateT ObjectEquivState DebugM PtrClosure
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
$ (PayloadCont -> DebugM (GenPapPayload ClosurePtr))
-> (ConstrDescCont -> DebugM ConstrDesc)
-> (StackCont -> DebugM (GenStackFrames ClosurePtr))
-> (ClosurePtr -> DebugM ClosurePtr)
-> SizedClosure
-> DebugM PtrClosure
forall (m :: * -> * -> * -> * -> *) (f :: * -> *) a b c d e g h i.
(Quadtraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> m a c e h
-> f (m b d g i)
quadtraverse PayloadCont -> DebugM (GenPapPayload ClosurePtr)
dereferencePapPayload ConstrDescCont -> DebugM ConstrDesc
dereferenceConDesc StackCont -> DebugM (GenStackFrames ClosurePtr)
dereferenceStack ClosurePtr -> DebugM ClosurePtr
forall (f :: * -> *) a. Applicative f => a -> f a
pure SizedClosure
s
      -- Step 2: Replace all the pointers in the closure by things they are
      -- equivalent to we have already seen.
      PtrClosure
s''  <- (GenPapPayload ClosurePtr
 -> StateT ObjectEquivState DebugM (GenPapPayload ClosurePtr))
-> (ConstrDesc -> StateT ObjectEquivState DebugM ConstrDesc)
-> (GenStackFrames ClosurePtr
    -> StateT ObjectEquivState DebugM (GenStackFrames ClosurePtr))
-> (ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> PtrClosure
-> StateT ObjectEquivState DebugM PtrClosure
forall (m :: * -> * -> * -> * -> *) (f :: * -> *) a b c d e g h i.
(Quadtraversable m, Applicative f) =>
(a -> f b)
-> (c -> f d)
-> (e -> f g)
-> (h -> f i)
-> m a c e h
-> f (m b d g i)
quadtraverse ((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)
traverse ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr
forall {m :: * -> *}.
MonadState ObjectEquivState m =>
ClosurePtr -> m ClosurePtr
rep_c) ConstrDesc -> StateT ObjectEquivState DebugM ConstrDesc
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ClosurePtr -> StateT ObjectEquivState DebugM ClosurePtr)
-> GenStackFrames ClosurePtr
-> StateT ObjectEquivState DebugM (GenStackFrames ClosurePtr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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'
      -- Step 3: Have we seen a closure like this one before?
      (ObjectEquivState -> ObjectEquivState)
-> StateT ObjectEquivState DebugM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (ClosurePtr -> PtrClosure -> ObjectEquivState -> ObjectEquivState
addEquiv ClosurePtr
cp PtrClosure
s'')

{-
        -- Yes, we have seen something of identical shape
        -- 1. Update equivalence maps to map this closure into the right
        -- equivalence class
        Just new_cp -> do
          n <- checkSize <$> lift get
          traceShowM n
          lift $ modify' (addNewMap cp new_cp)
          return new_cp
          --
        -- No, never seen something like this before
        -- Add the mapping to emap
        Nothing -> do
          lift $ modify' (addNewEquiv cp s'')
          return cp
          -}

      -- Step 4: Update the census, now we know the equivalence class of
      -- the object
      --lift $ modify' (go new_cp s'')
      -- Step 5: Call the continuation to carry on with the analysis
      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
        -- There is an equivalence class already
        Just ClosurePtr
cp' -> ClosurePtr -> m ClosurePtr
forall (m :: * -> *) a. Monad m => a -> m a
return ClosurePtr
cp'
        -- No equivalence class yet
        Maybe ClosurePtr
Nothing -> ClosurePtr -> m ClosurePtr
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 p ConstrDesc s c, a, a) -> [Char]
showLine (DebugClosureWithSize 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]
":", [Char]
-> (Int -> c -> [Char])
-> Int
-> DebugClosure p ConstrDesc s c
-> [Char]
forall c p s.
[Char]
-> (Int -> c -> [Char])
-> Int
-> DebugClosure p ConstrDesc s c
-> [Char]
ppClosure [Char]
"" (\Int
_ -> c -> [Char]
forall a. Show a => a -> [Char]
show) Int
0 (DebugClosureWithSize p ConstrDesc s c
-> DebugClosure p ConstrDesc s c
forall pap string s b.
DebugClosureWithSize pap string s b -> DebugClosure pap string s b
noSize DebugClosureWithSize 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 p ConstrDesc s c, a, a) -> [Char]
showLine) [(PtrClosure, Int, ClosurePtr)]
res
--  writeFile "profile/profile_out.txt" (unlines $ "key, total, count, max, avg" : (map showLine 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 (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))
  -- Use this code if we are returning ClosurePtr not SourceInformation
  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