blob: 95f6cc7ab6b1391ebd11556fe927e38d0924d73b (
plain)
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
|
module Intermediate where
import Data.List
import qualified Data.Map.Strict as Map
import AST
data IRProgram =
IRProgram [BB]
(Map.Map Name GlobFuncDef)
[Value] -- data table
data GlobFuncDef =
GlobFuncDef Int -- BB id of implementation
Int -- number of arguments
[Name] -- closure slots
data BB = BB Int [Instruction] Terminator
type Instruction = (Ref, InsCode)
data Ref
= RConst Int
| RTemp Int
| RSClo Name -- static closure object of a function
| RNone
deriving Eq
data InsCode
= IAssign Ref
| IParam Int -- first param is self-recurse link
| IClosure Int
| IData Int
| ICallC Ref [Ref]
| IAllocClo Name [Ref]
| IDiscard Ref
deriving Eq
data Terminator
= IBr Ref Int Int
| IJmp Int
| IRet Ref
| ITailC Ref [Ref]
| IExit
| IUnknown
deriving Eq
bidOf :: BB -> Int
bidOf (BB i _ _) = i
termOf :: BB -> Terminator
termOf (BB _ _ t) = t
instance Show IRProgram where
show (IRProgram bbs gfds datas) = intercalate "\n" $
["IRPROGRAM", "Data Table:"] ++ map (("- " ++) . show) datas ++
["Global functions:"] ++ map (\(n, gfd) -> "- " ++ n ++ ": " ++ show gfd) (Map.assocs gfds) ++
["Blocks:"] ++ [intercalate "\n" (map show bbs)]
instance Show GlobFuncDef where
show (GlobFuncDef bbid na []) = "BB " ++ show bbid ++ " (" ++ show na ++ ")"
show (GlobFuncDef bbid na cs) =
"BB " ++ show bbid ++ " (" ++ show na ++ ") (closure slots: " ++ intercalate ", " cs ++ ")"
instance Show BB where
show (BB i inss term) =
"BB " ++ show i ++
concatMap (\(r, ic) -> case r of
RNone -> "\n " ++ show ic
_ -> "\n " ++ show r ++ " <- " ++ show ic) inss ++
"\n " ++ show term
instance Show Ref where
show (RConst n) = show n
show (RTemp n) = "t" ++ show n
show (RSClo name) = "SC(\"" ++ name ++ "\")"
show RNone = "<<NONE>>"
instance Show InsCode where
show (IAssign r) = "assign " ++ show r
show (IParam n) = "param " ++ show n
show (IClosure n) = "closure " ++ show n
show (IData n) = "data " ++ show n
show (ICallC r as) = "callc " ++ show r ++ " " ++ show as
show (IAllocClo name vs) = "alloc-closure \"" ++ name ++ "\" " ++ show vs
show (IDiscard r) = "discard " ++ show r
instance Show Terminator where
show (IBr r b1 b2) = "br " ++ show r ++ " " ++ show b1 ++ " " ++ show b2
show (IJmp b) = "jmp " ++ show b
show (IRet r) = "ret " ++ show r
show (ITailC r as) = "tailc " ++ show r ++ " " ++ show as
show IExit = "exit"
show IUnknown = "<<UNKNOWN>>"
|
