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
(*
This module originated as a copy of interpreter/syntax/operators.ml in the
reference implementation. It is pulled in by the strong cohesion between
the operators and the AST. Not having this source file locally would mean
that it got basically replicated into the customModuleDecode.ml file.

Base revision: WebAssembly/spec@a7a1856.

The changes are:
  * Manual selective support for bulk-memory operations `memory_copy` and `memory_fill` (WebAssembly/spec@7fa2f20).
  * Support for passive data segments (incl. `MemoryInit`).

The code is otherwise as untouched as possible, so that we can relatively
easily apply diffs from the original code (possibly manually).
*)

open Wasm.Source
open Types
open Values
open Ast


let i32_const n = Const (I32 n.it @@ n.at)
let i64_const n = Const (I64 n.it @@ n.at)
let f32_const n = Const (F32 n.it @@ n.at)
let f64_const n = Const (F64 n.it @@ n.at)

let unreachable = Unreachable
let nop = Nop
let drop = Drop
let select = Select
let block bt es = Block (bt, es)
let loop bt es = Loop (bt, es)
let if_ bt es1 es2 = If (bt, es1, es2)
let br x = Br x
let br_if x = BrIf x
let br_table xs x = BrTable (xs, x)

let return = Return
let call x = Call x
let call_indirect x = CallIndirect x

let local_get x = LocalGet x
let local_set x = LocalSet x
let local_tee x = LocalTee x
let global_get x = GlobalGet x
let global_set x = GlobalSet x

let i32_load align offset = Load {ty = I32Type; align; offset; sz = None}
let i64_load align offset = Load {ty = I64Type; align; offset; sz = None}
let f32_load align offset = Load {ty = F32Type; align; offset; sz = None}
let f64_load align offset = Load {ty = F64Type; align; offset; sz = None}
let i32_load8_s align offset =
  Load {ty = I32Type; align; offset; sz = Some (Pack8, SX)}
let i32_load8_u align offset =
  Load {ty = I32Type; align; offset; sz = Some (Pack8, ZX)}
let i32_load16_s align offset =
  Load {ty = I32Type; align; offset; sz = Some (Pack16, SX)}
let i32_load16_u align offset =
  Load {ty = I32Type; align; offset; sz = Some (Pack16, ZX)}
let i64_load8_s align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack8, SX)}
let i64_load8_u align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack8, ZX)}
let i64_load16_s align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack16, SX)}
let i64_load16_u align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack16, ZX)}
let i64_load32_s align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack32, SX)}
let i64_load32_u align offset =
  Load {ty = I64Type; align; offset; sz = Some (Pack32, ZX)}

let i32_store align offset = Store {ty = I32Type; align; offset; sz = None}
let i64_store align offset = Store {ty = I64Type; align; offset; sz = None}
let f32_store align offset = Store {ty = F32Type; align; offset; sz = None}
let f64_store align offset = Store {ty = F64Type; align; offset; sz = None}
let i32_store8 align offset =
  Store {ty = I32Type; align; offset; sz = Some Pack8}
let i32_store16 align offset =
  Store {ty = I32Type; align; offset; sz = Some Pack16}
let i64_store8 align offset =
  Store {ty = I64Type; align; offset; sz = Some Pack8}
let i64_store16 align offset =
  Store {ty = I64Type; align; offset; sz = Some Pack16}
let i64_store32 align offset =
  Store {ty = I64Type; align; offset; sz = Some Pack32}

let i32_clz = Unary (I32 I32Op.Clz)
let i32_ctz = Unary (I32 I32Op.Ctz)
let i32_popcnt = Unary (I32 I32Op.Popcnt)
let i64_clz = Unary (I64 I64Op.Clz)
let i64_ctz = Unary (I64 I64Op.Ctz)
let i64_popcnt = Unary (I64 I64Op.Popcnt)
let f32_neg = Unary (F32 F32Op.Neg)
let f32_abs = Unary (F32 F32Op.Abs)
let f32_sqrt = Unary (F32 F32Op.Sqrt)
let f32_ceil = Unary (F32 F32Op.Ceil)
let f32_floor = Unary (F32 F32Op.Floor)
let f32_trunc = Unary (F32 F32Op.Trunc)
let f32_nearest = Unary (F32 F32Op.Nearest)
let f64_neg = Unary (F64 F64Op.Neg)
let f64_abs = Unary (F64 F64Op.Abs)
let f64_sqrt = Unary (F64 F64Op.Sqrt)
let f64_ceil = Unary (F64 F64Op.Ceil)
let f64_floor = Unary (F64 F64Op.Floor)
let f64_trunc = Unary (F64 F64Op.Trunc)
let f64_nearest = Unary (F64 F64Op.Nearest)

let i32_add = Binary (I32 I32Op.Add)
let i32_sub = Binary (I32 I32Op.Sub)
let i32_mul = Binary (I32 I32Op.Mul)
let i32_div_s = Binary (I32 I32Op.DivS)
let i32_div_u = Binary (I32 I32Op.DivU)
let i32_rem_s = Binary (I32 I32Op.RemS)
let i32_rem_u = Binary (I32 I32Op.RemU)
let i32_and = Binary (I32 I32Op.And)
let i32_or = Binary (I32 I32Op.Or)
let i32_xor = Binary (I32 I32Op.Xor)
let i32_shl = Binary (I32 I32Op.Shl)
let i32_shr_s = Binary (I32 I32Op.ShrS)
let i32_shr_u = Binary (I32 I32Op.ShrU)
let i32_rotl = Binary (I32 I32Op.Rotl)
let i32_rotr = Binary (I32 I32Op.Rotr)
let i64_add = Binary (I64 I64Op.Add)
let i64_sub = Binary (I64 I64Op.Sub)
let i64_mul = Binary (I64 I64Op.Mul)
let i64_div_s = Binary (I64 I64Op.DivS)
let i64_div_u = Binary (I64 I64Op.DivU)
let i64_rem_s = Binary (I64 I64Op.RemS)
let i64_rem_u = Binary (I64 I64Op.RemU)
let i64_and = Binary (I64 I64Op.And)
let i64_or = Binary (I64 I64Op.Or)
let i64_xor = Binary (I64 I64Op.Xor)
let i64_shl = Binary (I64 I64Op.Shl)
let i64_shr_s = Binary (I64 I64Op.ShrS)
let i64_shr_u = Binary (I64 I64Op.ShrU)
let i64_rotl = Binary (I64 I64Op.Rotl)
let i64_rotr = Binary (I64 I64Op.Rotr)
let f32_add = Binary (F32 F32Op.Add)
let f32_sub = Binary (F32 F32Op.Sub)
let f32_mul = Binary (F32 F32Op.Mul)
let f32_div = Binary (F32 F32Op.Div)
let f32_min = Binary (F32 F32Op.Min)
let f32_max = Binary (F32 F32Op.Max)
let f32_copysign = Binary (F32 F32Op.CopySign)
let f64_add = Binary (F64 F64Op.Add)
let f64_sub = Binary (F64 F64Op.Sub)
let f64_mul = Binary (F64 F64Op.Mul)
let f64_div = Binary (F64 F64Op.Div)
let f64_min = Binary (F64 F64Op.Min)
let f64_max = Binary (F64 F64Op.Max)
let f64_copysign = Binary (F64 F64Op.CopySign)

let i32_eqz = Test (I32 I32Op.Eqz)
let i64_eqz = Test (I64 I64Op.Eqz)

let i32_eq = Compare (I32 I32Op.Eq)
let i32_ne = Compare (I32 I32Op.Ne)
let i32_lt_s = Compare (I32 I32Op.LtS)
let i32_lt_u = Compare (I32 I32Op.LtU)
let i32_le_s = Compare (I32 I32Op.LeS)
let i32_le_u = Compare (I32 I32Op.LeU)
let i32_gt_s = Compare (I32 I32Op.GtS)
let i32_gt_u = Compare (I32 I32Op.GtU)
let i32_ge_s = Compare (I32 I32Op.GeS)
let i32_ge_u = Compare (I32 I32Op.GeU)
let i64_eq = Compare (I64 I64Op.Eq)
let i64_ne = Compare (I64 I64Op.Ne)
let i64_lt_s = Compare (I64 I64Op.LtS)
let i64_lt_u = Compare (I64 I64Op.LtU)
let i64_le_s = Compare (I64 I64Op.LeS)
let i64_le_u = Compare (I64 I64Op.LeU)
let i64_gt_s = Compare (I64 I64Op.GtS)
let i64_gt_u = Compare (I64 I64Op.GtU)
let i64_ge_s = Compare (I64 I64Op.GeS)
let i64_ge_u = Compare (I64 I64Op.GeU)
let f32_eq = Compare (F32 F32Op.Eq)
let f32_ne = Compare (F32 F32Op.Ne)
let f32_lt = Compare (F32 F32Op.Lt)
let f32_le = Compare (F32 F32Op.Le)
let f32_gt = Compare (F32 F32Op.Gt)
let f32_ge = Compare (F32 F32Op.Ge)
let f64_eq = Compare (F64 F64Op.Eq)
let f64_ne = Compare (F64 F64Op.Ne)
let f64_lt = Compare (F64 F64Op.Lt)
let f64_le = Compare (F64 F64Op.Le)
let f64_gt = Compare (F64 F64Op.Gt)
let f64_ge = Compare (F64 F64Op.Ge)

let i32_extend8_s = Unary (I32 (I32Op.ExtendS Pack8))
let i32_extend16_s = Unary (I32 (I32Op.ExtendS Pack16))
let i64_extend8_s = Unary (I64 (I64Op.ExtendS Pack8))
let i64_extend16_s = Unary (I64 (I64Op.ExtendS Pack16))
let i64_extend32_s = Unary (I64 (I64Op.ExtendS Pack32))

let i32_wrap_i64 = Convert (I32 I32Op.WrapI64)
let i32_trunc_f32_s = Convert (I32 I32Op.TruncSF32)
let i32_trunc_f32_u = Convert (I32 I32Op.TruncUF32)
let i32_trunc_f64_s = Convert (I32 I32Op.TruncSF64)
let i32_trunc_f64_u = Convert (I32 I32Op.TruncUF64)
let i32_trunc_sat_f32_s = Convert (I32 I32Op.TruncSatSF32)
let i32_trunc_sat_f32_u = Convert (I32 I32Op.TruncSatUF32)
let i32_trunc_sat_f64_s = Convert (I32 I32Op.TruncSatSF64)
let i32_trunc_sat_f64_u = Convert (I32 I32Op.TruncSatUF64)
let i64_extend_i32_s = Convert (I64 I64Op.ExtendSI32)
let i64_extend_i32_u = Convert (I64 I64Op.ExtendUI32)
let i64_trunc_f32_s = Convert (I64 I64Op.TruncSF32)
let i64_trunc_f32_u = Convert (I64 I64Op.TruncUF32)
let i64_trunc_f64_s = Convert (I64 I64Op.TruncSF64)
let i64_trunc_f64_u = Convert (I64 I64Op.TruncUF64)
let f32_convert_i32_s = Convert (F32 F32Op.ConvertSI32)
let f32_convert_i32_u = Convert (F32 F32Op.ConvertUI32)
let f32_convert_i64_s = Convert (F32 F32Op.ConvertSI64)
let f32_convert_i64_u = Convert (F32 F32Op.ConvertUI64)
let i64_trunc_sat_f32_s = Convert (I64 I64Op.TruncSatSF32)
let i64_trunc_sat_f32_u = Convert (I64 I64Op.TruncSatUF32)
let i64_trunc_sat_f64_s = Convert (I64 I64Op.TruncSatSF64)
let i64_trunc_sat_f64_u = Convert (I64 I64Op.TruncSatUF64)
let f32_demote_f64 = Convert (F32 F32Op.DemoteF64)
let f64_convert_i32_s = Convert (F64 F64Op.ConvertSI32)
let f64_convert_i32_u = Convert (F64 F64Op.ConvertUI32)
let f64_convert_i64_s = Convert (F64 F64Op.ConvertSI64)
let f64_convert_i64_u = Convert (F64 F64Op.ConvertUI64)
let f64_promote_f32 = Convert (F64 F64Op.PromoteF32)
let i32_reinterpret_f32 = Convert (I32 I32Op.ReinterpretFloat)
let i64_reinterpret_f64 = Convert (I64 I64Op.ReinterpretFloat)
let f32_reinterpret_i32 = Convert (F32 F32Op.ReinterpretInt)
let f64_reinterpret_i64 = Convert (F64 F64Op.ReinterpretInt)

let memory_size = MemorySize
let memory_grow = MemoryGrow

(* Manual extension for specific bulk-memory operations *)
let memory_fill = MemoryFill
let memory_copy = MemoryCopy
(* End of manual extension *)
(* Manual extension for passive data segments *)
let memory_init x = MemoryInit x
(* End of manual extension *)