Skip to content

Commit 82d5044

Browse files
authored
flambda-backend: Enhance numbers.ml with more primitive types (#544)
1 parent 216be99 commit 82d5044

File tree

2 files changed

+204
-0
lines changed

2 files changed

+204
-0
lines changed

utils/numbers.ml

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,11 +48,34 @@ module Int8 = struct
4848
i
4949

5050
let to_int i = i
51+
52+
let print ppf t = Format.pp_print_int ppf t
53+
end
54+
55+
module Uint8 = struct
56+
type t = int
57+
58+
let print ppf t = Format.pp_print_int ppf t
59+
60+
let zero = 0
61+
62+
let one = 1
63+
64+
let of_nonnegative_int_exn i =
65+
if i < 0 || i > (1 lsl 8) - 1
66+
then Misc.fatal_errorf "Uint8.of_nonnegative_int_exn: %d is out of range" i
67+
else i
68+
69+
let to_int i = i
5170
end
5271

5372
module Int16 = struct
5473
type t = int
5574

75+
let zero = 0
76+
77+
let one = 1
78+
5679
let of_int_exn i =
5780
if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then
5881
Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i
@@ -71,8 +94,115 @@ module Int16 = struct
7194
Int64.to_int i
7295

7396
let to_int t = t
97+
98+
let print ppf t = Format.pp_print_int ppf t
99+
end
100+
101+
module Uint16 = struct
102+
type t = int
103+
104+
let print ppf t = Format.pp_print_int ppf t
105+
106+
let of_nonnegative_int_exn i =
107+
if i < 0 || i > (1 lsl 16) - 1
108+
then Misc.fatal_errorf "Uint16.of_nonnegative_int_exn: %d is out of range" i
109+
else i
110+
111+
let upper_int64 = Int64.sub (Int64.shift_left Int64.one 16) Int64.one
112+
113+
let of_nonnegative_int64_exn i =
114+
if Int64.compare i 0L < 0 || Int64.compare i upper_int64 > 0
115+
then
116+
Misc.fatal_errorf "Uint16.of_nonnegative_int64_exn: %Ld is out of range" i
117+
else Int64.to_int i
118+
119+
let to_int t = t
120+
end
121+
122+
module Uint32 = struct
123+
type t = Int64.t
124+
125+
let zero = 0L
126+
127+
let print ppf t = Format.fprintf ppf "0x%Lx" t
128+
129+
let upper_int64 = Int64.sub (Int64.shift_left Int64.one 32) Int64.one
130+
131+
let of_nonnegative_int_exn i =
132+
if i < 0
133+
then Misc.fatal_errorf "Uint32.of_nonnegative_int_exn: %d is out of range" i
134+
else
135+
let i64 = Int64.of_int i in
136+
if Int64.compare i64 upper_int64 > 0
137+
then
138+
Misc.fatal_errorf "Uint32.of_nonnegative_int_exn: %d is out of range" i
139+
else i64
140+
141+
let of_nonnegative_int64_exn i =
142+
if Int64.compare i 0L < 0 || Int64.compare i upper_int64 > 0
143+
then
144+
Misc.fatal_errorf "Uint32.of_nonnegative_int64_exn: %Ld is out of range" i
145+
else i
146+
147+
let of_nonnegative_int32_exn i =
148+
if Int32.compare i 0l < 0
149+
then
150+
Misc.fatal_errorf "Uint32.of_nonnegative_int32_exn: %ld is out of range" i
151+
else Int64.of_int32 i
152+
153+
let to_int64 t = t
154+
end
155+
156+
module Uint64 = struct
157+
type t = Int64.t
158+
159+
let zero = 0L
160+
161+
let succ t = Int64.add 1L t
162+
163+
let of_nonnegative_int_exn i =
164+
if i < 0
165+
then Misc.fatal_errorf "Uint64.of_nonnegative_int_exn: %d is out of range" i
166+
else Int64.of_int i
167+
168+
let of_uint8 i = Int64.of_int i
169+
170+
let of_uint16 i = Int64.of_int i
171+
172+
let of_uint32 i = i
173+
174+
let of_nonnegative_int32_exn i =
175+
if Int32.compare i 0l < 0
176+
then
177+
Misc.fatal_errorf "Uint64.of_nonnegative_int32_exn: %ld is out of range" i
178+
else Int64.of_int32 i
179+
180+
let of_nonnegative_int64_exn i =
181+
if Int64.compare i 0L < 0
182+
then
183+
Misc.fatal_errorf "Uint64.of_nonnegative_int64_exn: %Ld is out of range" i
184+
else i
185+
186+
let to_int64 t = t
187+
188+
include Identifiable.Make (struct
189+
type nonrec t = t
190+
191+
let compare t1 t2 =
192+
(* Only a consistent order is needed here *)
193+
Int64.compare t1 t2
194+
195+
let equal t1 t2 = compare t1 t2 = 0
196+
197+
let hash t = Hashtbl.hash t
198+
199+
let print ppf t = Format.fprintf ppf "0x%Lx" t
200+
201+
let output _ _ = Misc.fatal_error "Not yet implemented"
202+
end)
74203
end
75204

205+
76206
module Float = struct
77207
type t = float
78208

utils/numbers.mli

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,15 +37,89 @@ module Int8 : sig
3737

3838
val of_int_exn : int -> t
3939
val to_int : t -> int
40+
val print : Format.formatter -> t -> unit
41+
end
42+
43+
(** Do not use polymorphic comparison on the unsigned integer types. *)
44+
45+
module Uint8 : sig
46+
type t
47+
48+
val print : Format.formatter -> t -> unit
49+
50+
val zero : t
51+
52+
val one : t
53+
54+
val of_nonnegative_int_exn : int -> t
55+
56+
val to_int : t -> int
4057
end
4158

4259
module Int16 : sig
4360
type t
4461

62+
val zero : t
63+
val one : t
64+
4565
val of_int_exn : int -> t
4666
val of_int64_exn : Int64.t -> t
4767

4868
val to_int : t -> int
69+
val print : Format.formatter -> t -> unit
70+
end
71+
72+
module Uint16 : sig
73+
type t
74+
75+
val print : Format.formatter -> t -> unit
76+
77+
val of_nonnegative_int_exn : int -> t
78+
79+
val of_nonnegative_int64_exn : Int64.t -> t
80+
81+
val to_int : t -> int
82+
end
83+
84+
module Uint32 : sig
85+
type t
86+
87+
val print : Format.formatter -> t -> unit
88+
89+
val zero : t
90+
91+
val of_nonnegative_int_exn : int -> t
92+
93+
val of_nonnegative_int32_exn : Int32.t -> t
94+
95+
val of_nonnegative_int64_exn : Int64.t -> t
96+
97+
val to_int64 : t -> Int64.t
98+
end
99+
100+
module Uint64 : sig
101+
type t
102+
103+
val zero : t
104+
105+
val succ : t -> t
106+
107+
val of_uint8 : Uint8.t -> t
108+
109+
val of_uint16 : Uint16.t -> t
110+
111+
val of_uint32 : Uint32.t -> t
112+
113+
val of_nonnegative_int_exn : int -> t
114+
115+
val of_nonnegative_int32_exn : Int32.t -> t
116+
117+
val of_nonnegative_int64_exn : Int64.t -> t
118+
119+
val to_int64 : t -> Int64.t
120+
121+
include Identifiable.S with type t := t
49122
end
50123

124+
51125
module Float : Identifiable.S with type t = float

0 commit comments

Comments
 (0)