1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
open! Import
let invalid_argf = Printf.invalid_argf
let negative_exponent () = Printf.invalid_argf "exponent can not be negative" ()
let overflow () = Printf.invalid_argf "integer overflow in pow" ()
external int_math_int_pow : int -> int -> int = "Base_int_math_int_pow_stub" [@@noalloc]
external int_math_int64_pow : int64 -> int64 -> int64 = "Base_int_math_int64_pow_stub"
let int_pow base exponent =
if exponent < 0 then negative_exponent ();
if abs base > 1
&& (exponent > 63
|| abs base > Pow_overflow_bounds.int_positive_overflow_bounds.(exponent))
then overflow ();
int_math_int_pow base exponent
;;
module Int64_with_comparisons = struct
include Caml.Int64
external ( < ) : int64 -> int64 -> bool = "%lessthan"
external ( > ) : int64 -> int64 -> bool = "%greaterthan"
external ( >= ) : int64 -> int64 -> bool = "%greaterequal"
end
let int64_pow base exponent =
let open Int64_with_comparisons in
if exponent < 0L then negative_exponent ();
if (base > 1L || base < -1L)
&& (exponent > 63L
|| (base >= 0L
&& base > Pow_overflow_bounds.int64_positive_overflow_bounds.(to_int exponent)
)
|| (base < 0L
&& base < Pow_overflow_bounds.int64_negative_overflow_bounds.(to_int exponent)
))
then overflow ();
int_math_int64_pow base exponent
;;
let int63_pow_on_int64 base exponent =
let open Int64_with_comparisons in
if exponent < 0L then negative_exponent ();
if abs base > 1L
&& (exponent > 63L
|| abs base
> Pow_overflow_bounds.int63_on_int64_positive_overflow_bounds.(to_int exponent)
)
then overflow ();
int_math_int64_pow base exponent
;;
module type Make_arg = sig
type t
include Floatable.S with type t := t
include Stringable.S with type t := t
val ( + ) : t -> t -> t
val ( - ) : t -> t -> t
val ( * ) : t -> t -> t
val ( / ) : t -> t -> t
val ( ~- ) : t -> t
include Comparisons.Infix with type t := t
val abs : t -> t
val neg : t -> t
val zero : t
val of_int_exn : int -> t
val rem : t -> t -> t
end
module Make (X : Make_arg) = struct
open X
let ( % ) x y =
if y <= zero
then
invalid_argf
"%s %% %s in core_int.ml: modulus should be positive"
(to_string x)
(to_string y)
();
let rval = X.rem x y in
if rval < zero then rval + y else rval
;;
let one = of_int_exn 1
let ( /% ) x y =
if y <= zero
then
invalid_argf
"%s /%% %s in core_int.ml: divisor should be positive"
(to_string x)
(to_string y)
();
if x < zero then ((x + one) / y) - one else x / y
;;
(** float division of integers *)
let ( // ) x y = to_float x /. to_float y
let round_down i ~to_multiple_of:modulus = i - (i % modulus)
let round_up i ~to_multiple_of:modulus =
let remainder = i % modulus in
if remainder = zero then i else i + modulus - remainder
;;
let round_towards_zero i ~to_multiple_of =
if i = zero
then zero
else if i > zero
then round_down i ~to_multiple_of
else round_up i ~to_multiple_of
;;
let round_nearest i ~to_multiple_of:modulus =
let remainder = i % modulus in
let modulus_minus_remainder = modulus - remainder in
if modulus_minus_remainder <= remainder
then i + modulus_minus_remainder
else i - remainder
;;
let round ?(dir = `Nearest) i ~to_multiple_of =
match dir with
| `Nearest -> round_nearest i ~to_multiple_of
| `Down -> round_down i ~to_multiple_of
| `Up -> round_up i ~to_multiple_of
| `Zero -> round_towards_zero i ~to_multiple_of
;;
end
module Private = struct
let int_pow = int_pow
let int64_pow = int64_pow
let int63_pow_on_int64 = int63_pow_on_int64
module Pow_overflow_bounds = Pow_overflow_bounds
end