implementation and tests for clz, ctz, and popcnt

ml-proto/src/spec/arithmetic.ml

@@ -33,6 +33,7 @@ sig
   val shift_right : t -> int -> t
   val shift_right_logical : t -> int -> t
   val to_int : t -> int
+  val of_int : int -> t
   val of_int32 : int32 -> t
   val of_int64 : int64 -> t
   val to_float : t -> float
@@ -42,6 +43,9 @@ sig
   val of_big_int_u : Big_int.big_int -> t
   val to_value : t -> value
   val of_value : int -> value -> t
+  val compare : t -> t -> int
+  val zero : t
+  val one : t
 end
 
 let to_big_int_u_for size to_big_int i =
@@ -119,10 +123,30 @@ struct
 
   let unop op =
     let f = match op with
-      | Clz -> fun i -> i  (* TODO *)
-      | Ctz -> fun i -> i  (* TODO *)
-      | Popcnt -> fun i -> i  (* TODO *)
-    in fun v -> Int.to_value (f (Int.of_value 1 v))
+      | Clz -> let rec loop acc n =
+                 match n with 
+                     | n when n = Int.zero -> Int.size 
+                     | n when Int.logand n (Int.shift_left Int.one (Int.size-1))
+                              <> Int.zero
+                         -> acc 
+                     | _ -> loop (1+acc) (Int.shift_left n 1) 
+               in loop 0
+      | Ctz -> let rec loop acc n =
+                 match n with 
+                     | n when n = Int.zero -> Int.size
+                     | n when Int.logand n Int.one = Int.one -> acc
+                     | _ -> loop (1+acc) (Int.shift_right_logical n 1) 
+               in loop 0
+      | Popcnt -> let rec loop acc i n =
+                    if n = Int.zero then acc
+                    else let acc = 
+                           if Int.logand n Int.one = Int.one
+                           then acc+1
+                           else acc
+			 in let n = Int.shift_right_logical n 1
+                            in loop acc (i-1) n
+                  in loop 0 Int.size
+    in fun v -> Int.to_value (Int.of_int (f (Int.of_value 1 v)))
 
   let binop op =
     let f = match op with

ml-proto/test/int32.wasm

@@ -0,0 +1,37 @@
+(; Int arith operations ;)
+
+(module
+  (func $clz (param $x i32) (result i32)
+    (i32.clz (get_local $x))
+  )
+
+  (func $ctz (param $x i32) (result i32)
+    (i32.ctz (get_local $x))
+  )
+
+  (func $popcnt (param $x i32) (result i32)
+    (i32.popcnt (get_local $x))
+  )
+
+  (export "clz" $clz)
+  (export "ctz" $ctz)
+  (export "popcnt" $popcnt) 
+)
+
+(assert_eq (invoke "clz" (i32.const -1)) (i32.const 0)) ;; 0xFFFFFFFF
+(assert_eq (invoke "clz" (i32.const 0)) (i32.const 32))
+(assert_eq (invoke "clz" (i32.const 32768)) (i32.const 16)) ;; 0x00008000 
+(assert_eq (invoke "clz" (i32.const 255)) (i32.const 24)) ;; 0xFF
+(assert_eq (invoke "clz" (i32.const -2147483648)) (i32.const 0)) ;; 0x80000000
+(assert_eq (invoke "clz" (i32.const 1)) (i32.const 31))
+(assert_eq (invoke "clz" (i32.const 2)) (i32.const 30)) 
+
+(assert_eq (invoke "ctz" (i32.const -1)) (i32.const 0))
+(assert_eq (invoke "ctz" (i32.const 0)) (i32.const 32))
+(assert_eq (invoke "ctz" (i32.const 32768)) (i32.const 15)) ;; 0x00008000
+(assert_eq (invoke "ctz" (i32.const 65536)) (i32.const 16)) ;; 0x00010000
+(assert_eq (invoke "ctz" (i32.const -2147483648)) (i32.const 31)) ;; 0x80000000
+
+(assert_eq (invoke "popcnt" (i32.const -1)) (i32.const 32))
+(assert_eq (invoke "popcnt" (i32.const 0)) (i32.const 0))
+(assert_eq (invoke "popcnt" (i32.const 32768)) (i32.const 1)) ;; 0x00008000