From 0798014fe75ead1fe5fc74e97f0f2baf065e2dd2 Mon Sep 17 00:00:00 2001
From: George Kuan <george.kuan@intel.com>
Date: Tue, 13 Oct 2015 19:18:02 -0700
Subject: [PATCH] refactor of int ops (i32/i64) into functor

---
 ml-proto/spec/i32.ml  | 124 +-------------------------
 ml-proto/spec/i32.mli |  39 ---------
 ml-proto/spec/i64.ml  | 124 +-------------------------
 ml-proto/spec/i64.mli |  39 ---------
 ml-proto/spec/int.ml  | 197 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 205 insertions(+), 318 deletions(-)
 delete mode 100644 ml-proto/spec/i32.mli
 delete mode 100644 ml-proto/spec/i64.mli
 create mode 100644 ml-proto/spec/int.ml

diff --git a/ml-proto/spec/i32.ml b/ml-proto/spec/i32.ml
index 20896e4eda..9d408fd8e3 100644
--- a/ml-proto/spec/i32.ml
+++ b/ml-proto/spec/i32.ml
@@ -1,122 +1,6 @@
 (* WebAssembly-compatible i32 implementation *)
 
-(*
- * Unsigned comparison in terms of signed comparison.
- *)
-let cmp_u x op y =
-  op (Int32.add x Int32.min_int) (Int32.add y Int32.min_int)
-
-(*
- * Unsigned division and remainder in terms of signed division; algorithm from
- * Hacker's Delight, Second Edition, by Henry S. Warren, Jr., section 9-3
- * "Unsigned Short Division from Signed Division".
- *)
-let divrem_u n d =
-  if d = Int32.zero then raise Numerics.IntegerDivideByZero else
-  let t = Int32.shift_right d (32 - 1) in
-  let n' = Int32.logand n (Int32.lognot t) in
-  let q = Int32.shift_left (Int32.div (Int32.shift_right_logical n' 1) d) 1 in
-  let r = Int32.sub n (Int32.mul q d) in
-  if cmp_u r (<) d then
-    q, r
-  else
-    Int32.add q Int32.one, Int32.sub r d
-
-type t = int32
-
-let of_int32 x = x
-let to_int32 x = x
-
-let zero = Int32.zero
-
-let add = Int32.add
-let sub = Int32.sub
-let mul = Int32.mul
-
-let div_s x y =
-  if y = Int32.zero then
-    raise Numerics.IntegerDivideByZero
-  else if x = Int32.min_int && y = Int32.minus_one then
-    raise Numerics.IntegerOverflow
-  else
-    Int32.div x y
-
-let div_u x y =
-  let q, r = divrem_u x y in q
-
-let rem_s x y =
-  if y = Int32.zero then
-    raise Numerics.IntegerDivideByZero
-  else
-    Int32.rem x y
-
-let rem_u x y =
-  let q, r = divrem_u x y in r
-
-let and_ = Int32.logand
-let or_ = Int32.logor
-let xor = Int32.logxor
-
-(* WebAssembly shift counts are unmasked and unsigned *)
-let shift_ok n = n >= Int32.zero && n < Int32.of_int 32
-
-let shl x y =
-  if shift_ok y then
-    Int32.shift_left x (Int32.to_int y)
-  else
-    Int32.zero
-
-let shr_s x y =
-  Int32.shift_right x (if shift_ok y then Int32.to_int y else 32 - 1)
-
-let shr_u x y =
-  if shift_ok y then
-    Int32.shift_right_logical x (Int32.to_int y)
-  else
-    Int32.zero
-
-let clz x =
-  Int32.of_int
-  (let rec loop acc n =
-    if n = Int32.zero then
-      32
-    else if and_ n (Int32.shift_left Int32.one (32 - 1)) <> Int32.zero then
-      acc
-    else
-      loop (1 + acc) (Int32.shift_left n 1)
-  in loop 0 x)
-
-let ctz x =
-  Int32.of_int
-  (let rec loop acc n =
-    if n = Int32.zero then
-      32
-    else if and_ n Int32.one = Int32.one then
-      acc
-    else
-      loop (1 + acc) (Int32.shift_right_logical n 1)
-  in loop 0 x)
-
-let popcnt x =
-  Int32.of_int
-  (let rec loop acc i n =
-    if n = Int32.zero then
-      acc
-    else
-      let acc' = if and_ n Int32.one = Int32.one then acc + 1 else acc in
-      loop acc' (i - 1) (Int32.shift_right_logical n 1)
-  in loop 0 32 x)
-
-let eq x y = x = y
-let ne x y = x <> y
-let lt_s x y = x < y
-let lt_u x y = cmp_u x (<) y
-let le_s x y = x <= y
-let le_u x y = cmp_u x (<=) y
-let gt_s x y = x > y
-let gt_u x y = cmp_u x (>) y
-let ge_s x y = x >= y
-let ge_u x y = cmp_u x (>=) y
-
-let of_string = Int32.of_string
-let to_string = Int32.to_string
+include Int.Make(struct
+                   include Int32
+                   let bitwidth = 32
+                 end)
diff --git a/ml-proto/spec/i32.mli b/ml-proto/spec/i32.mli
deleted file mode 100644
index b2d44abce2..0000000000
--- a/ml-proto/spec/i32.mli
+++ /dev/null
@@ -1,39 +0,0 @@
-(* WebAssembly-compatible i32 implementation *)
-
-(* TODO Make this type opaque? *)
-type t = int32
-
-val of_int32 : int32 -> t
-val to_int32 : t -> int32
-
-val zero : t
-
-val add : t -> t -> t
-val sub : t -> t -> t
-val mul : t -> t -> t
-val div_s : t -> t -> t
-val div_u : t -> t -> t
-val rem_s : t -> t -> t
-val rem_u : t -> t -> t
-val and_ : t -> t -> t
-val or_ : t -> t -> t
-val xor : t -> t -> t
-val shl : t -> t -> t
-val shr_s : t -> t -> t
-val shr_u : t -> t -> t
-val clz : t -> t
-val ctz : t -> t
-val popcnt : t -> t
-val eq : t -> t -> bool
-val ne : t -> t -> bool
-val lt_s : t -> t -> bool
-val lt_u : t -> t -> bool
-val le_s : t -> t -> bool
-val le_u : t -> t -> bool
-val gt_s : t -> t -> bool
-val gt_u : t -> t -> bool
-val ge_s : t -> t -> bool
-val ge_u : t -> t -> bool
-
-val of_string : string -> t
-val to_string : t -> string
diff --git a/ml-proto/spec/i64.ml b/ml-proto/spec/i64.ml
index 7d8333e4e2..4597a54346 100644
--- a/ml-proto/spec/i64.ml
+++ b/ml-proto/spec/i64.ml
@@ -1,122 +1,6 @@
 (* WebAssembly-compatible i64 implementation *)
 
-(*
- * Unsigned comparison in terms of signed comparison.
- *)
-let cmp_u x op y =
-  op (Int64.add x Int64.min_int) (Int64.add y Int64.min_int)
-
-(*
- * Unsigned division and remainder in terms of signed division; algorithm from
- * Hacker's Delight, Second Edition, by Henry S. Warren, Jr., section 9-3
- * "Unsigned Short Division from Signed Division".
- *)
-let divrem_u n d =
-  if d = Int64.zero then raise Numerics.IntegerDivideByZero else
-  let t = Int64.shift_right d (64 - 1) in
-  let n' = Int64.logand n (Int64.lognot t) in
-  let q = Int64.shift_left (Int64.div (Int64.shift_right_logical n' 1) d) 1 in
-  let r = Int64.sub n (Int64.mul q d) in
-  if cmp_u r (<) d then
-    q, r
-  else
-    Int64.add q Int64.one, Int64.sub r d
-
-type t = int64
-
-let of_int64 x = x
-let to_int64 x = x
-
-let zero = Int64.zero
-
-let add = Int64.add
-let sub = Int64.sub
-let mul = Int64.mul
-
-let div_s x y =
-  if y = Int64.zero then
-    raise Numerics.IntegerDivideByZero
-  else if x = Int64.min_int && y = Int64.minus_one then
-    raise Numerics.IntegerOverflow
-  else
-    Int64.div x y
-
-let div_u x y =
-  let q, r = divrem_u x y in q
-
-let rem_s x y =
-  if y = Int64.zero then
-    raise Numerics.IntegerDivideByZero
-  else
-    Int64.rem x y
-
-let rem_u x y =
-  let q, r = divrem_u x y in r
-
-let and_ = Int64.logand
-let or_ = Int64.logor
-let xor = Int64.logxor
-
-(* WebAssembly shift counts are unmasked and unsigned *)
-let shift_ok n = n >= Int64.zero && n < Int64.of_int 64
-
-let shl x y =
-  if shift_ok y then
-    Int64.shift_left x (Int64.to_int y)
-  else
-    Int64.zero
-
-let shr_s x y =
-  Int64.shift_right x (if shift_ok y then Int64.to_int y else 64 - 1)
-
-let shr_u x y =
-  if shift_ok y then
-    Int64.shift_right_logical x (Int64.to_int y)
-  else
-    Int64.zero
-
-let clz x =
-  Int64.of_int
-  (let rec loop acc n =
-    if n = Int64.zero then
-      64
-    else if and_ n (Int64.shift_left Int64.one (64 - 1)) <> Int64.zero then
-      acc
-    else
-      loop (1 + acc) (Int64.shift_left n 1)
-  in loop 0 x)
-
-let ctz x =
-  Int64.of_int
-  (let rec loop acc n =
-    if n = Int64.zero then
-      64
-    else if and_ n Int64.one = Int64.one then
-      acc
-    else
-      loop (1 + acc) (Int64.shift_right_logical n 1)
-  in loop 0 x)
-
-let popcnt x =
-  Int64.of_int
-  (let rec loop acc i n =
-    if n = Int64.zero then
-      acc
-    else
-      let acc' = if and_ n Int64.one = Int64.one then acc + 1 else acc in
-      loop acc' (i - 1) (Int64.shift_right_logical n 1)
-  in loop 0 64 x)
-
-let eq x y = x = y
-let ne x y = x <> y
-let lt_s x y = x < y
-let lt_u x y = cmp_u x (<) y
-let le_s x y = x <= y
-let le_u x y = cmp_u x (<=) y
-let gt_s x y = x > y
-let gt_u x y = cmp_u x (>) y
-let ge_s x y = x >= y
-let ge_u x y = cmp_u x (>=) y
-
-let of_string = Int64.of_string
-let to_string = Int64.to_string
+include Int.Make(struct
+                   include Int64
+                   let bitwidth = 64
+                 end)
diff --git a/ml-proto/spec/i64.mli b/ml-proto/spec/i64.mli
deleted file mode 100644
index 7643ef4650..0000000000
--- a/ml-proto/spec/i64.mli
+++ /dev/null
@@ -1,39 +0,0 @@
-(* WebAssembly-compatible i64 implementation *)
-
-(* TODO Make this type opaque? *)
-type t = int64
-
-val of_int64 : int64 -> t
-val to_int64 : t -> int64
-
-val zero : t
-
-val add : t -> t -> t
-val sub : t -> t -> t
-val mul : t -> t -> t
-val div_s : t -> t -> t
-val div_u : t -> t -> t
-val rem_s : t -> t -> t
-val rem_u : t -> t -> t
-val and_ : t -> t -> t
-val or_ : t -> t -> t
-val xor : t -> t -> t
-val shl : t -> t -> t
-val shr_s : t -> t -> t
-val shr_u : t -> t -> t
-val clz : t -> t
-val ctz : t -> t
-val popcnt : t -> t
-val eq : t -> t -> bool
-val ne : t -> t -> bool
-val lt_s : t -> t -> bool
-val lt_u : t -> t -> bool
-val le_s : t -> t -> bool
-val le_u : t -> t -> bool
-val gt_s : t -> t -> bool
-val gt_u : t -> t -> bool
-val ge_s : t -> t -> bool
-val ge_u : t -> t -> bool
-
-val of_string : string -> t
-val to_string : t -> string
diff --git a/ml-proto/spec/int.ml b/ml-proto/spec/int.ml
new file mode 100644
index 0000000000..3618d48f3f
--- /dev/null
+++ b/ml-proto/spec/int.ml
@@ -0,0 +1,197 @@
+(* WebAssembly-compatible int operations implementation *)
+
+module type RepresentationType =
+sig
+  type t  
+  val add : t -> t -> t
+  val min_int : t
+  val zero : t
+  val one : t
+  val minus_one : t                        
+  val shift_left : t -> int -> t
+  val shift_right : t -> int -> t
+  val logand : t -> t -> t
+  val lognot : t -> t
+  val logor : t -> t -> t
+  val logxor : t -> t -> t                    
+  val sub : t -> t -> t
+  val div : t -> t -> t
+  val mul : t -> t -> t
+  val rem : t -> t -> t                        
+  val shift_right_logical : t -> int -> t
+  val of_int : int -> t
+  val to_int : t -> int                        
+  val of_string : string -> t
+  val to_string : t -> string
+
+  val bitwidth : int 
+end
+
+module type S =
+sig
+  type t
+  type bits 
+
+  val of_bits : bits -> t
+  val to_bits : t -> bits
+
+  val zero : t
+
+  val add : t -> t -> t
+  val sub : t -> t -> t
+  val mul : t -> t -> t
+  val div_s : t -> t -> t
+  val div_u : t -> t -> t
+  val rem_s : t -> t -> t
+  val rem_u : t -> t -> t
+  val and_ : t -> t -> t
+  val or_ : t -> t -> t
+  val xor : t -> t -> t
+  val shl : t -> t -> t
+  val shr_s : t -> t -> t
+  val shr_u : t -> t -> t
+  val clz : t -> t
+  val ctz : t -> t
+  val popcnt : t -> t
+  val eq : t -> t -> bool
+  val ne : t -> t -> bool
+  val lt_s : t -> t -> bool
+  val lt_u : t -> t -> bool
+  val le_s : t -> t -> bool
+  val le_u : t -> t -> bool
+  val gt_s : t -> t -> bool
+  val gt_u : t -> t -> bool
+  val ge_s : t -> t -> bool
+  val ge_u : t -> t -> bool
+
+  val of_int : int -> t
+  val of_string : string -> t
+  val to_string : t -> string
+end
+    
+module Make(Rep : RepresentationType) : S with type bits = Rep.t and type t = Rep.t =
+struct
+  (*
+   * Unsigned comparison in terms of signed comparison.
+   *)
+  let cmp_u x op y =
+    op (Rep.add x Rep.min_int) (Rep.add y Rep.min_int)
+
+  (*
+   * Unsigned division and remainder in terms of signed division; algorithm from
+   * Hacker's Delight, Second Edition, by Henry S. Warren, Jr., section 9-3
+   * "Unsigned Short Division from Signed Division".
+   *)
+  let divrem_u n d =
+    if d = Rep.zero then raise Numerics.IntegerDivideByZero else
+      let t = Rep.shift_right d (Rep.bitwidth - 1) in
+      let n' = Rep.logand n (Rep.lognot t) in
+      let q = Rep.shift_left (Rep.div (Rep.shift_right_logical n' 1) d) 1 in
+      let r = Rep.sub n (Rep.mul q d) in
+      if cmp_u r (<) d then
+        q, r
+      else
+        Rep.add q Rep.one, Rep.sub r d
+
+  type t = Rep.t
+  type bits = Rep.t
+
+  let of_bits x = x
+  let to_bits x = x
+
+  let zero = Rep.zero
+
+  let add = Rep.add
+  let sub = Rep.sub
+  let mul = Rep.mul
+
+  let div_s x y =
+    if y = Rep.zero then
+      raise Numerics.IntegerDivideByZero
+    else if x = Rep.min_int && y = Rep.minus_one then
+      raise Numerics.IntegerOverflow
+    else
+      Rep.div x y
+
+  let div_u x y =
+    let q, r = divrem_u x y in q
+
+  let rem_s x y =
+    if y = Rep.zero then
+      raise Numerics.IntegerDivideByZero
+    else
+      Rep.rem x y
+
+  let rem_u x y =
+    let q, r = divrem_u x y in r
+
+  let and_ = Rep.logand
+  let or_ = Rep.logor
+  let xor = Rep.logxor
+
+  (* WebAssembly shift counts are unmasked and unsigned *)
+  let shift_ok n = n >= Rep.zero && n < Rep.of_int Rep.bitwidth
+
+  let shl x y =
+    if shift_ok y then
+      Rep.shift_left x (Rep.to_int y)
+    else
+      Rep.zero
+
+  let shr_s x y =
+    Rep.shift_right x (if shift_ok y then Rep.to_int y else Rep.bitwidth - 1)
+
+  let shr_u x y =
+    if shift_ok y then
+      Rep.shift_right_logical x (Rep.to_int y)
+    else
+      Rep.zero
+
+  let clz x =
+    Rep.of_int
+      (let rec loop acc n =
+         if n = Rep.zero then
+           Rep.bitwidth
+         else if and_ n (Rep.shift_left Rep.one (Rep.bitwidth - 1)) <> Rep.zero then
+           acc
+         else
+           loop (1 + acc) (Rep.shift_left n 1)
+       in loop 0 x)
+
+  let ctz x =
+    Rep.of_int
+      (let rec loop acc n =
+         if n = Rep.zero then
+           Rep.bitwidth
+         else if and_ n Rep.one = Rep.one then
+           acc
+         else
+           loop (1 + acc) (Rep.shift_right_logical n 1)
+       in loop 0 x)
+
+  let popcnt x =
+    Rep.of_int
+      (let rec loop acc i n =
+         if n = Rep.zero then
+           acc
+         else
+           let acc' = if and_ n Rep.one = Rep.one then acc + 1 else acc in
+           loop acc' (i - 1) (Rep.shift_right_logical n 1)
+       in loop 0 Rep.bitwidth x)
+
+  let eq x y = x = y
+  let ne x y = x <> y
+  let lt_s x y = x < y
+  let lt_u x y = cmp_u x (<) y
+  let le_s x y = x <= y
+  let le_u x y = cmp_u x (<=) y
+  let gt_s x y = x > y
+  let gt_u x y = cmp_u x (>) y
+  let ge_s x y = x >= y
+  let ge_u x y = cmp_u x (>=) y
+
+  let of_string = Rep.of_string
+  let to_string = Rep.to_string
+
+  let of_int = Rep.of_int
+end