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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
open CCShims_
include Int64
let min : t -> t -> t = Stdlib.min
let max : t -> t -> t = Stdlib.max
let sign i = compare i zero
let hash_to_int64 (n : t) =
let offset_basis = 0xcbf29ce484222325L in
let prime = 0x100000001b3L in
let h = ref offset_basis in
for k = 0 to 7 do
h := mul !h prime;
h := logxor !h (logand (shift_right n (k * 8)) 0xffL)
done;
logand !h max_int
let[@inline] hash (n : t) : int =
to_int (hash_to_int64 n) land CCShims_.Stdlib.max_int
let[@inline] popcount (b : t) : int =
let m1 = 0x5555555555555555L in
let m2 = 0x3333333333333333L in
let m4 = 0x0f0f0f0f0f0f0f0fL in
let b = sub b (logand (shift_right_logical b 1) m1) in
let b = add (logand b m2) (logand (shift_right_logical b 2) m2) in
let b = logand (add b (shift_right_logical b 4)) m4 in
let b = add b (shift_right_logical b 8) in
let b = add b (shift_right_logical b 16) in
let b = add b (shift_right_logical b 32) in
let b = logand b 0x7fL in
to_int b
let pow a b =
let rec aux acc = function
| 1L -> acc
| n ->
if equal (rem n 2L) zero then
aux (mul acc acc) (div n 2L)
else
mul acc (aux (mul acc acc) (div n 2L))
in
match b with
| 0L ->
if equal a 0L then
raise (Invalid_argument "pow: undefined value 0^0")
else
1L
| b when compare b 0L < 0 ->
raise (Invalid_argument "pow: can't raise int to negative power")
| b -> aux a b
let floor_div a n =
if compare a 0L < 0 && compare n 0L >= 0 then
sub (div (add a 1L) n) 1L
else if compare a 0L > 0 && compare n 0L < 0 then
sub (div (sub a 1L) n) 1L
else
div a n
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 1L) j yield
)
and down i j yield =
if equal i j then
yield i
else (
yield i;
down (sub i 1L) j yield
)
in
if compare i j <= 0 then
up i j yield
else
down i j yield
let range' i j yield =
if compare i j < 0 then
range i (sub j 1L) yield
else if equal i j then
()
else
range i (add j 1L) 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 0L then
raise (Invalid_argument "CCInt64.range_by")
else if
if compare step 0L > 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
let random n st = Random.State.int64 st n
let random_small = random 100L
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 1L) (shift_right_logical (neg 1L) 1)
type output = char -> unit
let to_binary_gen (out : output) n =
let n =
if compare n 0L < 0 then (
out '-';
neg n
) else
n
in
out '0';
out 'b';
let rec loop started bit n =
if equal bit 0L then (
if not started then out '0'
) else (
let b = logand n bit in
if equal b 0L 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
(** {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
let ( - ) = sub
let ( ~- ) = neg
let ( * ) = mul
let ( / ) = div
let ( ** ) = pow
let ( -- ) = range
let ( --^ ) = range'
let ( mod ) = rem
let ( land ) = logand
let ( lor ) = logor
let ( lxor ) = logxor
let lnot = lognot
let ( lsl ) = shift_left
let ( lsr ) = shift_right_logical
let ( asr ) = shift_right
let ( = ) = equal
let ( <> ) = Stdlib.( <> )
let ( < ) = Stdlib.( < )
let ( <= ) = Stdlib.( <= )
let ( > ) = Stdlib.( > )
let ( >= ) = Stdlib.( >= )
end
include Infix