diff --git a/src/core/CCNativeint.ml b/src/core/CCNativeint.ml index f13cf27d..030bb811 100644 --- a/src/core/CCNativeint.ml +++ b/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 diff --git a/src/core/CCNativeint.mli b/src/core/CCNativeint.mli index 90dcbb46..7929a680 100644 --- a/src/core/CCNativeint.mli +++ b/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 - argument is zero. This division rounds the real quotient of + (** [x / y] is the integer quotient of [x] and [y]. + 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 -(** 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}. *) +include module type of Infix