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
module type Infix = sig
type t
include Unsigned.Infix with type t := t
val (asr) : t -> int -> t
end
module type S = sig
type t
module Infix : Infix with type t := t
include Unsigned.S with type t := t
with module Infix := Infix
val neg : t -> t
val abs : t -> t
val minus_one : t
val min_int : t
val shift_right_logical : t -> int -> t
val of_nativeint : nativeint -> t
val to_nativeint : t -> nativeint
val of_int64 : int64 -> t
val to_int64 : t -> int64
end
module type Basics = sig
type t
val add : t -> t -> t
val sub : t -> t -> t
val mul : t -> t -> t
val div : t -> t -> t
val rem : t -> t -> t
val logand : t -> t -> t
val logor : t -> t -> t
val logxor : t -> t -> t
val shift_left : t -> int -> t
val shift_right : t -> int -> t
val shift_right_logical : t -> int -> t
end
module MakeInfix(S : Basics) =
struct
open S
let (+) = add
let (-) = sub
let ( * ) = mul
let (/) = div
let (mod) = rem
let (land) = logand
let (lor) = logor
let (lxor) = logxor
let (lsl) = shift_left
let (lsr) = shift_right_logical
let (asr) = shift_right
end
external format_int : string -> int -> string = "caml_format_int"
module Int =
struct
module Basics =
struct
type t = int
let add = ( + )
let sub = ( - )
let mul = ( * )
let div = ( / )
let rem = ( mod )
let max_int = Stdlib.max_int
let min_int = Stdlib.min_int
let logand = ( land )
let logor = ( lor )
let logxor = ( lxor )
let shift_left = ( lsl )
let shift_right = ( asr )
let shift_right_logical = ( lsr )
let of_int x = x
let to_int x = x
let of_string = int_of_string
let of_string_opt s = try Some (of_string s) with Failure _ -> None
let to_string = string_of_int
let to_hexstring = format_int "%x"
let zero = 0
let one = 1
let minus_one = -1
let lognot = lnot
let succ = Stdlib.succ
let pred = Stdlib.pred
let compare = Stdlib.compare
let equal = Stdlib.(=)
let max = Stdlib.max
let min = Stdlib.min
end
include Basics
module Infix = MakeInfix(Basics)
let to_int64 = Int64.of_int
let of_int64 = Int64.to_int
let to_nativeint = Nativeint.of_int
let of_nativeint = Nativeint.to_int
let abs = Stdlib.abs
let neg x = -x
let pp fmt n = Format.fprintf fmt "%d" n
let pp_hex fmt n = Format.fprintf fmt "%x" n
end
module Int32 =
struct
[@@@ocaml.warning "-32"]
let equal (x:int32) (y:int32) = x = y
let of_string_opt s = try Some (Int32.of_string s) with Failure _ -> None
include Int32
module Infix = MakeInfix(Int32)
let of_nativeint = Nativeint.to_int32
let to_nativeint = Nativeint.of_int32
let of_int64 = Int64.to_int32
let to_int64 = Int64.of_int32
let max = Stdlib.max
let min = Stdlib.min
let pp fmt n = Format.fprintf fmt "%ld" n
let pp_hex fmt n = Format.fprintf fmt "%lx" n
let to_hexstring n = Format.asprintf "%lx" n
end
module Int64 =
struct
[@@@ocaml.warning "-32"]
let equal (x:int64) (y:int64) = x = y
let of_string_opt s = try Some (Int64.of_string s) with Failure _ -> None
include Int64
module Infix = MakeInfix(Int64)
let of_int64 x = x
let to_int64 x = x
let max = Stdlib.max
let min = Stdlib.min
let pp fmt n = Format.fprintf fmt "%Ld" n
let pp_hex fmt n = Format.fprintf fmt "%Lx" n
let to_hexstring n = Format.asprintf "%Lx" n
end
external int_size : unit -> int = "integers_uint_size"
external long_size : unit -> int = "integers_ulong_size"
external llong_size : unit -> int = "integers_ulonglong_size"
let of_byte_size : int -> (module S) = function
| 4 -> (module Int32)
| 8 -> (module Int64)
| _ -> invalid_arg "Signed.of_byte_size"
module SInt = (val of_byte_size (int_size ()))
module Long = (val of_byte_size (long_size ()))
module LLong = (val of_byte_size (llong_size ()))
type sint = SInt.t
type long = Long.t
type llong = LLong.t