open Types
open Values
module V128Op =
struct
open Ast.V128Op
open V128Vec
open V128
let testop (op : testop) =
let f = match op with
| I8x16 AllTrue -> V128.I8x16.all_true
| I16x8 AllTrue -> V128.I16x8.all_true
| I32x4 AllTrue -> V128.I32x4.all_true
| I64x2 AllTrue -> V128.I64x2.all_true
| _ -> .
in fun v -> f (of_vec 1 v)
let unop (op : unop) =
let f = match op with
| I8x16 Neg -> V128.I8x16.neg
| I8x16 Abs -> V128.I8x16.abs
| I8x16 Popcnt -> V128.I8x16.popcnt
| I16x8 Neg -> V128.I16x8.neg
| I16x8 Abs -> V128.I16x8.abs
| I32x4 Abs -> V128.I32x4.abs
| I32x4 Neg -> V128.I32x4.neg
| I64x2 Abs -> V128.I64x2.abs
| I64x2 Neg -> V128.I64x2.neg
| F32x4 Abs -> V128.F32x4.abs
| F32x4 Neg -> V128.F32x4.neg
| F32x4 Sqrt -> V128.F32x4.sqrt
| F32x4 Ceil -> V128.F32x4.ceil
| F32x4 Floor -> V128.F32x4.floor
| F32x4 Trunc -> V128.F32x4.trunc
| F32x4 Nearest -> V128.F32x4.nearest
| F64x2 Abs -> V128.F64x2.abs
| F64x2 Neg -> V128.F64x2.neg
| F64x2 Sqrt -> V128.F64x2.sqrt
| F64x2 Ceil -> V128.F64x2.ceil
| F64x2 Floor -> V128.F64x2.floor
| F64x2 Trunc -> V128.F64x2.trunc
| F64x2 Nearest -> V128.F64x2.nearest
| _ -> assert false
in fun v -> to_vec (f (of_vec 1 v))
let binop (op : binop) =
let f = match op with
| I8x16 Swizzle -> V128.V8x16.swizzle
| I8x16 (Shuffle is) -> fun a b -> V128.V8x16.shuffle a b is
| I8x16 NarrowS -> V128.I8x16_convert.narrow_s
| I8x16 NarrowU -> V128.I8x16_convert.narrow_u
| I8x16 Add -> V128.I8x16.add
| I8x16 AddSatS -> V128.I8x16.add_sat_s
| I8x16 AddSatU -> V128.I8x16.add_sat_u
| I8x16 Sub -> V128.I8x16.sub
| I8x16 SubSatS -> V128.I8x16.sub_sat_s
| I8x16 SubSatU -> V128.I8x16.sub_sat_u
| I8x16 MinS -> V128.I8x16.min_s
| I8x16 MinU -> V128.I8x16.min_u
| I8x16 MaxS -> V128.I8x16.max_s
| I8x16 MaxU -> V128.I8x16.max_u
| I8x16 AvgrU -> V128.I8x16.avgr_u
| I16x8 NarrowS -> V128.I16x8_convert.narrow_s
| I16x8 NarrowU -> V128.I16x8_convert.narrow_u
| I16x8 Add -> V128.I16x8.add
| I16x8 AddSatS -> V128.I16x8.add_sat_s
| I16x8 AddSatU -> V128.I16x8.add_sat_u
| I16x8 Sub -> V128.I16x8.sub
| I16x8 SubSatS -> V128.I16x8.sub_sat_s
| I16x8 SubSatU -> V128.I16x8.sub_sat_u
| I16x8 Mul -> V128.I16x8.mul
| I16x8 MinS -> V128.I16x8.min_s
| I16x8 MinU -> V128.I16x8.min_u
| I16x8 MaxS -> V128.I16x8.max_s
| I16x8 MaxU -> V128.I16x8.max_u
| I16x8 AvgrU -> V128.I16x8.avgr_u
| I16x8 ExtMulLowS -> V128.I16x8_convert.extmul_low_s
| I16x8 ExtMulHighS -> V128.I16x8_convert.extmul_high_s
| I16x8 ExtMulLowU -> V128.I16x8_convert.extmul_low_u
| I16x8 ExtMulHighU -> V128.I16x8_convert.extmul_high_u
| I16x8 Q15MulRSatS -> V128.I16x8.q15mulr_sat_s
| I32x4 Add -> V128.I32x4.add
| I32x4 Sub -> V128.I32x4.sub
| I32x4 MinS -> V128.I32x4.min_s
| I32x4 MinU -> V128.I32x4.min_u
| I32x4 MaxS -> V128.I32x4.max_s
| I32x4 MaxU -> V128.I32x4.max_u
| I32x4 Mul -> V128.I32x4.mul
| I32x4 ExtMulLowS -> V128.I32x4_convert.extmul_low_s
| I32x4 ExtMulHighS -> V128.I32x4_convert.extmul_high_s
| I32x4 ExtMulLowU -> V128.I32x4_convert.extmul_low_u
| I32x4 ExtMulHighU -> V128.I32x4_convert.extmul_high_u
| I64x2 Add -> V128.I64x2.add
| I64x2 Sub -> V128.I64x2.sub
| I64x2 Mul -> V128.I64x2.mul
| I32x4 DotS -> V128.I32x4_convert.dot_s
| I64x2 ExtMulLowS -> V128.I64x2_convert.extmul_low_s
| I64x2 ExtMulHighS -> V128.I64x2_convert.extmul_high_s
| I64x2 ExtMulLowU -> V128.I64x2_convert.extmul_low_u
| I64x2 ExtMulHighU -> V128.I64x2_convert.extmul_high_u
| F32x4 Add -> V128.F32x4.add
| F32x4 Sub -> V128.F32x4.sub
| F32x4 Mul -> V128.F32x4.mul
| F32x4 Div -> V128.F32x4.div
| F32x4 Min -> V128.F32x4.min
| F32x4 Max -> V128.F32x4.max
| F32x4 Pmin -> V128.F32x4.pmin
| F32x4 Pmax -> V128.F32x4.pmax
| F64x2 Add -> V128.F64x2.add
| F64x2 Sub -> V128.F64x2.sub
| F64x2 Mul -> V128.F64x2.mul
| F64x2 Div -> V128.F64x2.div
| F64x2 Min -> V128.F64x2.min
| F64x2 Max -> V128.F64x2.max
| F64x2 Pmin -> V128.F64x2.pmin
| F64x2 Pmax -> V128.F64x2.pmax
| _ -> assert false
in fun v1 v2 -> to_vec (f (of_vec 1 v1) (of_vec 2 v2))
let relop (op : relop) =
let f = match op with
| I8x16 Eq -> V128.I8x16.eq
| I8x16 Ne -> V128.I8x16.ne
| I8x16 LtS -> V128.I8x16.lt_s
| I8x16 LtU -> V128.I8x16.lt_u
| I8x16 LeS -> V128.I8x16.le_s
| I8x16 LeU -> V128.I8x16.le_u
| I8x16 GtS -> V128.I8x16.gt_s
| I8x16 GtU -> V128.I8x16.gt_u
| I8x16 GeS -> V128.I8x16.ge_s
| I8x16 GeU -> V128.I8x16.ge_u
| I16x8 Eq -> V128.I16x8.eq
| I16x8 Ne -> V128.I16x8.ne
| I16x8 LtS -> V128.I16x8.lt_s
| I16x8 LtU -> V128.I16x8.lt_u
| I16x8 LeS -> V128.I16x8.le_s
| I16x8 LeU -> V128.I16x8.le_u
| I16x8 GtS -> V128.I16x8.gt_s
| I16x8 GtU -> V128.I16x8.gt_u
| I16x8 GeS -> V128.I16x8.ge_s
| I16x8 GeU -> V128.I16x8.ge_u
| I32x4 Eq -> V128.I32x4.eq
| I32x4 Ne -> V128.I32x4.ne
| I32x4 LtS -> V128.I32x4.lt_s
| I32x4 LtU -> V128.I32x4.lt_u
| I32x4 LeS -> V128.I32x4.le_s
| I32x4 LeU -> V128.I32x4.le_u
| I32x4 GtS -> V128.I32x4.gt_s
| I32x4 GtU -> V128.I32x4.gt_u
| I32x4 GeS -> V128.I32x4.ge_s
| I32x4 GeU -> V128.I32x4.ge_u
| I64x2 Eq -> V128.I64x2.eq
| I64x2 Ne -> V128.I64x2.ne
| I64x2 LtS -> V128.I64x2.lt_s
| I64x2 LeS -> V128.I64x2.le_s
| I64x2 GtS -> V128.I64x2.gt_s
| I64x2 GeS -> V128.I64x2.ge_s
| F32x4 Eq -> V128.F32x4.eq
| F32x4 Ne -> V128.F32x4.ne
| F32x4 Lt -> V128.F32x4.lt
| F32x4 Le -> V128.F32x4.le
| F32x4 Gt -> V128.F32x4.gt
| F32x4 Ge -> V128.F32x4.ge
| F64x2 Eq -> V128.F64x2.eq
| F64x2 Ne -> V128.F64x2.ne
| F64x2 Lt -> V128.F64x2.lt
| F64x2 Le -> V128.F64x2.le
| F64x2 Gt -> V128.F64x2.gt
| F64x2 Ge -> V128.F64x2.ge
| _ -> assert false
in fun v1 v2 -> to_vec (f (of_vec 1 v1) (of_vec 2 v2))
let cvtop (op : cvtop) =
let f = match op with
| I16x8 ExtendLowS -> V128.I16x8_convert.extend_low_s
| I16x8 ExtendHighS -> V128.I16x8_convert.extend_high_s
| I16x8 ExtendLowU -> V128.I16x8_convert.extend_low_u
| I16x8 ExtendHighU -> V128.I16x8_convert.extend_high_u
| I16x8 ExtAddPairwiseS -> V128.I16x8_convert.extadd_pairwise_s
| I16x8 ExtAddPairwiseU -> V128.I16x8_convert.extadd_pairwise_u
| I32x4 ExtendLowS -> V128.I32x4_convert.extend_low_s
| I32x4 ExtendHighS -> V128.I32x4_convert.extend_high_s
| I32x4 ExtendLowU -> V128.I32x4_convert.extend_low_u
| I32x4 ExtendHighU -> V128.I32x4_convert.extend_high_u
| I32x4 TruncSatSF32x4 -> V128.I32x4_convert.trunc_sat_f32x4_s
| I32x4 TruncSatUF32x4 -> V128.I32x4_convert.trunc_sat_f32x4_u
| I32x4 TruncSatSZeroF64x2 -> V128.I32x4_convert.trunc_sat_f64x2_s_zero
| I32x4 TruncSatUZeroF64x2 -> V128.I32x4_convert.trunc_sat_f64x2_u_zero
| I32x4 ExtAddPairwiseS -> V128.I32x4_convert.extadd_pairwise_s
| I32x4 ExtAddPairwiseU -> V128.I32x4_convert.extadd_pairwise_u
| I64x2 ExtendLowS -> V128.I64x2_convert.extend_low_s
| I64x2 ExtendHighS -> V128.I64x2_convert.extend_high_s
| I64x2 ExtendLowU -> V128.I64x2_convert.extend_low_u
| I64x2 ExtendHighU -> V128.I64x2_convert.extend_high_u
| F32x4 ConvertSI32x4 -> V128.F32x4_convert.convert_i32x4_s
| F32x4 ConvertUI32x4 -> V128.F32x4_convert.convert_i32x4_u
| F32x4 DemoteZeroF64x2 -> V128.F32x4_convert.demote_f64x2_zero
| F64x2 PromoteLowF32x4 -> V128.F64x2_convert.promote_low_f32x4
| F64x2 ConvertSI32x4 -> V128.F64x2_convert.convert_i32x4_s
| F64x2 ConvertUI32x4 -> V128.F64x2_convert.convert_i32x4_u
| _ -> assert false
in fun v -> to_vec (f (of_vec 1 v))
let shiftop (op : shiftop) =
let f = match op with
| I8x16 Shl -> V128.I8x16.shl
| I8x16 ShrS -> V128.I8x16.shr_s
| I8x16 ShrU -> V128.I8x16.shr_u
| I16x8 Shl -> V128.I16x8.shl
| I16x8 ShrS -> V128.I16x8.shr_s
| I16x8 ShrU -> V128.I16x8.shr_u
| I32x4 Shl -> V128.I32x4.shl
| I32x4 ShrS -> V128.I32x4.shr_s
| I32x4 ShrU -> V128.I32x4.shr_u
| I64x2 Shl -> V128.I64x2.shl
| I64x2 ShrS -> V128.I64x2.shr_s
| I64x2 ShrU -> V128.I64x2.shr_u
| _ -> .
in fun v n -> to_vec (f (of_vec 1 v) (I32Num.of_num 2 n))
let bitmaskop (op : bitmaskop) v =
let f = match op with
| I8x16 Bitmask -> V128.I8x16.bitmask
| I16x8 Bitmask -> V128.I16x8.bitmask
| I32x4 Bitmask -> V128.I32x4.bitmask
| I64x2 Bitmask -> V128.I64x2.bitmask
| _ -> .
in I32 (f (of_vec 1 v))
let vtestop (op : vtestop) =
let f = match op with
| AnyTrue -> V128.I8x16.any_true
in fun v -> f (of_vec 1 v)
let vunop (op : vunop) =
let f = match op with
| Not -> V128.V1x128.lognot
in fun v -> to_vec (f (of_vec 1 v))
let vbinop (op : vbinop) =
let f = match op with
| And -> V128.V1x128.and_
| Or -> V128.V1x128.or_
| Xor -> V128.V1x128.xor
| AndNot -> V128.V1x128.andnot
in fun v1 v2 -> to_vec (f (of_vec 1 v1) (of_vec 2 v2))
let vternop (op : vternop) =
let f = match op with
| Bitselect -> V128.V1x128.bitselect
in fun v1 v2 v3 -> to_vec (f (of_vec 1 v1) (of_vec 2 v2) (of_vec 3 v3))
end
module V128CvtOp =
struct
open Ast.V128Op
open V128Vec
open V128
let splatop (op : splatop) v =
let i =
match op with
| I8x16 Splat -> V128.I8x16.splat (I32Num.of_num 1 v)
| I16x8 Splat -> V128.I16x8.splat (I32Num.of_num 1 v)
| I32x4 Splat -> V128.I32x4.splat (I32Num.of_num 1 v)
| I64x2 Splat -> V128.I64x2.splat (I64Num.of_num 1 v)
| F32x4 Splat -> V128.F32x4.splat (F32Num.of_num 1 v)
| F64x2 Splat -> V128.F64x2.splat (F64Num.of_num 1 v)
in to_vec i
let extractop (op : extractop) v =
let v128 = of_vec 1 v in
match op with
| I8x16 (Extract (i, SX)) -> I32 (V128.I8x16.extract_lane_s i v128)
| I8x16 (Extract (i, ZX)) -> I32 (V128.I8x16.extract_lane_u i v128)
| I16x8 (Extract (i, SX)) -> I32 (V128.I16x8.extract_lane_s i v128)
| I16x8 (Extract (i, ZX)) -> I32 (V128.I16x8.extract_lane_u i v128)
| I32x4 (Extract (i, ())) -> I32 (V128.I32x4.extract_lane_u i v128)
| I64x2 (Extract (i, ())) -> I64 (V128.I64x2.extract_lane_u i v128)
| F32x4 (Extract (i, ())) -> F32 (V128.F32x4.extract_lane i v128)
| F64x2 (Extract (i, ())) -> F64 (V128.F64x2.extract_lane i v128)
let replaceop (op : replaceop) v (n : Values.num) =
let v128 = of_vec 1 v in
let v128' = match op with
| I8x16 (Replace i) -> V128.I8x16.replace_lane i v128 (I32Num.of_num 1 n)
| I16x8 (Replace i) -> V128.I16x8.replace_lane i v128 (I32Num.of_num 1 n)
| I32x4 (Replace i) -> V128.I32x4.replace_lane i v128 (I32Num.of_num 1 n)
| I64x2 (Replace i) -> V128.I64x2.replace_lane i v128 (I64Num.of_num 1 n)
| F32x4 (Replace i) -> V128.F32x4.replace_lane i v128 (F32Num.of_num 1 n)
| F64x2 (Replace i) -> V128.F64x2.replace_lane i v128 (F64Num.of_num 1 n)
in to_vec v128'
end
let op v128 = function
| V128 x -> v128 x
let eval_testop = op V128Op.testop
let eval_unop = op V128Op.unop
let eval_binop = op V128Op.binop
let eval_relop = op V128Op.relop
let eval_cvtop = op V128Op.cvtop
let eval_shiftop = op V128Op.shiftop
let eval_bitmaskop = op V128Op.bitmaskop
let eval_vtestop = op V128Op.vtestop
let eval_vunop = op V128Op.vunop
let eval_vbinop = op V128Op.vbinop
let eval_vternop = op V128Op.vternop
let eval_splatop = op V128CvtOp.splatop
let eval_extractop = op V128CvtOp.extractop
let eval_replaceop = op V128CvtOp.replaceop