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
type 'a t = Byte : char t | Short : int t | Int32 : int32 t | Int64 : int64 t
let serialize : type a. Format.formatter -> a t -> unit =
fun ppf -> function
| Byte -> Format.pp_print_string ppf "Conan.Integer.byte"
| Short -> Format.pp_print_string ppf "Conan.Integer.short"
| Int32 -> Format.pp_print_string ppf "Conan.Integer.int32"
| Int64 -> Format.pp_print_string ppf "Conan.Integer.int64"
let serializer_of : type a. a t -> Format.formatter -> a -> unit = function
| Byte -> Serialize.char
| Short -> Serialize.int
| Int32 -> Serialize.int32
| Int64 -> Serialize.int64
let byte = Byte
let short = Short
let int32 = Int32
let int64 = Int64
let pf = Format.fprintf
let pp : type a. a t -> Format.formatter -> a -> unit = function
| Byte -> fun ppf v -> pf ppf "%02x" (Char.code v)
| Short -> fun ppf v -> pf ppf "0x%x" v
| Int32 -> fun ppf v -> pf ppf "0x%lx" v
| Int64 -> fun ppf v -> pf ppf "0x%Lx" v
let add : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr ((code a + code b) land 0xff))
| Short -> fun a b -> (a + b) land 0xffff
| Int32 -> Int32.add
| Int64 -> Int64.add
let sub : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr ((code a + code b) land 0xff))
| Short -> fun a b -> (a - b) land 0xffff
| Int32 -> Int32.sub
| Int64 -> Int64.sub
let mul : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr (code a * code b land 0xff))
| Short -> fun a b -> a * b land 0xffff
| Int32 -> Int32.mul
| Int64 -> Int64.mul
let div : type w. ?unsigned:bool -> w t -> w -> w -> w =
fun ?(unsigned = false) -> function
| Byte -> fun a b -> Char.(chr (code a / code b land 0xff))
| Short -> fun a b -> a / b land 0xffff
| Int32 -> if unsigned then Int32.unsigned_div else Int32.div
| Int64 -> if unsigned then Int64.unsigned_div else Int64.div
let rem : type w. ?unsigned:bool -> w t -> w -> w -> w =
fun ?(unsigned = false) -> function
| Byte -> fun a b -> Char.(chr (code a mod code b land 0xff))
| Short -> fun a b -> a mod b land 0xffff
| Int32 -> if unsigned then Int32.unsigned_rem else Int32.rem
| Int64 -> if unsigned then Int64.unsigned_rem else Int64.rem
let bitwise_and : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr (code a land code b land 0xff))
| Short -> fun a b -> a land b land 0xffff
| Int32 -> Int32.logand
| Int64 -> Int64.logand
let bitwise_xor : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr (code a lxor code b land 0xff))
| Short -> fun a b -> a lxor b land 0xffff
| Int32 -> Int32.logxor
| Int64 -> Int64.logxor
let bitwise_or : type w. w t -> w -> w -> w = function
| Byte -> fun a b -> Char.(chr (code a lor code b land 0xff))
| Short -> fun a b -> a lor b land 0xffff
| Int32 -> Int32.logor
| Int64 -> Int64.logor
let invert : type w. w t -> w -> w = function
| Byte -> fun v -> Char.(chr (lnot (code v) land 0xff))
| Short -> fun v -> lnot v land 0xffff
| Int32 -> Int32.lognot
| Int64 -> Int64.lognot
let greater : type w. w t -> w -> w -> bool = function
| Byte -> ( > )
| Short -> ( > )
| Int32 -> ( > )
| Int64 -> ( > )
let lower : type w. w t -> w -> w -> bool = function
| Byte -> ( < )
| Short -> ( < )
| Int32 -> ( < )
| Int64 -> ( < )
let equal : type w. w t -> w -> w -> bool = function
| Byte -> ( = )
| Short -> ( = )
| Int32 -> ( = )
| Int64 -> ( = )
let different : type w. w t -> w -> w -> bool = function
| Byte -> ( <> )
| Short -> ( <> )
| Int32 -> ( <> )
| Int64 -> ( <> )
let zero : type w. w t -> w = function
| Byte -> '\000'
| Short -> 0
| Int32 -> Int32.zero
| Int64 -> Int64.zero
open Sub
let parse s =
let v = to_string s in
let lexbuf = Lexing.from_string v in
if is_empty s then Error `Empty
else
match Lexer.int lexbuf with
| Ok v ->
let first = Lexing.lexeme_end lexbuf in
Ok (Int64.of_string v, with_range ~first s)
| Error `Malformed -> Error (`Invalid_integer v)
| exception _ -> Error (`Invalid_integer v)