From 30969895ac8470deb9341d6c950ab2f42bc1c3b4 Mon Sep 17 00:00:00 2001 From: Nicolas Ojeda Bar Date: Mon, 30 Oct 2017 10:24:49 +0100 Subject: [PATCH] Add {Int32,Int64,Nativeint}.unsigned_{compare,div,rem} --- stdlib/int32.ml | 33 +++++++ stdlib/int32.mli | 25 ++++++ stdlib/int64.ml | 25 ++++++ stdlib/int64.mli | 25 ++++++ stdlib/nativeint.ml | 25 ++++++ stdlib/nativeint.mli | 25 ++++++ testsuite/tests/basic/boxedints.ml | 104 ++++++++++++++++++---- testsuite/tests/basic/boxedints.reference | 12 +++ utils/targetint.ml | 3 + utils/targetint.mli | 12 +++ 10 files changed, 271 insertions(+), 18 deletions(-) diff --git a/stdlib/int32.ml b/stdlib/int32.ml index 9e1eabf5e..e159851e5 100644 --- a/stdlib/int32.ml +++ b/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) diff --git a/stdlib/int32.mli b/stdlib/int32.mli index ca046d7d7..9ef27bb4b 100644 --- a/stdlib/int32.mli +++ b/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 *) diff --git a/stdlib/int64.ml b/stdlib/int64.ml index 59e616481..1640368d4 100644 --- a/stdlib/int64.ml +++ b/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) diff --git a/stdlib/int64.mli b/stdlib/int64.mli index 2800112a4..732cc0088 100644 --- a/stdlib/int64.mli +++ b/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 *) diff --git a/stdlib/nativeint.ml b/stdlib/nativeint.ml index 2a7bf4366..5d8b4e61a 100644 --- a/stdlib/nativeint.ml +++ b/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) diff --git a/stdlib/nativeint.mli b/stdlib/nativeint.mli index 1b6e78643..c338142a5 100644 --- a/stdlib/nativeint.mli +++ b/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 *) diff --git a/testsuite/tests/basic/boxedints.ml b/testsuite/tests/basic/boxedints.ml index e3ff7000f..8705dbb87 100644 --- a/testsuite/tests/basic/boxedints.ml +++ b/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 --------"; diff --git a/testsuite/tests/basic/boxedints.reference b/testsuite/tests/basic/boxedints.reference index 009390fae..8aa458027 100644 --- a/testsuite/tests/basic/boxedints.reference +++ b/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 diff --git a/utils/targetint.ml b/utils/targetint.ml index 4d08f559d..9d15a2ff5 100644 --- a/utils/targetint.ml +++ b/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 diff --git a/utils/targetint.mli b/utils/targetint.mli index d61cc805f..3727baac8 100644 --- a/utils/targetint.mli +++ b/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. *)