-
Notifications
You must be signed in to change notification settings - Fork 446
/
ast.ml
375 lines (324 loc) · 12.4 KB
/
ast.ml
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
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
(*
* Throughout the implementation we use consistent naming conventions for
* syntactic elements, associated with the types defined here and in a few
* other places:
*
* x : var
* v : value
* e : instr
* f : func
* m : module_
*
* t : value_type
* s : func_type
* c : context / config
*
* These conventions mostly follow standard practice in language semantics.
*)
open Types
type void = Lib.void
(* Operators *)
module IntOp =
struct
type unop = Clz | Ctz | Popcnt | ExtendS of pack_size
type binop = Add | Sub | Mul | DivS | DivU | RemS | RemU
| And | Or | Xor | Shl | ShrS | ShrU | Rotl | Rotr
type testop = Eqz
type relop = Eq | Ne | LtS | LtU | GtS | GtU | LeS | LeU | GeS | GeU
type cvtop = ExtendSI32 | ExtendUI32 | WrapI64
| TruncSF32 | TruncUF32 | TruncSF64 | TruncUF64
| TruncSatSF32 | TruncSatUF32 | TruncSatSF64 | TruncSatUF64
| ReinterpretFloat
end
module FloatOp =
struct
type unop = Neg | Abs | Ceil | Floor | Trunc | Nearest | Sqrt
type binop = Add | Sub | Mul | Div | Min | Max | CopySign
type testop = |
type relop = Eq | Ne | Lt | Gt | Le | Ge
type cvtop = ConvertSI32 | ConvertUI32 | ConvertSI64 | ConvertUI64
| PromoteF32 | DemoteF64
| ReinterpretInt
end
module I32Op = IntOp
module I64Op = IntOp
module F32Op = FloatOp
module F64Op = FloatOp
module V128Op =
struct
type itestop = AllTrue
type iunop = Abs | Neg | Popcnt
type funop = Abs | Neg | Sqrt | Ceil | Floor | Trunc | Nearest
type ibinop = Add | Sub | Mul | MinS | MinU | MaxS | MaxU | AvgrU
| AddSatS | AddSatU | SubSatS | SubSatU | DotS | Q15MulRSatS
| ExtMulLowS | ExtMulHighS | ExtMulLowU | ExtMulHighU
| Swizzle | Shuffle of int list | NarrowS | NarrowU
type fbinop = Add | Sub | Mul | Div | Min | Max | Pmin | Pmax
type irelop = Eq | Ne | LtS | LtU | LeS | LeU | GtS | GtU | GeS | GeU
type frelop = Eq | Ne | Lt | Le | Gt | Ge
type icvtop = ExtendLowS | ExtendLowU | ExtendHighS | ExtendHighU
| ExtAddPairwiseS | ExtAddPairwiseU
| TruncSatSF32x4 | TruncSatUF32x4
| TruncSatSZeroF64x2 | TruncSatUZeroF64x2
type fcvtop = DemoteZeroF64x2 | PromoteLowF32x4
| ConvertSI32x4 | ConvertUI32x4
type ishiftop = Shl | ShrS | ShrU
type ibitmaskop = Bitmask
type vtestop = AnyTrue
type vunop = Not
type vbinop = And | Or | Xor | AndNot
type vternop = Bitselect
type testop = (itestop, itestop, itestop, itestop, void, void) V128.laneop
type unop = (iunop, iunop, iunop, iunop, funop, funop) V128.laneop
type binop = (ibinop, ibinop, ibinop, ibinop, fbinop, fbinop) V128.laneop
type relop = (irelop, irelop, irelop, irelop, frelop, frelop) V128.laneop
type cvtop = (icvtop, icvtop, icvtop, icvtop, fcvtop, fcvtop) V128.laneop
type shiftop = (ishiftop, ishiftop, ishiftop, ishiftop, void, void) V128.laneop
type bitmaskop = (ibitmaskop, ibitmaskop, ibitmaskop, ibitmaskop, void, void) V128.laneop
type nsplatop = Splat
type 'a nextractop = Extract of int * 'a
type nreplaceop = Replace of int
type splatop = (nsplatop, nsplatop, nsplatop, nsplatop, nsplatop, nsplatop) V128.laneop
type extractop = (extension nextractop, extension nextractop, unit nextractop, unit nextractop, unit nextractop, unit nextractop) V128.laneop
type replaceop = (nreplaceop, nreplaceop, nreplaceop, nreplaceop, nreplaceop, nreplaceop) V128.laneop
end
type testop = (I32Op.testop, I64Op.testop, F32Op.testop, F64Op.testop) Values.op
type unop = (I32Op.unop, I64Op.unop, F32Op.unop, F64Op.unop) Values.op
type binop = (I32Op.binop, I64Op.binop, F32Op.binop, F64Op.binop) Values.op
type relop = (I32Op.relop, I64Op.relop, F32Op.relop, F64Op.relop) Values.op
type cvtop = (I32Op.cvtop, I64Op.cvtop, F32Op.cvtop, F64Op.cvtop) Values.op
type vec_testop = (V128Op.testop) Values.vecop
type vec_relop = (V128Op.relop) Values.vecop
type vec_unop = (V128Op.unop) Values.vecop
type vec_binop = (V128Op.binop) Values.vecop
type vec_cvtop = (V128Op.cvtop) Values.vecop
type vec_shiftop = (V128Op.shiftop) Values.vecop
type vec_bitmaskop = (V128Op.bitmaskop) Values.vecop
type vec_vtestop = (V128Op.vtestop) Values.vecop
type vec_vunop = (V128Op.vunop) Values.vecop
type vec_vbinop = (V128Op.vbinop) Values.vecop
type vec_vternop = (V128Op.vternop) Values.vecop
type vec_splatop = (V128Op.splatop) Values.vecop
type vec_extractop = (V128Op.extractop) Values.vecop
type vec_replaceop = (V128Op.replaceop) Values.vecop
type ('t, 'p) memop = {ty : 't; align : int; offset : int32; pack : 'p}
type loadop = (num_type, (pack_size * extension) option) memop
type storeop = (num_type, pack_size option) memop
type vec_loadop = (vec_type, (pack_size * vec_extension) option) memop
type vec_storeop = (vec_type, unit) memop
type vec_laneop = (vec_type, pack_size) memop * int
(* Expressions *)
type var = int32 Source.phrase
type num = Values.num Source.phrase
type vec = Values.vec Source.phrase
type name = Utf8.unicode
type block_type = VarBlockType of var | ValBlockType of value_type option
type instr = instr' Source.phrase
and instr' =
| Unreachable (* trap unconditionally *)
| Nop (* do nothing *)
| Drop (* forget a value *)
| Select of value_type list option (* branchless conditional *)
| Block of block_type * instr list (* execute in sequence *)
| Loop of block_type * instr list (* loop header *)
| If of block_type * instr list * instr list (* conditional *)
| Br of var (* break to n-th surrounding label *)
| BrIf of var (* conditional break *)
| BrTable of var list * var (* indexed break *)
| Return (* break from function body *)
| Call of var (* call function *)
| CallIndirect of var * var (* call function through table *)
| LocalGet of var (* read local variable *)
| LocalSet of var (* write local variable *)
| LocalTee of var (* write local variable and keep value *)
| GlobalGet of var (* read global variable *)
| GlobalSet of var (* write global variable *)
| TableGet of var (* read table element *)
| TableSet of var (* write table element *)
| TableSize of var (* size of table *)
| TableGrow of var (* grow table *)
| TableFill of var (* fill table range with value *)
| TableCopy of var * var (* copy table range *)
| TableInit of var * var (* initialize table range from segment *)
| ElemDrop of var (* drop passive element segment *)
| Load of loadop (* read memory at address *)
| Store of storeop (* write memory at address *)
| VecLoad of vec_loadop (* read memory at address *)
| VecStore of vec_storeop (* write memory at address *)
| VecLoadLane of vec_laneop (* read single lane at address *)
| VecStoreLane of vec_laneop (* write single lane to address *)
| MemorySize (* size of memory *)
| MemoryGrow (* grow memory *)
| MemoryFill (* fill memory range with value *)
| MemoryCopy (* copy memory ranges *)
| MemoryInit of var (* initialize memory range from segment *)
| DataDrop of var (* drop passive data segment *)
| RefNull of ref_type (* null reference *)
| RefFunc of var (* function reference *)
| RefIsNull (* null test *)
| Const of num (* constant *)
| Test of testop (* numeric test *)
| Compare of relop (* numeric comparison *)
| Unary of unop (* unary numeric operator *)
| Binary of binop (* binary numeric operator *)
| Convert of cvtop (* conversion *)
| VecConst of vec (* constant *)
| VecTest of vec_testop (* vector test *)
| VecCompare of vec_relop (* vector comparison *)
| VecUnary of vec_unop (* unary vector operator *)
| VecBinary of vec_binop (* binary vector operator *)
| VecConvert of vec_cvtop (* vector conversion *)
| VecShift of vec_shiftop (* vector shifts *)
| VecBitmask of vec_bitmaskop (* vector masking *)
| VecTestBits of vec_vtestop (* vector bit test *)
| VecUnaryBits of vec_vunop (* unary bit vector operator *)
| VecBinaryBits of vec_vbinop (* binary bit vector operator *)
| VecTernaryBits of vec_vternop (* ternary bit vector operator *)
| VecSplat of vec_splatop (* number to vector conversion *)
| VecExtract of vec_extractop (* extract lane from vector *)
| VecReplace of vec_replaceop (* replace lane in vector *)
(* Globals & Functions *)
type const = instr list Source.phrase
type global = global' Source.phrase
and global' =
{
gtype : global_type;
ginit : const;
}
type func = func' Source.phrase
and func' =
{
ftype : var;
locals : value_type list;
body : instr list;
}
(* Tables & Memories *)
type table = table' Source.phrase
and table' =
{
ttype : table_type;
}
type memory = memory' Source.phrase
and memory' =
{
mtype : memory_type;
}
type segment_mode = segment_mode' Source.phrase
and segment_mode' =
| Passive
| Active of {index : var; offset : const}
| Declarative
type elem_segment = elem_segment' Source.phrase
and elem_segment' =
{
etype : ref_type;
einit : const list;
emode : segment_mode;
}
type data_segment = data_segment' Source.phrase
and data_segment' =
{
dinit : string;
dmode : segment_mode;
}
(* Modules *)
type type_ = func_type Source.phrase
type export_desc = export_desc' Source.phrase
and export_desc' =
| FuncExport of var
| TableExport of var
| MemoryExport of var
| GlobalExport of var
type export = export' Source.phrase
and export' =
{
name : name;
edesc : export_desc;
}
type import_desc = import_desc' Source.phrase
and import_desc' =
| FuncImport of var
| TableImport of table_type
| MemoryImport of memory_type
| GlobalImport of global_type
type import = import' Source.phrase
and import' =
{
module_name : name;
item_name : name;
idesc : import_desc;
}
type start = start' Source.phrase
and start' =
{
sfunc : var;
}
type module_ = module_' Source.phrase
and module_' =
{
types : type_ list;
globals : global list;
tables : table list;
memories : memory list;
funcs : func list;
start : start option;
elems : elem_segment list;
datas : data_segment list;
imports : import list;
exports : export list;
}
(* Auxiliary functions *)
let empty_module =
{
types = [];
globals = [];
tables = [];
memories = [];
funcs = [];
start = None;
elems = [];
datas = [];
imports = [];
exports = [];
}
open Source
let func_type_for (m : module_) (x : var) : func_type =
(Lib.List32.nth m.it.types x.it).it
let import_type (m : module_) (im : import) : extern_type =
let {idesc; _} = im.it in
match idesc.it with
| FuncImport x -> ExternFuncType (func_type_for m x)
| TableImport t -> ExternTableType t
| MemoryImport t -> ExternMemoryType t
| GlobalImport t -> ExternGlobalType t
let export_type (m : module_) (ex : export) : extern_type =
let {edesc; _} = ex.it in
let its = List.map (import_type m) m.it.imports in
let open Lib.List32 in
match edesc.it with
| FuncExport x ->
let fts =
funcs its @ List.map (fun f -> func_type_for m f.it.ftype) m.it.funcs
in ExternFuncType (nth fts x.it)
| TableExport x ->
let tts = tables its @ List.map (fun t -> t.it.ttype) m.it.tables in
ExternTableType (nth tts x.it)
| MemoryExport x ->
let mts = memories its @ List.map (fun m -> m.it.mtype) m.it.memories in
ExternMemoryType (nth mts x.it)
| GlobalExport x ->
let gts = globals its @ List.map (fun g -> g.it.gtype) m.it.globals in
ExternGlobalType (nth gts x.it)
let string_of_name n =
let b = Buffer.create 16 in
let escape uc =
if uc < 0x20 || uc >= 0x7f then
Buffer.add_string b (Printf.sprintf "\\u{%02x}" uc)
else begin
let c = Char.chr uc in
if c = '\"' || c = '\\' then Buffer.add_char b '\\';
Buffer.add_char b c
end
in
List.iter escape n;
Buffer.contents b