feat(ccnativeint): complete CCNativeint with regards to CCInt

src/core/CCNativeint.ml

@@ -3,6 +3,200 @@
 open CCShims_
 include Nativeint
 
+
+let min : t -> t -> t = Stdlib.min
+let max : t -> t -> t = Stdlib.max
+
+let hash x = Stdlib.abs (to_int x)
+
+let sign i = compare i zero
+
+let pow a b =
+  let rec aux acc = function
+    | 1n -> acc
+    | n ->
+      if equal (rem n 2n) zero
+      then aux (mul acc acc) (div n 2n)
+      else mul acc (aux (mul acc acc) (div n 2n))
+  in
+  match b with
+    | 0n -> if equal a 0n then raise (Invalid_argument "pow: undefined value 0^0") else 1n
+    | b when compare b 0n < 0 -> raise (Invalid_argument "pow: can't raise int to negative power")
+    | b -> aux a b
+
+(*$T
+  pow 2n 10n = 1024n
+  pow 2n 15n = 32768n
+  pow 10n 5n = 100000n
+  pow 42n 0n = 1n
+  pow 0n 1n = 0n
+*)
+
+let floor_div a n =
+  if compare a 0n < 0 && compare n 0n >= 0 then
+    sub (div (add a 1n) n) 1n
+  else if compare a 0n > 0 && compare n 0n < 0 then
+    sub (div (sub a 1n) n) 1n
+  else
+    div a n
+
+(*$T
+  (floor_div 3n 5n = 0n)
+  (floor_div 5n 5n = 1n)
+  (floor_div 20n 5n = 4n)
+  (floor_div 12n 5n = 2n)
+  (floor_div 0n 5n = 0n)
+  (floor_div (-1n) 5n = -1n)
+  (floor_div (-5n) 5n = -1n)
+  (floor_div (-12n) 5n = -3n)
+
+  (floor_div 0n (-5n) = 0n)
+  (floor_div 3n (-5n) = -1n)
+  (floor_div 5n (-5n) = -1n)
+  (floor_div 9n (-5n) = -2n)
+  (floor_div 20n (-5n) = -4n)
+  (floor_div (-2n) (-5n) = 0n)
+  (floor_div (-8n) (-5n) = 1n)
+  (floor_div (-35n) (-5n) = 7n)
+
+  try ignore (floor_div 12n 0n); false with Division_by_zero -> true
+  try ignore (floor_div (-12n) 0n); false with Division_by_zero -> true
+*)
+
+(*$Q
+  (Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) \
+      (fun (n, m) -> let m = m + 1n in \
+                     floor_div n m = of_float @@ floor (to_float n /. to_float m))
+  (Q.pair (Q.map of_int Q.small_signed_int) (Q.map of_int Q.small_nat)) \
+      (fun (n, m) -> let m = m + 1n in \
+                     floor_div n (-m) = of_float @@ floor (to_float n /. to_float (-m)))
+*)
+
+type 'a printer = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+type 'a iter = ('a -> unit) -> unit
+
+let range i j yield =
+  let rec up i j yield =
+    if equal i j then yield i
+    else (
+      yield i;
+      up (add i 1n) j yield
+    )
+  and down i j yield =
+    if equal i j then yield i
+    else (
+      yield i;
+      down (sub i 1n) j yield
+    )
+  in
+  if compare i j <= 0 then up i j yield else down i j yield
+
+(*$= & ~printer:Q.Print.(list to_string)
+  [0n;1n;2n;3n;4n;5n] (range 0n 5n |> Iter.to_list)
+  [0n]                (range 0n 0n |> Iter.to_list)
+  [5n;4n;3n;2n]       (range 5n 2n |> Iter.to_list)
+*)
+
+let range' i j yield =
+  if compare i j < 0 then range i (sub j 1n) yield
+  else if equal i j then ()
+  else range i (add j 1n) yield
+
+let range_by ~step i j yield =
+  let rec range i j yield =
+    if equal i j then yield i
+    else (
+      yield i;
+      range (add i step) j yield
+    )
+  in
+  if equal step 0n then
+    raise (Invalid_argument "CCNativeint.range_by")
+  else if (if compare step 0n > 0 then compare i j > 0 else compare i j < 0) then ()
+  else range i (add (mul (div (sub j i) step) step) i) yield
+
+(* note: the last test checks that no error occurs due to overflows. *)
+(*$= & ~printer:Q.Print.(list to_string)
+  [0n]       (range_by ~step:1n   0n 0n      |> Iter.to_list)
+  []         (range_by ~step:1n   5n 0n      |> Iter.to_list)
+  []         (range_by ~step:2n   1n 0n      |> Iter.to_list)
+  [0n;2n;4n] (range_by ~step:2n   0n 4n      |> Iter.to_list)
+  [0n;2n;4n] (range_by ~step:2n   0n 5n      |> Iter.to_list)
+  [0n]       (range_by ~step:(neg 1n) 0n 0n  |> Iter.to_list)
+  []         (range_by ~step:(neg 1n) 0n 5n  |> Iter.to_list)
+  []         (range_by ~step:(neg 2n) 0n 1n  |> Iter.to_list)
+  [5n;3n;1n] (range_by ~step:(neg 2n) 5n 1n  |> Iter.to_list)
+  [5n;3n;1n] (range_by ~step:(neg 2n) 5n 0n  |> Iter.to_list)
+  [0n]       (range_by ~step:max_int 0n 2n   |> Iter.to_list)
+*)
+
+(*$Q
+  Q.(pair (map of_int small_int) (map of_int small_int)) (fun (i,j) -> \
+    let i = min i j and j = max i j in \
+    CCList.equal CCNativeint.equal \
+      (CCNativeint.range_by ~step:1n i j |> Iter.to_list) \
+      (CCNativeint.range i j |> Iter.to_list) )
+*)
+
+let random n st = Random.State.nativeint st n
+let random_small = random 100n
+let random_range i j st = add i (random (sub j i) st)
+
+
+(** {2 Conversion} *)
+
+let of_string_exn = of_string
+
+let of_string x = try Some (of_string_exn x) with Failure _ -> None
+let of_string_opt = of_string
+
+let most_significant_bit =
+  logxor (neg 1n) (shift_right_logical (neg 1n) 1)
+
+type output = char -> unit
+
+(* abstract printer *)
+let to_binary_gen (out:output) n =
+  let n = if compare n 0n <0 then (out '-'; neg n) else n in
+  out '0'; out 'b';
+  let rec loop started bit n =
+    if equal bit 0n then (
+      if not started then out '0'
+    ) else (
+      let b = logand n bit in
+      if equal b 0n then (
+        if started then out '0';
+        loop started (shift_right_logical bit 1) n
+      ) else (
+        out '1';
+        loop true (shift_right_logical bit 1) n
+      )
+    )
+  in
+  loop false most_significant_bit n
+
+let to_string_binary n =
+  let buf = Buffer.create 16 in
+  to_binary_gen (Buffer.add_char buf) n;
+  Buffer.contents buf
+
+(*$= & ~printer:CCFun.id
+  "0b111" (to_string_binary 7n)
+  "-0b111" (to_string_binary (-7n))
+  "0b0" (to_string_binary 0n)
+*)
+
+(** {2 Printing} *)
+
+let pp out n = Format.pp_print_string out (to_string n)
+
+let pp_binary out n =
+  to_binary_gen (Format.pp_print_char out) n
+
+
+(** {2 Infix Operators} *)
+
 module Infix = struct
   let (+) = add
 
@@ -14,6 +208,12 @@ module Infix = struct
 
   let (/) = div
 
+  let ( ** ) = pow
+
+  let (--) = range
+
+  let (--^) = range'
+
   let (mod) = rem
 
   let (land) = logand
@@ -39,12 +239,3 @@ module Infix = struct
   let (>=) = Stdlib.(>=)
 end
 include Infix
-
-let hash x = Stdlib.abs (to_int x)
-
-(** {2 Conversion} *)
-
-let of_string_exn = of_string
-
-let of_string x = try Some (of_string_exn x) with Failure _ -> None
-let of_string_opt = of_string

src/core/CCNativeint.mli

@@ -18,42 +18,159 @@
 
 include module type of struct include Nativeint end
 
+val min : t -> t -> t
+(** [min x y] returns the minimum of the two integers [x] and [y].
+    @since NEXT_RELEASE *)
+
+val max : t -> t -> t
+(** [max x y] returns the maximum of the two integers [x] and [y].
+    @since NEXT_RELEASE *)
+
+val hash : t -> int
+(** [hash x] computes the hash of [x].
+    Like {!Stdlib.abs (to_int x)}. *)
+
+val sign : t -> int
+(** [sign x] return [0] if [x = 0], [-1] if [x < 0] and [1] if [x > 0].
+    Same as [compare x zero].
+    @since NEXT_RELEASE*)
+
+val pow : t -> t -> t
+(** [pow base exponent] returns [base] raised to the power of [exponent].
+    [pow x y = x^y] for positive integers [x] and [y].
+    Raises [Invalid_argument] if [x = y = 0] or [y] < 0.
+    @since 0.11 *)
+
+val floor_div : t -> t -> t
+(** [floor_div x n] is integer division rounding towards negative infinity.
+    It satisfies [x = m * floor_div x n + rem x n].
+    @since NEXT_RELEASE *)
+
+type 'a printer = Format.formatter -> 'a -> unit
+type 'a random_gen = Random.State.t -> 'a
+type 'a iter = ('a -> unit) -> unit
+
+
+val range_by : step:t -> t -> t -> t iter
+(** [range_by ~step i j] iterates on integers from [i] to [j] included,
+    where the difference between successive elements is [step].
+    Use a negative [step] for a decreasing list.
+    @raise Invalid_argument if [step=0].
+    @since NEXT_RELEASE *)
+
+val range : t -> t -> t iter
+(** [range i j] iterates on integers from [i] to [j] included . It works
+    both for decreasing and increasing ranges.
+    @since NEXT_RELEASE *)
+
+val range' : t -> t -> t iter
+(** [range' i j] is like {!range} but the second bound [j] is excluded.
+    For instance [range' 0 5 = Iter.of_list [0;1;2;3;4]].
+    @since NEXT_RELEASE *)
+
+val random : t -> t random_gen
+val random_small : t random_gen
+val random_range : t -> t -> t random_gen
+
+
+(** {2 Conversion} *)
+
+val of_string : string -> t option
+(** [of_string s] is the safe version of {!of_string_exn}.
+    Like {!of_string_exn}, but return [None] instead of raising. *)
+
+val of_string_opt : string -> t option
+(** [of_string_opt s] is an alias to {!of_string}. *)
+
+val of_string_exn : string -> t
+(** [of_string_exn s] converts the given string [s] into a native integer.
+    Alias to {!Nativeint.of_string}.
+    Convert the given string to a native integer.
+    The string is read in decimal (by default, or if the string
+    begins with [0u]) or in hexadecimal, octal or binary if the
+    string begins with [0x], [0o] or [0b] respectively.
+
+    The [0u] prefix reads the input as an unsigned integer in the range
+    [[0, 2*CCNativeint.max_int+1]]. If the input exceeds {!CCNativeint.max_int}
+    it is converted to the signed integer
+    [CCInt64.min_int + input - CCNativeint.max_int - 1].
+
+    Raise [Failure "Nativeint.of_string"] if the given string is not
+    a valid representation of an integer, or if the integer represented
+    exceeds the range of integers representable in type [nativeint]. *)
+
+val to_string_binary : t -> string
+(** [to_string_binary x] returns the string representation of the integer [x], in binary.
+    @since NEXT_RELEASE *)
+
+
+(** {2 Printing} *)
+
+val pp : t printer
+(** [pp ppf x] prints the integer [x] on [ppf].
+    @since NEXT_RELEASE *)
+
+val pp_binary : t printer
+(** [pp_binary ppf x] prints [x] on [ppf].
+    Print as "0b00101010".
+    @since NEXT_RELEASE *)
+
+
+(** {2 Infix Operators} *)
+
 module Infix : sig
   val ( + ) : t -> t -> t
-  (** Addition. *)
+  (** [x + y] is the sum of [x] and [y]. 
+      Addition. *)
 
   val ( - ) : t -> t -> t
-  (** Subtraction. *)
+  (** [x - y] is the difference of [x] and [y].
+      Subtraction. *)
 
   val ( ~- ) : t -> t
-  (** Unary negation. *)
+  (** [~- x] is the negation of [x].
+      Unary negation. *)
 
   val ( * ) : t -> t -> t
-  (** Multiplication. *)
+  (** [ x * y] is the product of [x] and [y].
+      Multiplication. *)
 
   val ( / ) : t -> t -> t
-  (** Integer division.  Raise [Division_by_zero] if the second
+  (** [x / y] is the integer quotient of [x] and [y].
-      argument is zero.  This division rounds the real quotient of
+      Integer division.  Raise [Division_by_zero] if the second
+      argument [y] is zero.  This division rounds the real quotient of
       its arguments towards zero, as specified for {!Stdlib.(/)}. *)
 
   val ( mod ) : t -> t -> t
-  (** [x mod y ] is the integer remainder.
+  (** [x mod y] is the integer remainder of [x / y].
       If [y <> zero], the result of [x mod y] satisfies the following properties:
       [zero <= x mod y < abs y] and
       [x = ((x / y) * y) + (x mod y)].
       If [y = 0], [x mod y] raises [Division_by_zero]. *)
 
+  val ( ** ) : t -> t -> t
+  (** Alias to {!pow}
+      @since NEXT_RELEASE *)
+
+  val (--) : t -> t -> t iter
+  (** Alias to {!range}.
+      @since NEXT_RELEASE *)
+
+  val (--^) : t -> t -> t iter
+  (** Alias to {!range'}.
+      @since NEXT_RELEASE *)
+
   val ( land ) : t -> t -> t
-  (** Bitwise logical and. *)
+  (** [x land y] is the bitwise logical and of [x] and [y]. *)
 
   val ( lor ) : t -> t -> t
-  (** Bitwise logical or. *)
+  (** [x lor y] is the bitwise logical or of [x] and [y]. *)
 
   val ( lxor ) : t -> t -> t
-  (** Bitwise logical exclusive or. *)
+  (** [x lxor y] is the bitwise logical exclusive or of [x] and [y]. *)
 
   val lnot : t -> t
-  (** Bitwise logical negation. *)
+  (** [lnot x] is the bitwise logical negation of [x] (the bits of [x] are inverted). *)
 
   val ( lsl ) : t -> int -> t
   (** [ x lsl y] shifts [x] to the left by [y] bits.
@@ -80,30 +197,4 @@ module Infix : sig
   val (<) : t -> t -> bool
 end
 
-val hash : t -> int
+include module type of Infix
-(** Like {!Stdlib.abs (to_int x)}. *)
-
-(** {2 Conversion} *)
-
-val of_string_exn : string -> t
-(** Alias to {!Nativeint.of_string}.
-    Convert the given string to a native integer.
-    The string is read in decimal (by default, or if the string
-    begins with [0u]) or in hexadecimal, octal or binary if the
-    string begins with [0x], [0o] or [0b] respectively.
-
-    The [0u] prefix reads the input as an unsigned integer in the range
-    [[0, 2*CCNativeint.max_int+1]]. If the input exceeds {!CCNativeint.max_int}
-    it is converted to the signed integer
-    [CCInt64.min_int + input - CCNativeint.max_int - 1].
-
-    Raise [Failure "Nativeint.of_string"] if the given string is not
-    a valid representation of an integer, or if the integer represented
-    exceeds the range of integers representable in type [nativeint]. *)
-
-val of_string : string -> t option
-(** Safe version of {!of_string_exn}.
-    Like {!of_string_exn}, but return [None] instead of raising. *)
-
-val of_string_opt : string -> t option
-(** Alias to {!of_string}. *)