V128 refactor SIMD to use submodule (#222)

* Refactor SIMD operators

* Common submodule for different SIMD lane shapes

* Tweak the submodule representation

* Rename modules, move module into Make

* MakeFloat takes a Float.S

* Better name for MakeFloat parameter

Author: ngzhian

interpreter/exec/eval_numeric.ml

@@ -127,15 +127,17 @@ struct
 
   let unop op =
     fun v -> match op with
-      | F32x4Abs -> to_value (SXX.f32x4_abs (of_value 1 v))
-      | F64x2Abs -> to_value (SXX.f64x2_abs (of_value 1 v))
+      | F32x4 Abs -> to_value (SXX.F32x4.abs (of_value 1 v))
+      | F64x2 Abs -> to_value (SXX.F64x2.abs (of_value 1 v))
+      | _ -> failwith "TODO v128 unimplemented unop"
 
   let binop op =
     let f = match op with
-      | F32x4Min -> SXX.f32x4_min
-      | F32x4Max -> SXX.f32x4_max
-      | F64x2Min -> SXX.f64x2_min
-      | F64x2Max -> SXX.f64x2_max
+      | F32x4 Min -> SXX.F32x4.min
+      | F32x4 Max -> SXX.F32x4.max
+      | F64x2 Min -> SXX.F64x2.min
+      | F64x2 Max -> SXX.F64x2.max
+      | _ -> failwith "TODO v128 unimplemented unop"
     in fun v1 v2 -> to_value (f (of_value 1 v1) (of_value 2 v2))
 
   (* FIXME *)
@@ -147,7 +149,7 @@ struct
   let extractop op v =
     match op with
     | F32x4ExtractLane imm ->
-      (F32Op.to_value (SXX.f32x4_extract_lane imm (of_value 1 v)))
+      (F32Op.to_value (SXX.F32x4.extract_lane imm (of_value 1 v)))
     | I32x4ExtractLane imm ->
       (I32Op.to_value (SXX.i32x4_extract_lane imm (of_value 1 v)))
 end

interpreter/exec/simd.ml

@@ -33,6 +33,18 @@ sig
   val of_f64x2 : F64.t list -> t
 end
 
+(* This signature defines the types and operations SIMD floats can expose. *)
+module type Float =
+sig
+  type t
+  type lane
+
+  val abs : t -> t
+  val min : t -> t -> t
+  val max : t -> t -> t
+  val extract_lane : int -> t -> lane
+end
+
 module type S =
 sig
   type t
@@ -45,15 +57,10 @@ sig
 
   val i32x4_extract_lane : int -> t -> I32.t
 
-  val f32x4_min : t -> t -> t
-  val f32x4_max : t -> t -> t
-  val f32x4_abs : t -> t
-  val f32x4_extract_lane : int -> t -> F32.t
-
-  val f64x2_min : t -> t -> t
-  val f64x2_max : t -> t -> t
-  val f64x2_abs : t -> t
-  val f64x2_extract_lane : int -> t -> F64.t
+  (* We need type t = t to ensure that all submodule types are S.t,
+   * then callers don't have to change *)
+  module F32x4 : Float with type t = t and type lane = F32.t
+  module F64x2 : Float with type t = t and type lane = F64.t
 end
 
 module Make (Rep : RepType) : S with type bits = Rep.t =
@@ -71,27 +78,29 @@ struct
 
   let i32x4_extract_lane i x = List.nth (to_i32x4 x) i
 
-  let to_f32x4 = Rep.to_f32x4
-  let of_f32x4 = Rep.of_f32x4
-  let f32x4_unop f x =
-    of_f32x4 (List.map f (to_f32x4 x))
-  let f32x4_binop f x y =
-    of_f32x4 (List.map2 f (to_f32x4 x) (to_f32x4 y))
-
-  let f32x4_extract_lane i x = List.nth (to_f32x4 x) i
-  let f32x4_min = f32x4_binop F32.min
-  let f32x4_max = f32x4_binop F32.max
-  let f32x4_abs x = f32x4_unop F32.abs x
-
-  let to_f64x2 = Rep.to_f64x2
-  let of_f64x2 = Rep.of_f64x2
-  let f64x2_unop f x =
-    of_f64x2 (List.map f (to_f64x2 x))
-  let f64x2_binop f x y =
-    of_f64x2 (List.map2 f (to_f64x2 x) (to_f64x2 y))
-
-  let f64x2_extract_lane i x = List.nth (to_f64x2 x) i
-  let f64x2_min = f64x2_binop F64.min
-  let f64x2_max = f64x2_binop F64.max
-  let f64x2_abs x = f64x2_unop F64.abs x
+  module MakeFloat (Float : Float.S) (Convert : sig
+      val to_shape : Rep.t -> Float.t list
+      val of_shape : Float.t list -> Rep.t
+    end) : Float with type t = Rep.t and type lane = Float.t =
+  struct
+    type t = Rep.t
+    type lane = Float.t
+    let unop f x = Convert.of_shape (List.map f (Convert.to_shape x))
+    let binop f x y = Convert.of_shape (List.map2 f (Convert.to_shape x) (Convert.to_shape y))
+    let abs = unop Float.abs
+    let min = binop Float.min
+    let max = binop Float.max
+    let extract_lane i s = List.nth (Convert.to_shape s) i
+  end
+
+  module F32x4 = MakeFloat (F32) (struct
+      let to_shape = Rep.to_f32x4
+      let of_shape = Rep.of_f32x4
+    end)
+
+  module F64x2 = MakeFloat (F64) (struct
+      let to_shape = Rep.to_f64x2
+      let of_shape = Rep.of_f64x2
+    end)
+
 end

interpreter/script/run.ml

@@ -376,16 +376,16 @@ let assert_result at got expect =
             let open Simd in
             match shape, v with
             | F32x4, V128 v ->
-                    let l0 = F32 (V128.f32x4_extract_lane 0 v) in
-                    let l1 = F32 (V128.f32x4_extract_lane 1 v) in
-                    let l2 = F32 (V128.f32x4_extract_lane 2 v) in
-                    let l3 = F32 (V128.f32x4_extract_lane 3 v) in
+                    let l0 = F32 (V128.F32x4.extract_lane 0 v) in
+                    let l1 = F32 (V128.F32x4.extract_lane 1 v) in
+                    let l2 = F32 (V128.F32x4.extract_lane 2 v) in
+                    let l3 = F32 (V128.F32x4.extract_lane 3 v) in
                       List.exists2 (fun v r ->
                           assert_num_pat at v r
                       ) [l0; l1; l2; l3]  vs
             | F64x2, V128 v ->
-                    let l0 = F64 (V128.f64x2_extract_lane 0 v) in
-                    let l1 = F64 (V128.f64x2_extract_lane 1 v) in
+                    let l0 = F64 (V128.F64x2.extract_lane 0 v) in
+                    let l1 = F64 (V128.F64x2.extract_lane 1 v) in
                       List.exists2 (fun v r ->
                           assert_num_pat at v r
                       ) [l0; l1]  vs

interpreter/syntax/ast.ml

@@ -47,8 +47,21 @@ end
 (* FIXME *)
 module SimdOp =
 struct
-  type unop = F32x4Abs | F64x2Abs
-  type binop = F32x4Min | F32x4Max | F64x2Min | F64x2Max
+  type iunop = TodoIunop
+  type ibinop = TodoIbinop
+  type funop = Abs
+  type fbinop = Min | Max
+
+  type ('i8x16, 'i16x8, 'i32x4, 'i64x2, 'f32x4, 'f64x2) v128op =
+    | I8x16 of 'i8x16
+    | I16x8 of 'i16x8
+    | I32x4 of 'i32x4
+    | I64x2 of 'i64x2
+    | F32x4 of 'f32x4
+    | F64x2 of 'f64x2
+
+  type unop = (iunop, iunop, iunop, iunop, funop, funop) v128op
+  type binop = (ibinop, ibinop, ibinop, ibinop, fbinop, fbinop) v128op
   type testop = TodoTestOp
   type relop = TodoRelOp
   type cvtop = TodoCvtOp

interpreter/syntax/operators.ml

@@ -207,10 +207,10 @@ let memory_grow = MemoryGrow
 let i32x4_extract_lane imm = ExtractLane (V128Op.I32x4ExtractLane imm)
 
 let f32x4_extract_lane imm = ExtractLane (V128Op.F32x4ExtractLane imm)
-let f32x4_min = Binary (V128 V128Op.F32x4Min)
-let f32x4_max = Binary (V128 V128Op.F32x4Max)
-let f32x4_abs = Unary (V128 V128Op.F32x4Abs)
+let f32x4_min = Binary (V128 (V128Op.F32x4 V128Op.Min))
+let f32x4_max = Binary (V128 (V128Op.F32x4 V128Op.Max))
+let f32x4_abs = Unary (V128 (V128Op.F32x4 V128Op.Abs))
 
-let f64x2_min = Binary (V128 V128Op.F64x2Min)
-let f64x2_max = Binary (V128 V128Op.F64x2Max)
-let f64x2_abs = Unary (V128 V128Op.F64x2Abs)
+let f64x2_min = Binary (V128 (V128Op.F64x2 V128Op.Min))
+let f64x2_max = Binary (V128 (V128Op.F64x2 V128Op.Max))
+let f64x2_abs = Unary (V128 (V128Op.F64x2 V128Op.Abs))