-
Notifications
You must be signed in to change notification settings - Fork 8
/
Types.hs
98 lines (79 loc) · 2.4 KB
/
Types.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
{-# LANGUAGE TypeSynonymInstances #-}
module GHC.Vacuum.Types (
module GHC.Vacuum.Types
) where
import GHC.Vacuum.ClosureType
import GHC.Vacuum.Internal(HValue)
import Data.List
import Data.Word
import Data.IntMap(IntMap)
import Data.Monoid(Monoid(..))
import qualified Data.IntMap as IM
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 (x,_,_) = x
snd3 (_,x,_) = x
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)
-- So we can derive Show for Closure
instance Show HValue where show _ = "(HValue)"
-- A box for safe deposit of HValues
data Box a = Box a
------------------------------------------------
data Env = Env
{uniq :: HNodeId
-- the keys are hashes of StableNames
,seen :: IntMap [(StableName HValue,HNodeId)]
,hvals :: IntMap (Box HValue)
,graph :: IntMap HNode}
emptyEnv :: Env
emptyEnv = Env
{uniq = 0
,seen = mempty
,hvals = mempty
,graph = mempty}
------------------------------------------------