module GHC.Vacuum.Types (
module GHC.Vacuum.Types
) where
import GHC.Vacuum.ClosureType
import GHC.Vacuum.Internal(HValue)
import Data.Word
import Data.IntMap(IntMap)
import Data.Monoid(Monoid(..))
import System.Mem.StableName
type HNodeId = Int
data HNode = HNode
{nodePtrs :: [HNodeId]
,nodeLits :: [Word]
,nodeInfo :: InfoTab}
deriving(Eq,Ord,Read,Show)
emptyHNode :: ClosureType -> HNode
emptyHNode ct = HNode
{nodePtrs = []
,nodeLits = []
,nodeInfo = if isCon ct
then ConInfo [] [] [] 0 0 ct 0 []
else OtherInfo 0 0 ct 0 []}
nodePkg :: HNode -> String
nodeMod :: HNode -> String
nodeName :: HNode -> String
nodePkg = fst3 . itabName . nodeInfo
nodeMod = snd3 . itabName . nodeInfo
nodeName = trd3 . itabName . nodeInfo
fst3 :: (a, b, c) -> a
fst3 (x,_,_) = x
snd3 :: (a, b, c) -> b
snd3 (_,x,_) = x
trd3 :: (a, b, c) -> c
trd3 (_,_,x) = x
itabName :: InfoTab -> (String, String, String)
itabName i@(ConInfo{}) = (itabPkg i, itabMod i, itabCon i)
itabName _ = ([], [], [])
summary :: HNode -> ([String],[HNodeId],[Word])
summary (HNode ps ls info) = case itabName info of
(a,b,c) -> ([a,b,c],ps,ls)
data InfoTab
= ConInfo {itabPkg :: String
,itabMod :: String
,itabCon :: String
,itabPtrs :: Word
,itabLits :: Word
,itabType :: ClosureType
,itabSrtLen :: Word
,itabCode :: [Word]}
| OtherInfo {itabPtrs :: Word
,itabLits :: Word
,itabType :: ClosureType
,itabSrtLen :: Word
,itabCode :: [Word]}
deriving(Eq,Ord,Read,Show)
data Closure = Closure
{closPtrs :: [HValue]
,closLits :: [Word]
,closITab :: InfoTab}
deriving(Show)
instance Show HValue where show _ = "(HValue)"
data Box a = Box a
data Env = Env
{uniq :: HNodeId
,seen :: IntMap [(StableName HValue,HNodeId)]
,hvals :: IntMap (Box HValue)
,graph :: IntMap HNode}
emptyEnv :: Env
emptyEnv = Env
{uniq = 0
,seen = mempty
,hvals = mempty
,graph = mempty}