Add {Int32,Int64,Nativeint}.unsigned_{compare,div,rem}

stdlib/int32.ml

@@ -52,6 +52,22 @@ let min_int = 0x80000000l
 let max_int = 0x7FFFFFFFl
 let lognot n = logxor n (-1l)
 
+let unsigned_to_int =
+  match Sys.word_size with
+  | 32 ->
+      let max_int = of_int Stdlib.max_int in
+      fun n ->
+        if compare zero n <= 0 && compare n max_int <= 0 then
+          Some (to_int n)
+        else
+          None
+  | 64 ->
+      (* So that it compiles in 32-bit *)
+      let move = int_of_string "0x1_0000_0000" in
+      fun n -> let i = to_int n in Some (if i < 0 then i + move else i)
+  | _ ->
+      assert false
+
 external format : string -> int32 -> string = "caml_int32_format"
 let to_string n = format "%d" n
 
@@ -66,3 +82,20 @@ type t = int32
 
 let compare (x: t) (y: t) = Stdlib.compare x y
 let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)

stdlib/int32.mli

@@ -60,12 +60,24 @@ external div : int32 -> int32 -> int32 = "%int32_div"
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Stdlib.(/)}. *)
 
+val unsigned_div : int32 -> int32 -> int32
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} 32-bit integers.
+
+    @since 4.08.0 *)
+
 external rem : int32 -> int32 -> int32 = "%int32_mod"
 (** Integer remainder.  If [y] is not zero, the result
    of [Int32.rem x y] satisfies the following property:
    [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)].
    If [y = 0], [Int32.rem x y] raises [Division_by_zero]. *)
 
+val unsigned_rem : int32 -> int32 -> int32
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} 32-bit integers.
+
+    @since 4.08.0 *)
+
 val succ : int32 -> int32
 (** Successor.  [Int32.succ x] is [Int32.add x Int32.one]. *)
 
@@ -121,6 +133,13 @@ external to_int : int32 -> int = "%int32_to_int"
    during the conversion.  On 64-bit platforms, the conversion
    is exact. *)
 
+val unsigned_to_int : int32 -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
 external of_float : float -> int32
   = "caml_int32_of_float" "caml_int32_of_float_unboxed"
   [@@unboxed] [@@noalloc]
@@ -184,6 +203,12 @@ val compare: t -> t -> int
     allows the module [Int32] to be passed as argument to the functors
     {!Set.Make} and {!Map.Make}. *)
 
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    32-bit integers.
+
+    @since 4.08.0 *)
+
 val equal: t -> t -> bool
 (** The equal function for int32s.
     @since 4.03.0 *)

stdlib/int64.ml

@@ -50,6 +50,14 @@ let min_int = 0x8000000000000000L
 let max_int = 0x7FFFFFFFFFFFFFFFL
 let lognot n = logxor n (-1L)
 
+let unsigned_to_int =
+  let max_int = of_int Stdlib.max_int in
+  fun n ->
+    if compare zero n <= 0 && compare n max_int <= 0 then
+      Some (to_int n)
+    else
+      None
+
 external format : string -> int64 -> string = "caml_int64_format"
 let to_string n = format "%d" n
 
@@ -73,3 +81,20 @@ type t = int64
 
 let compare (x: t) (y: t) = Stdlib.compare x y
 let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)

stdlib/int64.mli

@@ -60,12 +60,24 @@ external div : int64 -> int64 -> int64 = "%int64_div"
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Stdlib.(/)}. *)
 
+val unsigned_div : int64 -> int64 -> int64
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} 64-bit integers.
+
+    @since 4.08.0 *)
+
 external rem : int64 -> int64 -> int64 = "%int64_mod"
 (** Integer remainder.  If [y] is not zero, the result
    of [Int64.rem x y] satisfies the following property:
    [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)].
    If [y = 0], [Int64.rem x y] raises [Division_by_zero]. *)
 
+val unsigned_rem : int64 -> int64 -> int64
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} 64-bit integers.
+
+    @since 4.08.0 *)
+
 val succ : int64 -> int64
 (** Successor.  [Int64.succ x] is [Int64.add x Int64.one]. *)
 
@@ -121,6 +133,13 @@ external to_int : int64 -> int = "%int64_to_int"
    is taken modulo 2{^31}, i.e. the top 33 bits are lost
    during the conversion. *)
 
+val unsigned_to_int : int64 -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
 external of_float : float -> int64
   = "caml_int64_of_float" "caml_int64_of_float_unboxed"
   [@@unboxed] [@@noalloc]
@@ -204,6 +223,12 @@ val compare: t -> t -> int
     allows the module [Int64] to be passed as argument to the functors
     {!Set.Make} and {!Map.Make}. *)
 
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    64-bit integers.
+
+    @since 4.08.0 *)
+
 val equal: t -> t -> bool
 (** The equal function for int64s.
     @since 4.03.0 *)

stdlib/nativeint.ml

@@ -49,6 +49,14 @@ let min_int = shift_left 1n (size - 1)
 let max_int = sub min_int 1n
 let lognot n = logxor n (-1n)
 
+let unsigned_to_int =
+  let max_int = of_int Stdlib.max_int in
+  fun n ->
+    if compare zero n <= 0 && compare n max_int <= 0 then
+      Some (to_int n)
+    else
+      None
+
 external format : string -> nativeint -> string = "caml_nativeint_format"
 let to_string n = format "%d" n
 
@@ -63,3 +71,20 @@ type t = nativeint
 
 let compare (x: t) (y: t) = Stdlib.compare x y
 let equal (x: t) (y: t) = compare x y = 0
+
+let unsigned_compare n m =
+  compare (sub n min_int) (sub m min_int)
+
+(* Unsigned division from signed division of the same
+   bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
+*)
+let unsigned_div n d =
+  if d < zero then
+    if unsigned_compare n d < 0 then zero else one
+  else
+    let q = shift_left (div (shift_right_logical n 1) d) 1 in
+    let r = sub n (mul q d) in
+    if unsigned_compare r d >= 0 then succ q else q
+
+let unsigned_rem n d =
+  sub n (mul (unsigned_div n d) d)

stdlib/nativeint.mli

@@ -63,6 +63,12 @@ external div : nativeint -> nativeint -> nativeint = "%nativeint_div"
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Stdlib.(/)}. *)
 
+val unsigned_div : nativeint -> nativeint -> nativeint
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} native integers.
+
+    @since 4.08.0 *)
+
 external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod"
 (** Integer remainder.  If [y] is not zero, the result
    of [Nativeint.rem x y] satisfies the following properties:
@@ -71,6 +77,12 @@ external rem : nativeint -> nativeint -> nativeint = "%nativeint_mod"
                       (Nativeint.rem x y)].
    If [y = 0], [Nativeint.rem x y] raises [Division_by_zero]. *)
 
+val unsigned_rem : nativeint -> nativeint -> nativeint
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} native integers.
+
+    @since 4.08.0 *)
+
 val succ : nativeint -> nativeint
 (** Successor.
    [Nativeint.succ x] is [Nativeint.add x Nativeint.one]. *)
@@ -138,6 +150,13 @@ external to_int : nativeint -> int = "%nativeint_to_int"
    integer (type [int]).  The high-order bit is lost during
    the conversion. *)
 
+val unsigned_to_int : nativeint -> int option
+(** Same as {!to_int}, but interprets the argument as an {e unsigned} integer.
+    Returns [None] if the unsigned value of the argument cannot fit into an
+    [int].
+
+    @since 4.08.0 *)
+
 external of_float : float -> nativeint
   = "caml_nativeint_of_float" "caml_nativeint_of_float_unboxed"
   [@@unboxed] [@@noalloc]
@@ -194,6 +213,12 @@ val compare: t -> t -> int
     allows the module [Nativeint] to be passed as argument to the functors
     {!Set.Make} and {!Map.Make}. *)
 
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    native integers.
+
+    @since 4.08.0 *)
+
 val equal: t -> t -> bool
 (** The equal function for native ints.
     @since 4.03.0 *)

testsuite/tests/basic/boxedints.ml

@@ -35,6 +35,7 @@ module type TESTSIG = sig
     val sub: t -> t -> t
     val mul: t -> t -> t
     val div: t -> t -> t
+    val unsigned_div: t -> t -> t
     val rem: t -> t -> t
     val logand: t -> t -> t
     val logor: t -> t -> t
@@ -44,6 +45,7 @@ module type TESTSIG = sig
     val shift_right_logical: t -> int -> t
     val of_int: int -> t
     val to_int: t -> int
+    val unsigned_to_int: t -> int option
     val of_float: float -> t
     val to_float: t -> float
     val zero: t
@@ -55,7 +57,7 @@ module type TESTSIG = sig
     val to_string: t -> string
     val of_string: string -> t
   end
-  val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int
+  val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int*int
   val skip_float_tests: bool
 end
 
@@ -72,6 +74,30 @@ struct
     test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
     test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
 
+    testing_function "unsigned_to_int";
+    test 1 (unsigned_to_int (of_int 0)) (Some 0);
+    test 2 (unsigned_to_int (of_int 123)) (Some 123);
+    test 3 (unsigned_to_int minus_one)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (int_of_string "0xFFFFFFFF")
+       | _ -> assert false);
+    test 4 (unsigned_to_int max_int)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (to_int max_int)
+       | _ -> assert false);
+    test 5 (unsigned_to_int min_int)
+      (match Sys.word_size with
+       | 32 -> None
+       | 64 -> Some (int_of_string "0x80000000")
+       | _ -> assert false);
+    test 6 (unsigned_to_int (of_int Stdlib.max_int))
+      (match Sys.word_size with
+       | 32 -> Some Stdlib.max_int
+       | 64 -> Some (int_of_string "0xFFFFFFFF")
+       | _ -> assert false);
+
     testing_function "of_string";
     test 1 (of_string "0") (of_int 0);
     test 2 (of_string "123") (of_int 123);
@@ -170,6 +196,21 @@ struct
        11, 1234567, -12345678];
     test 12 (div min_int (of_int (-1))) min_int;
 
+    testing_function "unsigned_div";
+    List.iter
+      (fun (n, a, b, c) -> test n (unsigned_div a b) c)
+      [1, of_int 0, of_int 2, of_int 0;
+       2, of_int 123, of_int 1, of_int 123;
+       3, of_int (-123), of_int 1, of_int (-123);
+       4, of_int (123), of_int (-1), of_int 0;
+       5, of_int (-123), of_int (-1), of_int 0;
+       6, of_int 127531236, of_int 365, of_int (127531236/365);
+       7, of_int 16384, of_int 256, of_int (16384/256);
+       8, of_int (-1), of_int 2, max_int;
+       9, of_int (-1), max_int, of_int 2;
+       10, min_int, of_int 2, shift_left (of_int 1) 30;
+       11, of_int (-1), of_int 8, shift_right_logical (of_int (-1)) 3];
+
     testing_function "mod";
     List.iter
       (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
@@ -271,19 +312,19 @@ struct
 
     testing_function "Comparisons";
     test 1 (testcomp (of_int 0) (of_int 0))
-           (true,false,false,false,true,true,0);
+           (true,false,false,false,true,true,0,0);
     test 2 (testcomp (of_int 1234567) (of_int 1234567))
-           (true,false,false,false,true,true,0);
+           (true,false,false,false,true,true,0, 0);
     test 3 (testcomp (of_int 0) (of_int 1))
-           (false,true,true,false,true,false,-1);
+           (false,true,true,false,true,false,-1,-1);
     test 4 (testcomp (of_int (-1)) (of_int 0))
-           (false,true,true,false,true,false,-1);
+           (false,true,true,false,true,false,-1,1);
     test 5 (testcomp (of_int 1) (of_int 0))
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,1);
     test 6 (testcomp (of_int 0) (of_int (-1)))
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,-1);
     test 7 (testcomp max_int min_int)
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,-1);
 
     ()
 end
@@ -303,6 +344,15 @@ struct
     test 4 (to_int (of_int 0x3FFFFFFF)) 0x3FFFFFFF;
     test 5 (to_int (of_int (-0x40000000))) (-0x40000000);
 
+    testing_function "unsigned_to_int";
+    test 1 (unsigned_to_int (of_int 0)) (Some 0);
+    test 2 (unsigned_to_int (of_int 123)) (Some 123);
+    test 3 (unsigned_to_int minus_one) None;
+    test 4 (unsigned_to_int max_int) None;
+    test 5 (unsigned_to_int min_int) None;
+    test 6 (unsigned_to_int (of_int Stdlib.max_int))
+      (Some Stdlib.max_int);
+
     testing_function "of_string";
     test 1 (of_string "0") (of_int 0);
     test 2 (of_string "123") (of_int 123);
@@ -406,6 +456,21 @@ struct
        11, 1234567, -12345678];
     test 12 (div min_int (of_int (-1))) min_int;
 
+    testing_function "unsigned_div";
+    List.iter
+      (fun (n, a, b, c) -> test n (unsigned_div a b) c)
+      [1, of_int 0, of_int 2, of_int 0;
+       2, of_int 123, of_int 1, of_int 123;
+       3, of_int (-123), of_int 1, of_int (-123);
+       4, of_int (123), of_int (-1), of_int 0;
+       5, of_int (-123), of_int (-1), of_int 0;
+       6, of_int 127531236, of_int 365, of_int (127531236/365);
+       7, of_int 16384, of_int 256, of_int (16384/256);
+       8, of_int (-1), of_int 2, max_int;
+       9, of_int (-1), max_int, of_int 2;
+       10, min_int, of_int 2, shift_left (of_int 1) 62;
+       11, of_int (-1), of_int 8, shift_right_logical (of_int (-1)) 3];
+
     testing_function "mod";
     List.iter
       (fun (n, a, b) -> test n (rem (of_int a) (of_int b)) (of_int (a mod b)))
@@ -489,19 +554,19 @@ struct
 
     testing_function "Comparisons";
     test 1 (testcomp (of_int 0) (of_int 0))
-           (true,false,false,false,true,true,0);
+           (true,false,false,false,true,true,0,0);
     test 2 (testcomp (of_int 1234567) (of_int 1234567))
-           (true,false,false,false,true,true,0);
+           (true,false,false,false,true,true,0,0);
     test 3 (testcomp (of_int 0) (of_int 1))
-           (false,true,true,false,true,false,-1);
+           (false,true,true,false,true,false,-1,-1);
     test 4 (testcomp (of_int (-1)) (of_int 0))
-           (false,true,true,false,true,false,-1);
+           (false,true,true,false,true,false,-1,1);
     test 5 (testcomp (of_int 1) (of_int 0))
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,1);
     test 6 (testcomp (of_int 0) (of_int (-1)))
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,-1);
     test 7 (testcomp max_int min_int)
-           (false,true,false,true,false,true,1);
+           (false,true,false,true,false,true,1,-1);
 
     ()
 end
@@ -509,11 +574,14 @@ end
 (******** The test proper **********)
 
 let testcomp_int32 (a : int32) (b : int32) =
-  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Int32.unsigned_compare a b)
 let testcomp_int64 (a : int64) (b : int64) =
-  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Int64.unsigned_compare a b)
 let testcomp_nativeint (a : nativeint) (b : nativeint) =
-  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b)
+  (a = b, a <> b, a < b, a > b, a <= b, a >= b, compare a b,
+   Nativeint.unsigned_compare a b)
 
 let _ =
   testing_function "-------- Int32 --------";

testsuite/tests/basic/boxedints.reference

@@ -3,6 +3,8 @@
 
 of_int, to_int
  1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
 of_string
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 to_string, format
@@ -17,6 +19,8 @@ mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 mod
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and
@@ -42,6 +46,8 @@ Comparisons
 
 of_int, to_int
  1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
 of_string
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 to_string, format
@@ -56,6 +62,8 @@ mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 mod
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and
@@ -77,6 +85,8 @@ Comparisons
 
 of_int, to_int
  1... 2... 3... 4... 5...
+unsigned_to_int
+ 1... 2... 3... 4... 5... 6...
 of_string
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 to_string, format
@@ -91,6 +101,8 @@ mul
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12... 13...
 div
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+unsigned_div
+ 1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
 mod
  1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
 and

utils/targetint.ml

@@ -28,7 +28,9 @@ module type S = sig
   val sub : t -> t -> t
   val mul : t -> t -> t
   val div : t -> t -> t
+  val unsigned_div : t -> t -> t
   val rem : t -> t -> t
+  val unsigned_rem : t -> t -> t
   val succ : t -> t
   val pred : t -> t
   val abs : t -> t
@@ -53,6 +55,7 @@ module type S = sig
   val of_string : string -> t
   val to_string : t -> string
   val compare: t -> t -> int
+  val unsigned_compare : t -> t -> int
   val equal: t -> t -> bool
   val repr: t -> repr
   val print : Format.formatter -> t -> unit

utils/targetint.mli

@@ -58,6 +58,10 @@ val div : t -> t -> t
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Stdlib.(/)}. *)
 
+val unsigned_div : t -> t -> t
+(** Same as {!div}, except that arguments and result are interpreted as {e
+    unsigned} 32-bit integers. *)
+
 val rem : t -> t -> t
 (** Integer remainder.  If [y] is not zero, the result
    of [Targetint.rem x y] satisfies the following properties:
@@ -66,6 +70,10 @@ val rem : t -> t -> t
                       (Targetint.rem x y)].
    If [y = 0], [Targetint.rem x y] raises [Division_by_zero]. *)
 
+val unsigned_rem : t -> t -> t
+(** Same as {!rem}, except that arguments and result are interpreted as {e
+    unsigned} integers. *)
+
 val succ : t -> t
 (** Successor.
    [Targetint.succ x] is [Targetint.add x Targetint.one]. *)
@@ -181,6 +189,10 @@ val compare: t -> t -> int
     allows the module [Targetint] to be passed as argument to the functors
     {!Set.Make} and {!Map.Make}. *)
 
+val unsigned_compare: t -> t -> int
+(** Same as {!compare}, except that arguments are interpreted as {e unsigned}
+    integers. *)
+
 val equal: t -> t -> bool
 (** The equal function for target ints. *)