{-# LANGUAGE MagicHash, UnboxedTuples, CPP, ForeignFunctionInterface, GHCForeignImportPrim, UnliftedFFITypes, BangPatterns, RecordWildCards, DeriveFunctor, DeriveFoldable, DeriveTraversable, PatternGuards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module      :  GHC.HeapView
Copyright   :  (c) 2012-2019 Joachim Breitner
License     :  BSD3
Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>

With this module, you can investigate the heap representation of Haskell
values, i.e. to investigate sharing and lazy evaluation.
-}


module GHC.HeapView (
    -- * Heap data types
    GenClosure(..),
    Closure,
    allClosures,                            -- was allPtrs
    ClosureType(..),
    StgInfoTable(..),
    HalfWord,
    -- * Reading from the heap
    getClosureData,
    getBoxedClosureData,
    getClosureRaw,
    -- * Pretty printing
    ppClosure,
    -- * Heap maps
    -- $heapmap
    HeapTree(..),
    buildHeapTree,
    ppHeapTree,
    HeapGraphEntry(..),
    HeapGraphIndex,
    HeapGraph(..),
    lookupHeapGraph,
    heapGraphRoot,
    buildHeapGraph,
    multiBuildHeapGraph,
    addHeapGraph,
    annotateHeapGraph,
    updateHeapGraph,
    ppHeapGraph,
    -- * Boxes
    Box(..),
    asBox,
    areBoxesEqual,
    -- * Disassembler
    disassembleBCO,
    )
    where

import GHC.Exts         ( Any,
                          Ptr(..), Addr#, Int(..), Word(..),
                          ByteArray#, Array#, sizeofByteArray#, sizeofArray#, indexArray#, indexWordArray#,
                          unsafeCoerce# )

import GHC.Exts.Heap
import GHC.Exts.Heap.Constants

import GHC.Arr          (Array(..))

import Foreign          hiding ( void )
import Data.Char
import Data.List
import Data.Maybe       ( catMaybes )
import Data.Functor
import Data.Function
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import qualified Data.IntMap as M
import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Trans.Writer.Strict
import Control.Exception.Base (evaluate)

import GHC.Disassembler

#include "ghcautoconf.h"

#if __GLASGOW_HASKELL__ == 806
-- Deriving for Functor, Foldable and Traversable is missing in  GHC 8.6
-- will be available in GHC 8.8
deriving instance Functor GenClosure
deriving instance Foldable GenClosure
deriving instance Traversable GenClosure
#endif

instance Storable StgInfoTable where

   sizeOf :: StgInfoTable -> Int
sizeOf StgInfoTable
itbl
      = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
        [
         forall b a. Storable b => (a -> b) -> a -> Int
fieldSz StgInfoTable -> HalfWord
ptrs StgInfoTable
itbl,
         forall b a. Storable b => (a -> b) -> a -> Int
fieldSz StgInfoTable -> HalfWord
nptrs StgInfoTable
itbl,
         forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: HalfWord),
         forall b a. Storable b => (a -> b) -> a -> Int
fieldSz StgInfoTable -> HalfWord
srtlen StgInfoTable
itbl
        ]

   alignment :: StgInfoTable -> Int
alignment StgInfoTable
_
      = Int
wORD_SIZE

   poke :: Ptr StgInfoTable -> StgInfoTable -> IO ()
poke Ptr StgInfoTable
_a0 StgInfoTable
_itbl
      = forall a. HasCallStack => [Char] -> a
error [Char]
"Storable StgInfoTable is read-only"

   peek :: Ptr StgInfoTable -> IO StgInfoTable
peek Ptr StgInfoTable
a0
      = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT) (forall a b. Ptr a -> Ptr b
castPtr Ptr StgInfoTable
a0)
      forall a b. (a -> b) -> a -> b
$ do
           HalfWord
ptrs'   <- forall a. Storable a => PtrIO a
load
           HalfWord
nptrs'  <- forall a. Storable a => PtrIO a
load
           HalfWord
tipe'   <- forall a. Storable a => PtrIO a
load
           HalfWord
srtlen' <- forall a. Storable a => PtrIO a
load
           forall (m :: * -> *) a. Monad m => a -> m a
return
              StgInfoTable {
                 entry :: Maybe EntryFunPtr
entry  = forall a. Maybe a
Nothing,            -- Storable instance needed for EntryFunPtr!!
                 ptrs :: HalfWord
ptrs   = HalfWord
ptrs',
                 nptrs :: HalfWord
nptrs  = HalfWord
nptrs',
                 tipe :: ClosureType
tipe   = forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral (HalfWord
tipe'::HalfWord)),
                 srtlen :: HalfWord
srtlen = HalfWord
srtlen',
                 code :: Maybe ItblCodes
code   = forall a. Maybe a
Nothing              -- Storable instance needed for ItblCodes
              }

fieldSz :: Storable b => (a -> b) -> a -> Int
fieldSz :: forall b a. Storable b => (a -> b) -> a -> Int
fieldSz a -> b
sel a
x = forall a. Storable a => a -> Int
sizeOf (a -> b
sel a
x)

load :: Storable a => PtrIO a
load :: forall a. Storable a => PtrIO a
load = do Ptr a
addr <- forall a. Storable a => PtrIO (Ptr a)
advance
          forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. Storable a => Ptr a -> IO a
peek Ptr a
addr)

type PtrIO = StateT (Ptr Word8) IO

advance :: Storable a => PtrIO (Ptr a)
advance :: forall a. Storable a => PtrIO (Ptr a)
advance = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall {m :: * -> *} {a} {a} {b}.
(Monad m, Storable a) =>
Ptr a -> m (Ptr a, Ptr b)
adv where
    adv :: Ptr a -> m (Ptr a, Ptr b)
adv Ptr a
addr = case forall a b. Ptr a -> Ptr b
castPtr Ptr a
addr of { Ptr a
addrCast -> forall (m :: * -> *) a. Monad m => a -> m a
return
        (Ptr a
addrCast, Ptr a
addr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => Ptr a -> Int
sizeOfPointee Ptr a
addrCast) }

sizeOfPointee :: (Storable a) => Ptr a -> Int
sizeOfPointee :: forall a. Storable a => Ptr a -> Int
sizeOfPointee Ptr a
addr = forall a. Storable a => a -> Int
sizeOf (forall {a}. Ptr a -> a
typeHack Ptr a
addr)
    where typeHack :: Ptr a -> a
typeHack = forall a. HasCallStack => a
undefined :: Ptr a -> a


foreign import prim "stg_unpackClosurezh" unpackClosurezh# :: Any -> (# Addr#, ByteArray#, Array# b #)

-- | This returns the raw representation of the given argument. The second
-- component of the triple are the words on the heap, and the third component
-- are those words that are actually pointers. Once back in Haskell word, the
-- 'Word'  may be outdated after a garbage collector run, but the corresponding
-- 'Box' will still point to the correct value.
getClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box])
getClosureRaw :: forall a. a -> IO (Ptr StgInfoTable, [Word], [Box])
getClosureRaw a
x =
    case forall b. Any -> (# Addr#, ByteArray#, Array# b #)
unpackClosurezh# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# a
x) of
        (# Addr#
iptr, ByteArray#
dat, Array# Any
ptrs #) -> do
            let nelems :: Int
nelems = (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
dat)) forall a. Integral a => a -> a -> a
`div` Int
wORD_SIZE
                rawWords :: [Word]
rawWords = [Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWordArray# ByteArray#
dat Int#
i) | I# Int#
i <- [Int
0.. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nelems forall a. Num a => a -> a -> a
-Int
1] ]
                pelems :: Int
pelems = Int# -> Int
I# (forall a. Array# a -> Int#
sizeofArray# Array# Any
ptrs)
                ptrList :: [Box]
ptrList = forall t b. (t -> b) -> Array Int t -> [b]
amap' Any -> Box
Box forall a b. (a -> b) -> a -> b
$ forall i e. i -> i -> Int -> Array# e -> Array i e
Array Int
0 (Int
pelems forall a. Num a => a -> a -> a
- Int
1) Int
pelems Array# Any
ptrs
            -- This is just for good measure, and seems to be not important.
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. a -> IO a
evaluate [Box]
ptrList
            -- This seems to be required to avoid crashes as well
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate Int
nelems
            -- The following deep evaluation is crucial to avoid crashes (but why)?
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. a -> IO a
evaluate [Word]
rawWords
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Addr# -> Ptr a
Ptr Addr#
iptr, [Word]
rawWords, [Box]
ptrList)

-- From compiler/ghci/RtClosureInspect.hs
amap' :: (t -> b) -> Array Int t -> [b]
amap' :: forall t b. (t -> b) -> Array Int t -> [b]
amap' t -> b
f (Array Int
i0 Int
i Int
_ Array# t
arr#) = forall a b. (a -> b) -> [a] -> [b]
map Int -> b
g [Int
0 .. Int
i forall a. Num a => a -> a -> a
- Int
i0]
    where g :: Int -> b
g (I# Int#
i#) = case forall a. Array# a -> Int# -> (# a #)
indexArray# Array# t
arr# Int#
i# of
                          (# t
e #) -> t -> b
f t
e

isChar :: GenClosure b -> Maybe Char
isChar :: forall b. GenClosure b -> Maybe Char
isChar (ConstrClosure { name :: forall b. GenClosure b -> [Char]
name = [Char]
"C#", dataArgs :: forall b. GenClosure b -> [Word]
dataArgs = [Word
ch], ptrArgs :: forall b. GenClosure b -> [b]
ptrArgs = []}) = forall a. a -> Maybe a
Just (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ch))
isChar GenClosure b
_ = forall a. Maybe a
Nothing

isCons :: GenClosure b -> Maybe (b, b)
isCons :: forall b. GenClosure b -> Maybe (b, b)
isCons (ConstrClosure { name :: forall b. GenClosure b -> [Char]
name = [Char]
":", dataArgs :: forall b. GenClosure b -> [Word]
dataArgs = [], ptrArgs :: forall b. GenClosure b -> [b]
ptrArgs = [b
h,b
t]}) = forall a. a -> Maybe a
Just (b
h,b
t)
isCons GenClosure b
_ = forall a. Maybe a
Nothing

isTup :: GenClosure b -> Maybe [b]
isTup :: forall b. GenClosure b -> Maybe [b]
isTup (ConstrClosure { dataArgs :: forall b. GenClosure b -> [Word]
dataArgs = [], [b]
[Char]
StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
modl :: forall b. GenClosure b -> [Char]
pkg :: forall b. GenClosure b -> [Char]
name :: [Char]
modl :: [Char]
pkg :: [Char]
ptrArgs :: [b]
info :: StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
name :: forall b. GenClosure b -> [Char]
..}) =
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
name forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&&
       forall a. [a] -> a
head [Char]
name forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& forall a. [a] -> a
last [Char]
name forall a. Eq a => a -> a -> Bool
== Char
')' Bool -> Bool -> Bool
&&
       forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
',') (forall a. [a] -> [a]
tail (forall a. [a] -> [a]
init [Char]
name))
    then forall a. a -> Maybe a
Just [b]
ptrArgs else forall a. Maybe a
Nothing
isTup GenClosure b
_ = forall a. Maybe a
Nothing


isNil :: GenClosure b -> Bool
isNil :: forall b. GenClosure b -> Bool
isNil (ConstrClosure { name :: forall b. GenClosure b -> [Char]
name = [Char]
"[]", dataArgs :: forall b. GenClosure b -> [Word]
dataArgs = [], ptrArgs :: forall b. GenClosure b -> [b]
ptrArgs = []}) = Bool
True
isNil GenClosure b
_ = Bool
False

-- | A pretty-printer that tries to generate valid Haskell for evalutated data.
-- It assumes that for the included boxes, you already replaced them by Strings
-- using 'Data.Foldable.map' or, if you need to do IO, 'Data.Foldable.mapM'.
--
-- The parameter gives the precedendence, to avoid avoidable parenthesises.
ppClosure :: (Int -> b -> String) -> Int -> GenClosure b -> String
ppClosure :: forall b. (Int -> b -> [Char]) -> Int -> GenClosure b -> [Char]
ppClosure Int -> b -> [Char]
showBox Int
prec GenClosure b
c = case GenClosure b
c of
    GenClosure b
_ | Just Char
ch <- forall b. GenClosure b -> Maybe Char
isChar GenClosure b
c -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$
        [[Char]
"C#", forall a. Show a => a -> [Char]
show Char
ch]
    GenClosure b
_ | Just (b
h,b
t) <- forall b. GenClosure b -> Maybe (b, b)
isCons GenClosure b
c -> Bool -> [Char] -> [Char]
addBraces (Int
5 forall a. Ord a => a -> a -> Bool
<= Int
prec) forall a b. (a -> b) -> a -> b
$
        Int -> b -> [Char]
showBox Int
5 b
h forall a. [a] -> [a] -> [a]
++ [Char]
" : " forall a. [a] -> [a] -> [a]
++ Int -> b -> [Char]
showBox Int
4 b
t
    GenClosure b
_ | Just [b]
vs <- forall b. GenClosure b -> Maybe [b]
isTup GenClosure b
c ->
        [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
0) [b]
vs) forall a. [a] -> [a] -> [a]
++ [Char]
")"
    ConstrClosure {[b]
[Char]
[Word]
StgInfoTable
name :: [Char]
modl :: [Char]
pkg :: [Char]
dataArgs :: [Word]
ptrArgs :: [b]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
modl :: forall b. GenClosure b -> [Char]
pkg :: forall b. GenClosure b -> [Char]
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
name :: forall b. GenClosure b -> [Char]
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$
        [Char]
name forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) [b]
ptrArgs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Word]
dataArgs
    ThunkClosure {[b]
[Word]
StgInfoTable
dataArgs :: [Word]
ptrArgs :: [b]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$
        [Char]
"_thunk" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) [b]
ptrArgs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Word]
dataArgs
    SelectorClosure {b
StgInfoTable
selectee :: forall b. GenClosure b -> b
selectee :: b
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        [[Char]
"_sel", Int -> b -> [Char]
showBox Int
10 b
selectee]
    IndClosure {b
StgInfoTable
indirectee :: forall b. GenClosure b -> b
indirectee :: b
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        [[Char]
"_ind", Int -> b -> [Char]
showBox Int
10 b
indirectee]
    BlackholeClosure {b
StgInfoTable
indirectee :: b
info :: StgInfoTable
indirectee :: forall b. GenClosure b -> b
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        [[Char]
"_bh",  Int -> b -> [Char]
showBox Int
10 b
indirectee]
    APClosure {b
[b]
HalfWord
StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
n_args :: forall b. GenClosure b -> HalfWord
payload :: forall b. GenClosure b -> [b]
payload :: [b]
fun :: b
n_args :: HalfWord
arity :: HalfWord
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) forall a b. (a -> b) -> a -> b
$
        b
fun forall a. a -> [a] -> [a]
: [b]
payload
    PAPClosure {b
[b]
HalfWord
StgInfoTable
payload :: [b]
fun :: b
n_args :: HalfWord
arity :: HalfWord
info :: StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
n_args :: forall b. GenClosure b -> HalfWord
payload :: forall b. GenClosure b -> [b]
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) forall a b. (a -> b) -> a -> b
$
        b
fun forall a. a -> [a] -> [a]
: [b]
payload
    APStackClosure {b
[b]
StgInfoTable
payload :: [b]
fun :: b
info :: StgInfoTable
fun :: forall b. GenClosure b -> b
payload :: forall b. GenClosure b -> [b]
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) forall a b. (a -> b) -> a -> b
$
        b
fun forall a. a -> [a] -> [a]
: [b]
payload
    BCOClosure {b
[Word]
HalfWord
StgInfoTable
bcoptrs :: forall b. GenClosure b -> b
bitmap :: forall b. GenClosure b -> [Word]
instrs :: forall b. GenClosure b -> b
literals :: forall b. GenClosure b -> b
size :: forall b. GenClosure b -> HalfWord
bitmap :: [Word]
size :: HalfWord
arity :: HalfWord
bcoptrs :: b
literals :: b
instrs :: b
info :: StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        [[Char]
"_bco", Int -> b -> [Char]
showBox Int
10 b
bcoptrs]
    ArrWordsClosure {[Word]
Word
StgInfoTable
arrWords :: forall b. GenClosure b -> [Word]
bytes :: forall b. GenClosure b -> Word
arrWords :: [Word]
bytes :: Word
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        [[Char]
"toArray", [Char]
"("forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
arrWords) forall a. [a] -> [a] -> [a]
++ [Char]
" words)", forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [[Char]]
shorten (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Word]
arrWords)) ]
    MutArrClosure {[b]
Word
StgInfoTable
mccPayload :: forall b. GenClosure b -> [b]
mccPtrs :: forall b. GenClosure b -> Word
mccSize :: forall b. GenClosure b -> Word
mccPayload :: [b]
mccSize :: Word
mccPtrs :: Word
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        --["toMutArray", "("++show (length mccPayload) ++ " ptrs)",  intercalate "," (shorten (map (showBox 10) mccPayload))]
        [[Char]
"[", forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [[Char]]
shorten (forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) [b]
mccPayload)),[Char]
"]"]
    MutVarClosure {b
StgInfoTable
var :: forall b. GenClosure b -> b
var :: b
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$
        [[Char]
"_mutVar", (Int -> b -> [Char]
showBox Int
10) b
var]
    MVarClosure {b
StgInfoTable
queueHead :: forall b. GenClosure b -> b
queueTail :: forall b. GenClosure b -> b
value :: forall b. GenClosure b -> b
value :: b
queueTail :: b
queueHead :: b
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app forall a b. (a -> b) -> a -> b
$
        [[Char]
"MVar", (Int -> b -> [Char]
showBox Int
10) b
value]
    FunClosure {[b]
[Word]
StgInfoTable
dataArgs :: [Word]
ptrArgs :: [b]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
..} ->
        [Char]
"_fun" forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
braceize (forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
0) [b]
ptrArgs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Word]
dataArgs)
    BlockingQueueClosure {b
StgInfoTable
blackHole :: forall b. GenClosure b -> b
link :: forall b. GenClosure b -> b
owner :: forall b. GenClosure b -> b
queue :: forall b. GenClosure b -> b
queue :: b
owner :: b
blackHole :: b
link :: b
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} ->
        [Char]
"_blockingQueue"
    IntClosure {Int
PrimType
intVal :: forall b. GenClosure b -> Int
ptipe :: forall b. GenClosure b -> PrimType
intVal :: Int
ptipe :: PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Int", forall a. Show a => a -> [Char]
show Int
intVal]
    WordClosure {Word
PrimType
wordVal :: forall b. GenClosure b -> Word
wordVal :: Word
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Word", forall a. Show a => a -> [Char]
show Word
wordVal]
    Int64Closure {Int64
PrimType
int64Val :: forall b. GenClosure b -> Int64
int64Val :: Int64
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Int64", forall a. Show a => a -> [Char]
show Int64
int64Val]
    Word64Closure {Word64
PrimType
word64Val :: forall b. GenClosure b -> Word64
word64Val :: Word64
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Word64", forall a. Show a => a -> [Char]
show Word64
word64Val]
    AddrClosure {Int
PrimType
addrVal :: forall b. GenClosure b -> Int
addrVal :: Int
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Addr", forall a. Show a => a -> [Char]
show Int
addrVal]
    FloatClosure {Float
PrimType
floatVal :: forall b. GenClosure b -> Float
floatVal :: Float
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Float", forall a. Show a => a -> [Char]
show Float
floatVal]
    DoubleClosure {Double
PrimType
doubleVal :: forall b. GenClosure b -> Double
doubleVal :: Double
ptipe :: PrimType
ptipe :: forall b. GenClosure b -> PrimType
..} -> [[Char]] -> [Char]
app
        [[Char]
"Double", forall a. Show a => a -> [Char]
show Double
doubleVal]
    OtherClosure {[b]
[Word]
StgInfoTable
hvalues :: forall b. GenClosure b -> [b]
rawWords :: forall b. GenClosure b -> [Word]
rawWords :: [Word]
hvalues :: [b]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} ->
        [Char]
"_other"
    UnsupportedClosure {StgInfoTable
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
..} ->
        [Char]
"_unsupported"
#if MIN_VERSION_ghc_heap(8,10,1)
    -- copy-pasta'd from MutArrClosure:
    SmallMutArrClosure {[b]
Word
StgInfoTable
mccPayload :: [b]
mccPtrs :: Word
info :: StgInfoTable
mccPayload :: forall b. GenClosure b -> [b]
mccPtrs :: forall b. GenClosure b -> Word
info :: forall b. GenClosure b -> StgInfoTable
..} -> [[Char]] -> [Char]
app
        --["toMutArray", "("++show (length mccPayload) ++ " ptrs)",  intercalate "," (shorten (map (showBox 10) mccPayload))]
        [[Char]
"[", forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [[Char]]
shorten (forall a b. (a -> b) -> [a] -> [b]
map (Int -> b -> [Char]
showBox Int
10) [b]
mccPayload)),[Char]
"]"]
    WeakClosure {b
StgInfoTable
cfinalizers :: forall b. GenClosure b -> b
finalizer :: forall b. GenClosure b -> b
key :: forall b. GenClosure b -> b
link :: b
finalizer :: b
value :: b
key :: b
cfinalizers :: b
info :: StgInfoTable
link :: forall b. GenClosure b -> b
value :: forall b. GenClosure b -> b
info :: forall b. GenClosure b -> StgInfoTable
..} ->
        [Char]
"_weak"
#endif
  where
    app :: [[Char]] -> [Char]
app [[Char]
a] = [Char]
a  forall a. [a] -> [a] -> [a]
++ [Char]
"()"
    app [[Char]]
xs = Bool -> [Char] -> [Char]
addBraces (Int
10 forall a. Ord a => a -> a -> Bool
<= Int
prec) (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [[Char]]
xs)

    shorten :: [[Char]] -> [[Char]]
shorten [[Char]]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs forall a. Ord a => a -> a -> Bool
> Int
20 then forall a. Int -> [a] -> [a]
take Int
20 [[Char]]
xs forall a. [a] -> [a] -> [a]
++ [[Char]
"(and more)"] else [[Char]]
xs

{- $heapmap

   For more global views of the heap, you can use heap maps. These come in
   variations, either a trees or as graphs, depending on
   whether you want to detect cycles and sharing or not.

   The entries of a 'HeapGraph' can be annotated with arbitrary values. Most
   operations expect this to be in the 'Monoid' class: They use 'mempty' to
   annotate closures added because the passed values reference them, and they
   use 'mappend' to combine the annotations when two values conincide, e.g.
   during 'updateHeapGraph'.
-}

-- | Heap maps as tree, i.e. no sharing, no cycles.
data HeapTree = HeapTree Box (GenClosure HeapTree) | EndOfHeapTree

heapTreeClosure :: HeapTree -> Maybe (GenClosure HeapTree)
heapTreeClosure :: HeapTree -> Maybe (GenClosure HeapTree)
heapTreeClosure (HeapTree Box
_ GenClosure HeapTree
c) = forall a. a -> Maybe a
Just GenClosure HeapTree
c
heapTreeClosure HeapTree
EndOfHeapTree = forall a. Maybe a
Nothing

-- | Constructing an 'HeapTree' from a boxed value. It takes a depth parameter
-- that prevents it from running ad infinitum for cyclic or infinite
-- structures.
buildHeapTree :: Int -> Box -> IO HeapTree
buildHeapTree :: Int -> Box -> IO HeapTree
buildHeapTree Int
0 Box
_ = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HeapTree
EndOfHeapTree
buildHeapTree Int
n Box
b = do
    Closure
c <- Box -> IO Closure
getBoxedClosureData Box
b
    GenClosure HeapTree
c' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (Int -> Box -> IO HeapTree
buildHeapTree (Int
nforall a. Num a => a -> a -> a
-Int
1)) Closure
c
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Box -> GenClosure HeapTree -> HeapTree
HeapTree Box
b GenClosure HeapTree
c'

-- | Pretty-Printing a heap Tree
--
-- Example output for @[Just 4, Nothing, *something*]@, where *something* is an
-- unevaluated expression depending on the command line argument.
--
-- >[Just (I# 4),Nothing,Just (_thunk ["arg1","arg2"])]
ppHeapTree :: HeapTree -> String
ppHeapTree :: HeapTree -> [Char]
ppHeapTree = Int -> HeapTree -> [Char]
go Int
0
  where
    go :: Int -> HeapTree -> [Char]
go Int
_ HeapTree
EndOfHeapTree = [Char]
"..."
    go Int
prec t :: HeapTree
t@(HeapTree Box
_ GenClosure HeapTree
c')
        | Just [Char]
s <- HeapTree -> Maybe [Char]
isHeapTreeString HeapTree
t = forall a. Show a => a -> [Char]
show [Char]
s
        | Just [HeapTree]
l <- HeapTree -> Maybe [HeapTree]
isHeapTreeList HeapTree
t   = [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map HeapTree -> [Char]
ppHeapTree [HeapTree]
l) forall a. [a] -> [a] -> [a]
++ [Char]
"]"
        | Just [BCI HeapTree]
bc <- forall a b.
(a -> Maybe (GenClosure b)) -> GenClosure a -> Maybe [BCI b]
disassembleBCO HeapTree -> Maybe (GenClosure HeapTree)
heapTreeClosure GenClosure HeapTree
c'
                                       = [[Char]] -> [Char]
app ([Char]
"_bco" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> HeapTree -> [Char]
go Int
10) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [BCI HeapTree]
bc))
        | Bool
otherwise                    = forall b. (Int -> b -> [Char]) -> Int -> GenClosure b -> [Char]
ppClosure Int -> HeapTree -> [Char]
go Int
prec GenClosure HeapTree
c'
      where
        app :: [[Char]] -> [Char]
app [[Char]
a] = [Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"()"
        app [[Char]]
xs = Bool -> [Char] -> [Char]
addBraces (Int
10 forall a. Ord a => a -> a -> Bool
<= Int
prec) (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [[Char]]
xs)

isHeapTreeList :: HeapTree -> Maybe ([HeapTree])
isHeapTreeList :: HeapTree -> Maybe [HeapTree]
isHeapTreeList HeapTree
tree = do
    GenClosure HeapTree
c <- HeapTree -> Maybe (GenClosure HeapTree)
heapTreeClosure HeapTree
tree
    if forall b. GenClosure b -> Bool
isNil GenClosure HeapTree
c
      then forall (m :: * -> *) a. Monad m => a -> m a
return []
      else do
        (HeapTree
h,HeapTree
t) <- forall b. GenClosure b -> Maybe (b, b)
isCons GenClosure HeapTree
c
        [HeapTree]
t' <- HeapTree -> Maybe [HeapTree]
isHeapTreeList HeapTree
t
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (:) HeapTree
h [HeapTree]
t'

isHeapTreeString :: HeapTree -> Maybe String
isHeapTreeString :: HeapTree -> Maybe [Char]
isHeapTreeString HeapTree
t = do
    [HeapTree]
list <- HeapTree -> Maybe [HeapTree]
isHeapTreeList HeapTree
t
    -- We do not want to print empty lists as "" as we do not know that they
    -- are really strings.
    if (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HeapTree]
list)
        then forall a. Maybe a
Nothing
        else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall b. GenClosure b -> Maybe Char
isChar forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< HeapTree -> Maybe (GenClosure HeapTree)
heapTreeClosure) [HeapTree]
list

-- | For heap graphs, i.e. data structures that also represent sharing and
-- cyclic structures, these are the entries. If the referenced value is
-- @Nothing@, then we do not have that value in the map, most likely due to
-- exceeding the recursion bound passed to 'buildHeapGraph'.
--
-- Besides a pointer to the stored value and the closure representation we
-- also keep track of whether the value was still alive at the last update of the
-- heap graph. In addition we have a slot for arbitrary data, for the user's convenience.
data HeapGraphEntry a = HeapGraphEntry {
        forall a. HeapGraphEntry a -> Box
hgeBox :: Box,
        forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure :: GenClosure (Maybe HeapGraphIndex),
        forall a. HeapGraphEntry a -> Bool
hgeLive :: Bool,
        forall a. HeapGraphEntry a -> a
hgeData :: a}
    deriving (Int -> HeapGraphEntry a -> [Char] -> [Char]
forall a. Show a => Int -> HeapGraphEntry a -> [Char] -> [Char]
forall a. Show a => [HeapGraphEntry a] -> [Char] -> [Char]
forall a. Show a => HeapGraphEntry a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [HeapGraphEntry a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [HeapGraphEntry a] -> [Char] -> [Char]
show :: HeapGraphEntry a -> [Char]
$cshow :: forall a. Show a => HeapGraphEntry a -> [Char]
showsPrec :: Int -> HeapGraphEntry a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> HeapGraphEntry a -> [Char] -> [Char]
Show, forall a b. a -> HeapGraphEntry b -> HeapGraphEntry a
forall a b. (a -> b) -> HeapGraphEntry a -> HeapGraphEntry b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HeapGraphEntry b -> HeapGraphEntry a
$c<$ :: forall a b. a -> HeapGraphEntry b -> HeapGraphEntry a
fmap :: forall a b. (a -> b) -> HeapGraphEntry a -> HeapGraphEntry b
$cfmap :: forall a b. (a -> b) -> HeapGraphEntry a -> HeapGraphEntry b
Functor)
type HeapGraphIndex = Int

-- | The whole graph. The suggested interface is to only use 'lookupHeapGraph',
-- as the internal representation may change. Nevertheless, we export it here:
-- Sometimes the user knows better what he needs than we do.
newtype HeapGraph a = HeapGraph (M.IntMap (HeapGraphEntry a))
    deriving (Int -> HeapGraph a -> [Char] -> [Char]
forall a. Show a => Int -> HeapGraph a -> [Char] -> [Char]
forall a. Show a => [HeapGraph a] -> [Char] -> [Char]
forall a. Show a => HeapGraph a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [HeapGraph a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [HeapGraph a] -> [Char] -> [Char]
show :: HeapGraph a -> [Char]
$cshow :: forall a. Show a => HeapGraph a -> [Char]
showsPrec :: Int -> HeapGraph a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> HeapGraph a -> [Char] -> [Char]
Show)

lookupHeapGraph :: HeapGraphIndex -> (HeapGraph a) -> Maybe (HeapGraphEntry a)
lookupHeapGraph :: forall a. Int -> HeapGraph a -> Maybe (HeapGraphEntry a)
lookupHeapGraph Int
i (HeapGraph IntMap (HeapGraphEntry a)
m) = forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap (HeapGraphEntry a)
m

heapGraphRoot :: HeapGraphIndex
heapGraphRoot :: Int
heapGraphRoot = Int
0

-- | Creates a 'HeapGraph' for the value in the box, but not recursing further
-- than the given limit. The initial value has index 'heapGraphRoot'.
buildHeapGraph
   :: Monoid a
   => Int -- ^ Search limit
   -> a -- ^ Data value for the root
   -> Box -- ^ The value to start with
   -> IO (HeapGraph a)
buildHeapGraph :: forall a. Monoid a => Int -> a -> Box -> IO (HeapGraph a)
buildHeapGraph Int
limit a
rootD Box
initialBox =
    forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Monoid a =>
Int -> [(a, Box)] -> IO (HeapGraph a, [(a, Int)])
multiBuildHeapGraph Int
limit [(a
rootD, Box
initialBox)]

-- | Creates a 'HeapGraph' for the values in multiple boxes, but not recursing
--   further than the given limit.
--
--   Returns the 'HeapGraph' and the indices of initial values. The arbitrary
--   type @a@ can be used to make the connection between the input and the
--   resulting list of indices, and to store additional data.
multiBuildHeapGraph
    :: Monoid a
    => Int -- ^ Search limit
    -> [(a, Box)] -- ^ Starting values with associated data entry
    -> IO (HeapGraph a, [(a, HeapGraphIndex)])
multiBuildHeapGraph :: forall a.
Monoid a =>
Int -> [(a, Box)] -> IO (HeapGraph a, [(a, Int)])
multiBuildHeapGraph Int
limit = forall a.
Monoid a =>
Int -> HeapGraph a -> [(a, Box)] -> IO (HeapGraph a, [(a, Int)])
generalBuildHeapGraph Int
limit (forall a. IntMap (HeapGraphEntry a) -> HeapGraph a
HeapGraph forall a. IntMap a
M.empty)

-- | Adds an entry to an existing 'HeapGraph'.
--
--   Returns the updated 'HeapGraph' and the index of the added value.
addHeapGraph
    :: Monoid a
    => Int -- ^ Search limit
    -> a -- ^ Data to be stored with the added value
    -> Box -- ^ Value to add to the graph
    -> HeapGraph a -- ^ Graph to extend
    -> IO (HeapGraphIndex, HeapGraph a)
addHeapGraph :: forall a.
Monoid a =>
Int -> a -> Box -> HeapGraph a -> IO (Int, HeapGraph a)
addHeapGraph Int
limit a
d Box
box HeapGraph a
hg = do
    (HeapGraph a
hg', [(a
_,Int
i)]) <- forall a.
Monoid a =>
Int -> HeapGraph a -> [(a, Box)] -> IO (HeapGraph a, [(a, Int)])
generalBuildHeapGraph Int
limit HeapGraph a
hg [(a
d,Box
box)]
    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, HeapGraph a
hg')

-- | Adds the given annotation to the entry at the given index, using the
-- 'mappend' operation of its 'Monoid' instance.
annotateHeapGraph :: Monoid a => a -> HeapGraphIndex -> HeapGraph a -> HeapGraph a
annotateHeapGraph :: forall a. Monoid a => a -> Int -> HeapGraph a -> HeapGraph a
annotateHeapGraph a
d Int
i (HeapGraph IntMap (HeapGraphEntry a)
hg) = forall a. IntMap (HeapGraphEntry a) -> HeapGraph a
HeapGraph forall a b. (a -> b) -> a -> b
$ forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
M.update HeapGraphEntry a -> Maybe (HeapGraphEntry a)
go Int
i IntMap (HeapGraphEntry a)
hg
  where
    go :: HeapGraphEntry a -> Maybe (HeapGraphEntry a)
go HeapGraphEntry a
hge = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HeapGraphEntry a
hge { hgeData :: a
hgeData = forall a. HeapGraphEntry a -> a
hgeData HeapGraphEntry a
hge forall a. Semigroup a => a -> a -> a
<> a
d }

generalBuildHeapGraph
    :: Monoid a
    => Int
    -> HeapGraph a
    -> [(a,Box)]
    -> IO (HeapGraph a, [(a, HeapGraphIndex)])
generalBuildHeapGraph :: forall a.
Monoid a =>
Int -> HeapGraph a -> [(a, Box)] -> IO (HeapGraph a, [(a, Int)])
generalBuildHeapGraph Int
limit HeapGraph a
_ [(a, Box)]
_ | Int
limit forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"buildHeapGraph: limit has to be positive"
generalBuildHeapGraph Int
limit (HeapGraph IntMap (HeapGraphEntry a)
hg) [(a, Box)]
addBoxes = do
    -- First collect all boxes from the existing heap graph
    let boxList :: [(Box, Int)]
boxList = [ (forall a. HeapGraphEntry a -> Box
hgeBox HeapGraphEntry a
hge, Int
i) | (Int
i, HeapGraphEntry a
hge) <- forall a. IntMap a -> [(Int, a)]
M.toList IntMap (HeapGraphEntry a)
hg ]
        indices :: [Int]
indices | forall a. IntMap a -> Bool
M.null IntMap (HeapGraphEntry a)
hg = [Int
0..]
                | Bool
otherwise = [Int
1 forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
fst (forall a. IntMap a -> (Int, a)
M.findMax IntMap (HeapGraphEntry a)
hg)..]

        initialState :: ([(Box, Int)], [Int], [a])
initialState = ([(Box, Int)]
boxList, [Int]
indices, [])
    -- It is ok to use the Monoid (IntMap a) instance here, because
    -- we will, besides the first time, use 'tell' only to add singletons not
    -- already there
    ([(a, Int)]
is, IntMap (HeapGraphEntry a)
hg') <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall {c}.
StateT
  ([(Box, Int)], [Int], c)
  (WriterT (IntMap (HeapGraphEntry a)) IO)
  [(a, Int)]
run forall {a}. ([(Box, Int)], [Int], [a])
initialState)
    -- Now add the annotations of the root values
    let hg'' :: HeapGraph a
hg'' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Monoid a => a -> Int -> HeapGraph a -> HeapGraph a
annotateHeapGraph)) (forall a. IntMap (HeapGraphEntry a) -> HeapGraph a
HeapGraph IntMap (HeapGraphEntry a)
hg') [(a, Int)]
is
    forall (m :: * -> *) a. Monad m => a -> m a
return (HeapGraph a
hg'', [(a, Int)]
is)
  where
    run :: StateT
  ([(Box, Int)], [Int], c)
  (WriterT (IntMap (HeapGraphEntry a)) IO)
  [(a, Int)]
run = do
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell IntMap (HeapGraphEntry a)
hg -- Start with the initial map
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(a, Box)]
addBoxes forall a b. (a -> b) -> a -> b
$ \(a
d, Box
b) -> do
            -- Cannot fail, as limit is not zero here
            Just Int
i <- forall {t} {c}.
(Eq t, Num t) =>
t
-> Box
-> StateT
     ([(Box, Int)], [Int], c)
     (WriterT (IntMap (HeapGraphEntry a)) IO)
     (Maybe Int)
add Int
limit Box
b
            forall (m :: * -> *) a. Monad m => a -> m a
return (a
d, Int
i)

    add :: t
-> Box
-> StateT
     ([(Box, Int)], [Int], c)
     (WriterT (IntMap (HeapGraphEntry a)) IO)
     (Maybe Int)
add t
0  Box
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    add t
n Box
b = do
        -- If the box is in the map, return the index
        ([(Box, Int)]
existing,[Int]
_,c
_) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
        Maybe (Box, Int)
mbI <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. (a -> IO Bool) -> [a] -> IO (Maybe a)
findM (Box -> Box -> IO Bool
areBoxesEqual Box
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Box, Int)]
existing
        case Maybe (Box, Int)
mbI of
            Just (Box
_,Int
i) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
i
            Maybe (Box, Int)
Nothing -> do
                -- Otherwise, allocate a new index
                Int
i <- forall {a} {b} {c}.
StateT (a, [b], c) (WriterT (IntMap (HeapGraphEntry a)) IO) b
nextI
                -- And register it
                forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\([(Box, Int)]
x,[Int]
y,c
z) -> ((Box
b,Int
i)forall a. a -> [a] -> [a]
:[(Box, Int)]
x, [Int]
y, c
z))
                -- Look up the closure
                Closure
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Box -> IO Closure
getBoxedClosureData Box
b
                -- Find indicies for all boxes contained in the map
                GenClosure (Maybe Int)
c' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (t
-> Box
-> StateT
     ([(Box, Int)], [Int], c)
     (WriterT (IntMap (HeapGraphEntry a)) IO)
     (Maybe Int)
add (t
nforall a. Num a => a -> a -> a
-t
1)) Closure
c
                -- Add add the resulting closure to the map
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (forall a. Int -> a -> IntMap a
M.singleton Int
i (forall a.
Box -> GenClosure (Maybe Int) -> Bool -> a -> HeapGraphEntry a
HeapGraphEntry Box
b GenClosure (Maybe Int)
c' Bool
True forall a. Monoid a => a
mempty))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
i
    nextI :: StateT (a, [b], c) (WriterT (IntMap (HeapGraphEntry a)) IO) b
nextI = do
        b
i <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(a
_,[b]
b,c
_) -> [b]
b))
        forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\(a
a,[b]
b,c
c) -> (a
a, forall a. [a] -> [a]
tail [b]
b, c
c))
        forall (m :: * -> *) a. Monad m => a -> m a
return b
i

-- | This function updates a heap graph to reflect the current state of
-- closures on the heap, conforming to the following specification.
--
--  * Every entry whose value has been garbage collected by now is marked as
--    dead by setting 'hgeLive' to @False@
--  * Every entry whose value is still live gets the 'hgeClosure' field updated
--    and newly referenced closures are, up to the given depth, added to the graph.
--  * A map mapping previous indicies to the corresponding new indicies is returned as well.
--  * The closure at 'heapGraphRoot' stays at 'heapGraphRoot'
updateHeapGraph :: Monoid a => Int -> HeapGraph a -> IO (HeapGraph a, HeapGraphIndex -> HeapGraphIndex)
updateHeapGraph :: forall a.
Monoid a =>
Int -> HeapGraph a -> IO (HeapGraph a, Int -> Int)
updateHeapGraph Int
limit (HeapGraph IntMap (HeapGraphEntry a)
startHG) = do
    (HeapGraph a
hg', IntMap Int
indexMap) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {a}.
(MonadIO m, Monoid a) =>
HeapGraph a
-> (Int, HeapGraphEntry a) -> WriterT (IntMap Int) m (HeapGraph a)
go (forall a. IntMap (HeapGraphEntry a) -> HeapGraph a
HeapGraph forall a. IntMap a
M.empty) (forall a. IntMap a -> [(Int, a)]
M.toList IntMap (HeapGraphEntry a)
startHG)
    forall (m :: * -> *) a. Monad m => a -> m a
return (HeapGraph a
hg', forall a. IntMap a -> Int -> a
(M.!) IntMap Int
indexMap)
  where
    go :: HeapGraph a
-> (Int, HeapGraphEntry a) -> WriterT (IntMap Int) m (HeapGraph a)
go HeapGraph a
hg (Int
i, HeapGraphEntry a
hge) = do
        (Int
j, HeapGraph a
hg') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Monoid a =>
Int -> a -> Box -> HeapGraph a -> IO (Int, HeapGraph a)
addHeapGraph Int
limit (forall a. HeapGraphEntry a -> a
hgeData HeapGraphEntry a
hge) (forall a. HeapGraphEntry a -> Box
hgeBox HeapGraphEntry a
hge) HeapGraph a
hg
        forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (forall a. Int -> a -> IntMap a
M.singleton Int
i Int
j)
        forall (m :: * -> *) a. Monad m => a -> m a
return HeapGraph a
hg'

-- | Pretty-prints a HeapGraph. The resulting string contains newlines. Example
-- for @let s = \"Ki\" in (s, s, cycle \"Ho\")@:
--
-- >let x1 = "Ki"
-- >    x6 = C# 'H' : C# 'o' : x6
-- >in (x1,x1,x6)
ppHeapGraph :: HeapGraph a -> String
ppHeapGraph :: forall a. HeapGraph a -> [Char]
ppHeapGraph (HeapGraph IntMap (HeapGraphEntry a)
m) = [Char]
letWrapper forall a. [a] -> [a] -> [a]
++ Int -> Maybe Int -> [Char]
ppRef Int
0 (forall a. a -> Maybe a
Just Int
heapGraphRoot)
  where
    -- All variables occuring more than once
    bindings :: [Int]
bindings = forall a. HeapGraph a -> [Int] -> [Int]
boundMultipleTimes (forall a. IntMap (HeapGraphEntry a) -> HeapGraph a
HeapGraph IntMap (HeapGraphEntry a)
m) [Int
heapGraphRoot]

    letWrapper :: [Char]
letWrapper =
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
bindings
        then [Char]
""
        else [Char]
"let " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n    " (forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
ppBinding [Int]
bindings) forall a. [a] -> [a] -> [a]
++ [Char]
"\nin "

    bindingLetter :: Int -> Char
bindingLetter Int
i = case forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure (Int -> HeapGraphEntry a
iToE Int
i) of
        ThunkClosure {[Maybe Int]
[Word]
StgInfoTable
dataArgs :: [Word]
ptrArgs :: [Maybe Int]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
..} -> Char
't'
        SelectorClosure {Maybe Int
StgInfoTable
selectee :: Maybe Int
info :: StgInfoTable
selectee :: forall b. GenClosure b -> b
info :: forall b. GenClosure b -> StgInfoTable
..} -> Char
't'
        APClosure {[Maybe Int]
Maybe Int
HalfWord
StgInfoTable
payload :: [Maybe Int]
fun :: Maybe Int
n_args :: HalfWord
arity :: HalfWord
info :: StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
n_args :: forall b. GenClosure b -> HalfWord
payload :: forall b. GenClosure b -> [b]
info :: forall b. GenClosure b -> StgInfoTable
..} -> Char
't'
        PAPClosure {[Maybe Int]
Maybe Int
HalfWord
StgInfoTable
payload :: [Maybe Int]
fun :: Maybe Int
n_args :: HalfWord
arity :: HalfWord
info :: StgInfoTable
arity :: forall b. GenClosure b -> HalfWord
fun :: forall b. GenClosure b -> b
n_args :: forall b. GenClosure b -> HalfWord
payload :: forall b. GenClosure b -> [b]
info :: forall b. GenClosure b -> StgInfoTable
..} -> Char
'f'
        BCOClosure {[Word]
Maybe Int
HalfWord
StgInfoTable
bitmap :: [Word]
size :: HalfWord
arity :: HalfWord
bcoptrs :: Maybe Int
literals :: Maybe Int
instrs :: Maybe Int
info :: StgInfoTable
bcoptrs :: forall b. GenClosure b -> b
bitmap :: forall b. GenClosure b -> [Word]
instrs :: forall b. GenClosure b -> b
literals :: forall b. GenClosure b -> b
size :: forall b. GenClosure b -> HalfWord
arity :: forall b. GenClosure b -> HalfWord
info :: forall b. GenClosure b -> StgInfoTable
..} -> Char
't'
        FunClosure {[Maybe Int]
[Word]
StgInfoTable
dataArgs :: [Word]
ptrArgs :: [Maybe Int]
info :: StgInfoTable
info :: forall b. GenClosure b -> StgInfoTable
ptrArgs :: forall b. GenClosure b -> [b]
dataArgs :: forall b. GenClosure b -> [Word]
..} -> Char
'f'
        GenClosure (Maybe Int)
_ -> Char
'x'

    ppBindingMap :: IntMap [Char]
ppBindingMap = forall a. [(Int, a)] -> IntMap a
M.fromList forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
j (Int
i,Char
c) -> (Int
i, [Char
c] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
j)) [(Int
1::Int)..]) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)
        [ (Int
i, Int -> Char
bindingLetter Int
i) | Int
i <- [Int]
bindings ]

    ppVar :: Int -> [Char]
ppVar Int
i = IntMap [Char]
ppBindingMap forall a. IntMap a -> Int -> a
M.! Int
i
    ppBinding :: Int -> [Char]
ppBinding Int
i = Int -> [Char]
ppVar Int
i forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ Int -> HeapGraphEntry a -> [Char]
ppEntry Int
0 (Int -> HeapGraphEntry a
iToE Int
i)

    ppEntry :: Int -> HeapGraphEntry a -> [Char]
ppEntry Int
prec HeapGraphEntry a
hge
        | Just [Char]
s <- forall a. HeapGraphEntry a -> Maybe [Char]
isString HeapGraphEntry a
hge = forall a. Show a => a -> [Char]
show [Char]
s
        | Just [Maybe Int]
l <- forall a. HeapGraphEntry a -> Maybe [Maybe Int]
isList HeapGraphEntry a
hge   = [Char]
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> [Char]
ppRef Int
0) [Maybe Int]
l) forall a. [a] -> [a] -> [a]
++ [Char]
"]"
        | Just [BCI (Maybe Int)]
bc <- forall a b.
(a -> Maybe (GenClosure b)) -> GenClosure a -> Maybe [BCI b]
disassembleBCO (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HeapGraphEntry a
iToE)) (forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure HeapGraphEntry a
hge)
                                       = [[Char]] -> [Char]
app ([Char]
"_bco" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> Maybe Int -> [Char]
ppRef Int
10) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [BCI (Maybe Int)]
bc))
        | Bool
otherwise = forall b. (Int -> b -> [Char]) -> Int -> GenClosure b -> [Char]
ppClosure Int -> Maybe Int -> [Char]
ppRef Int
prec (forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure HeapGraphEntry a
hge)
      where
        app :: [[Char]] -> [Char]
app [[Char]
a] = [Char]
a  forall a. [a] -> [a] -> [a]
++ [Char]
"()"
        app [[Char]]
xs = Bool -> [Char] -> [Char]
addBraces (Int
10 forall a. Ord a => a -> a -> Bool
<= Int
prec) (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" " [[Char]]
xs)

    ppRef :: Int -> Maybe Int -> [Char]
ppRef Int
_ Maybe Int
Nothing = [Char]
"..."
    ppRef Int
prec (Just Int
i) | Int
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
bindings = Int -> [Char]
ppVar Int
i
                        | Bool
otherwise = Int -> HeapGraphEntry a -> [Char]
ppEntry Int
prec (Int -> HeapGraphEntry a
iToE Int
i)
    iToE :: Int -> HeapGraphEntry a
iToE Int
i = IntMap (HeapGraphEntry a)
m forall a. IntMap a -> Int -> a
M.! Int
i

    iToUnboundE :: Int -> Maybe (HeapGraphEntry a)
iToUnboundE Int
i = if Int
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
bindings then forall a. Maybe a
Nothing else forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap (HeapGraphEntry a)
m

    isList :: HeapGraphEntry a -> Maybe ([Maybe HeapGraphIndex])
    isList :: forall a. HeapGraphEntry a -> Maybe [Maybe Int]
isList HeapGraphEntry a
hge =
        if forall b. GenClosure b -> Bool
isNil (forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure HeapGraphEntry a
hge)
          then forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            (Maybe Int
h,Maybe Int
t) <- forall b. GenClosure b -> Maybe (b, b)
isCons (forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure HeapGraphEntry a
hge)
            Int
ti <- Maybe Int
t
            HeapGraphEntry a
e <- Int -> Maybe (HeapGraphEntry a)
iToUnboundE Int
ti
            [Maybe Int]
t' <- forall a. HeapGraphEntry a -> Maybe [Maybe Int]
isList HeapGraphEntry a
e
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (:) Maybe Int
h [Maybe Int]
t'

    isString :: HeapGraphEntry a -> Maybe String
    isString :: forall a. HeapGraphEntry a -> Maybe [Char]
isString HeapGraphEntry a
e = do
        [Maybe Int]
list <- forall a. HeapGraphEntry a -> Maybe [Maybe Int]
isList HeapGraphEntry a
e
        -- We do not want to print empty lists as "" as we do not know that they
        -- are really strings.
        if (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Int]
list)
            then forall a. Maybe a
Nothing
            else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall b. GenClosure b -> Maybe Char
isChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> Maybe (HeapGraphEntry a)
iToUnboundE forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. a -> a
id) [Maybe Int]
list


-- | In the given HeapMap, list all indices that are used more than once. The
-- second parameter adds external references, commonly @[heapGraphRoot]@.
boundMultipleTimes :: HeapGraph a -> [HeapGraphIndex] -> [HeapGraphIndex]
boundMultipleTimes :: forall a. HeapGraph a -> [Int] -> [Int]
boundMultipleTimes (HeapGraph IntMap (HeapGraphEntry a)
m) [Int]
roots = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [[a]]
group forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$
     [Int]
roots forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. GenClosure b -> [b]
allClosures forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HeapGraphEntry a -> GenClosure (Maybe Int)
hgeClosure) (forall a. IntMap a -> [a]
M.elems IntMap (HeapGraphEntry a)
m)

-- | This function integrates the disassembler in "GHC.Disassembler". The first
-- argument should a function that dereferences the pointer in the closure to a
-- closure.
--
-- If any of these return 'Nothing', then 'disassembleBCO' returns Nothing
disassembleBCO :: (a -> Maybe (GenClosure b)) -> GenClosure a -> Maybe [BCI b]
-- Disable the assembler
disassembleBCO :: forall a b.
(a -> Maybe (GenClosure b)) -> GenClosure a -> Maybe [BCI b]
disassembleBCO a -> Maybe (GenClosure b)
_ GenClosure a
_ | forall a. a -> a
id Bool
True = forall a. Maybe a
Nothing
disassembleBCO a -> Maybe (GenClosure b)
deref (BCOClosure {a
[Word]
HalfWord
StgInfoTable
bitmap :: [Word]
size :: HalfWord
arity :: HalfWord
bcoptrs :: a
literals :: a
instrs :: a
info :: StgInfoTable
bcoptrs :: forall b. GenClosure b -> b
bitmap :: forall b. GenClosure b -> [Word]
instrs :: forall b. GenClosure b -> b
literals :: forall b. GenClosure b -> b
size :: forall b. GenClosure b -> HalfWord
arity :: forall b. GenClosure b -> HalfWord
info :: forall b. GenClosure b -> StgInfoTable
..}) = do
    GenClosure b
opsC <- a -> Maybe (GenClosure b)
deref a
instrs
    GenClosure b
litsC <- a -> Maybe (GenClosure b)
deref a
literals
    GenClosure b
ptrsC  <- a -> Maybe (GenClosure b)
deref a
bcoptrs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall box. [box] -> [Word] -> ByteString -> [BCI box]
disassemble (forall b. GenClosure b -> [b]
mccPayload GenClosure b
ptrsC) (forall b. GenClosure b -> [Word]
arrWords GenClosure b
litsC) (Word -> [Word] -> ByteString
toBytes (forall b. GenClosure b -> Word
bytes GenClosure b
opsC) (forall b. GenClosure b -> [Word]
arrWords GenClosure b
opsC))
disassembleBCO a -> Maybe (GenClosure b)
_ GenClosure a
_ = forall a. Maybe a
Nothing

-- Utilities

findM :: (a -> IO Bool) -> [a] -> IO (Maybe a)
findM :: forall a. (a -> IO Bool) -> [a] -> IO (Maybe a)
findM a -> IO Bool
_p [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
findM a -> IO Bool
p (a
x:[a]
xs) = do
    Bool
b <- a -> IO Bool
p a
x
    if Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x) else forall a. (a -> IO Bool) -> [a] -> IO (Maybe a)
findM a -> IO Bool
p [a]
xs

addBraces :: Bool -> String -> String
addBraces :: Bool -> [Char] -> [Char]
addBraces Bool
True [Char]
t = [Char]
"(" forall a. [a] -> [a] -> [a]
++ [Char]
t forall a. [a] -> [a] -> [a]
++ [Char]
")"
addBraces Bool
False [Char]
t = [Char]
t

braceize :: [String] -> String
braceize :: [[Char]] -> [Char]
braceize [] = [Char]
""
braceize [[Char]]
xs = [Char]
"{" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," [[Char]]
xs forall a. [a] -> [a] -> [a]
++ [Char]
"}"