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
|
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
|
-
+
-
+
+
-
-
+
+
+
+
+
+
+
|
namespace clang
namespace nanopass
module CLanguage =
// Grammar:
// arg ::= int | var
// exp ::= arg | (read) | (- arg) | (+ arg arg)
// stmt ::= (assign var exp) | (return arg)
// C0 ::= (program (var∗) stmt+)
type CLanguage = CProgram of CSymbols * CStatement list
and CSymbols = Map<string, CVarHolder>
and CSymbols = Map<string, CVarInfo>
and CStatement = CAssign of string * CExpression // variable name * expression
| CIfStmt of CArgument * CStatement list * CStatement list
| CReturn of CArgument
and CVarInfo = {
and CVariable = CDataType * int // (data type, offset in memory)
and CVarHolder = { var: CVariable; ghost : bool; rdcnt : int; wrcnt : int } // (<var>, is ghost / hidden, read counter, write counter)
dtype: CDataType; // data type
offset : int; // offset in the memory
auto : bool; // is generated variable
rdcnt : int; // read op counter
wrcnt : int // write op counter
}
and CExpression = CValue of CArgument
| CRead // read value, polymorphic :: () -> integer | () -> boolean
| CNeg of CArgument // negative:: integer -> integer
| CAdd of CArgument * CArgument // add:: integer -> integer -> integer
| CSub of CArgument * CArgument // substract:: integer -> integer -> integer
| CMul of CArgument * CArgument // multiply:: integer -> integer -> integer
| CDiv of CArgument * CArgument // divide:: integer -> integer -> integer
| CCmpEq of CArgument * CArgument // compare 'equal':: integer -> integer -> boolean
| CCmpNeq of CArgument * CArgument // compare 'not equal':: integer -> integer -> boolean
| CCmpLt of CArgument * CArgument // compare 'less':: integer -> integer -> boolean
| CCmpGt of CArgument * CArgument // compare 'great':: integer -> integer -> boolean
| CCmpLe of CArgument * CArgument // compare 'less or equal':: integer -> integer -> boolean
| CCmpGe of CArgument * CArgument // compare 'great equal':: integer -> integer -> boolean
| CNot of CArgument // boolean NOT:: boolean -> boolean
| CAnd of CArgument * CArgument // booleand AND:: boolean -> boolean -> boolean
| COr of CArgument * CArgument // booleand OR:: boolean -> boolean -> boolean
| CXOr of CArgument * CArgument // booleand exclusive OR:: boolean -> boolean -> boolean
and CArgument = CInt of int | CBool of bool | CBoolVar of string | CIntVar of string
and CDataType = CTypeAny | CTypeInt | CTypeBool | CUnknown
let get_arg_type arg =
match arg with
| CBool _ | CBoolVar _ -> CTypeBool
| CInt _ | CIntVar _ -> CTypeInt
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
+
|
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
CTypeBool
| CNot (_)
| CAnd (_, _)
| CXOr (_, _)
| COr (_, _) ->
CTypeBool
let expr_args_is_ok exp =
match exp with
| CValue v -> true
| CRead -> true
|
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
+
+
+
+
+
+
+
-
+
-
-
+
+
+
+
-
+
-
+
-
+
-
-
-
-
-
-
-
+
-
+
-
-
+
+
|
let t2 = get_arg_type a2
match t1, t2 with
| CTypeInt , CTypeInt-> true
| _, _ -> false
| CNot (a1) ->
(get_arg_type a1) = CTypeBool
| CAnd (a1, a2)
| CXOr (a1, a2)
| COr (a1, a2) ->
let t1 = get_arg_type a1
let t2 = get_arg_type a2
match t1, t2 with
| CTypeBool , CTypeBool-> true
| _, _ -> false
let calcNextOffset lastVar =
match (lastVar.dtype) with
| CTypeBool -> (lastVar.offset) + 1
| CTypeInt -> (lastVar.offset) + 4
| _ -> (lastVar.offset) + 8
let makeSymByArg isGhost offset arg =
(* let makeSymByArg offset arg =
match arg with
| CBoolVar name -> Some (name, {var = (CTypeBool, offset); ghost = isGhost; rdcnt = 0; wrcnt = 0})
| CIntVar name -> Some (name, {var = (CTypeInt, offset); ghost = isGhost; rdcnt = 0; wrcnt = 0})
| CBoolVar v ->
Some (v, {dtype = CTypeBool; offset = offset; rdcnt = 0; wrcnt = 0})
| CIntVar v ->
Some (v, {dtype = CTypeInt; offset = offset; rdcnt = 0; wrcnt = 0})
| _ -> None
let updateSymCnt written varh =
let updateSymCnt written varInfo =
if written then
{varh with wrcnt = varh.wrcnt + 1}
{varInfo with wrcnt = varInfo.wrcnt + 1}
else
{varh with rdcnt = varh.rdcnt + 1}
{varInfo with rdcnt = varInfo.rdcnt + 1}
let calcNextOffset lastVar =
match fst (lastVar.var) with
| CTypeBool -> snd (lastVar.var) + 1
| CTypeInt -> snd (lastVar.var) + 4
| _ -> snd (lastVar.var) + 8
let addSym calcNextOffset isGhost arg syms =
let addSym calcNextOffset arg syms =
let newOffs =
if Map.count syms > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) syms
let lastVar = Map.fold (fun s k v -> if (snd (v.var) > (snd (s.var))) then v else s) firstVar syms
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar syms
calcNextOffset lastVar
else
0
match makeSymByArg isGhost newOffs arg with
| Some (name, vh) -> Map.add name vh syms
match makeSymByArg newOffs arg with
| Some (vh) -> Map.add name vh syms // DESIGN ERROR: ghost variable should have the name???
| _ -> syms
let updateSym written arg syms =
let updateCnt wrc vx =
match vx with
| Some(v) -> Some( if wrc then {v with wrcnt = v.wrcnt + 1} else {v with rdcnt = v.rdcnt + 1})
| None -> None
|
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
-
+
|
| Some arg ->
addSym calcNextOffset isGhost arg syms
|> updateSym true arg
|> updateSymsByExpr exp
| _ -> syms
(newSyms, (List.append stmts [CAssign(varname, exp)]))
let addAssignWith calcNextOffset isGhost varname expConstructor arg1Name arg2Name prg =
let addAssignWith calcNextOffset expConstructor isGhost varname arg1Name arg2Name prg =
let syms, stmts = prg
let exp, syms = expConstructor arg1Name arg2Name syms
let wArg = match (get_expr_result_type exp) with
| CTypeBool -> Some (CBoolVar varname)
| CTypeInt -> Some (CIntVar varname)
| _ -> None
let newSyms = match wArg with
|
189
190
191
192
193
194
195
|
199
200
201
202
203
204
205
206
|
+
|
let newAddInt arg1 arg2 syms =
let isGhost = true
let a1 = (CIntVar arg1)
let a2 = (CIntVar arg2)
let syms = syms |> addSym calcNextOffset isGhost a1 |> addSym calcNextOffset isGhost a2
let exp = CAdd (a1, a2)
(exp, syms)
*)
|