Source file CCNativeint.ml
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
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
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
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
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
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
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
(** {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