@@ -44,7 +44,7 @@ let ( & ) = Caml_nativeint_extern.logand
44
44
let ( << ) = Caml_nativeint_extern. shift_left
45
45
let lognot x = Caml_nativeint_extern. logxor x (- 1n )
46
46
47
- type t = { hi : nativeint ; lo : nativeint ; }
47
+ type t = Int64 of { hi : nativeint ; lo : nativeint ; }
48
48
49
49
external unsafe_to_int64 : t -> int64 = " %identity"
50
50
external unsafe_of_int64 : int64 -> t = " %identity"
@@ -53,8 +53,13 @@ external unsafe_of_int64 : int64 -> t = "%identity"
53
53
let to_unsigned (x : nativeint ) =
54
54
x >>> 0
55
55
56
- let mk ~lo ~hi = {lo = to_unsigned lo ; hi}
57
-
56
+ let mk ~lo ~hi = Int64 {lo = to_unsigned lo ; hi}
57
+ (*
58
+ module N = struct
59
+ type nonrec t = t = private { hi : nativeint; lo : nativeint ; }
60
+ end
61
+ open N
62
+ *)
58
63
let min_int = mk ~lo: 0n ~hi: (- 0x80000000n )
59
64
60
65
let max_int =
@@ -69,8 +74,8 @@ let neg_one = mk ~lo:(-1n) ~hi:(-1n)
69
74
let neg_signed x = (x & 0x8000_0000n ) <> 0n
70
75
71
76
let add
72
- ({lo = this_low_ ; hi = this_high_ } : t )
73
- ({lo = other_low_ ; hi = other_high_ } : t ) =
77
+ (Int64 {lo = this_low_ ; hi = this_high_ } : t )
78
+ (Int64 {lo = other_low_ ; hi = other_high_ } : t ) =
74
79
let lo = ( this_low_ +~ other_low_) & 0xffff_ffffn in
75
80
let overflow =
76
81
if (neg_signed this_low_ && (neg_signed other_low_ || not (neg_signed lo)))
@@ -81,9 +86,9 @@ let add
81
86
mk ~lo ~hi: (( this_high_ +~ other_high_ +~ overflow) & 0xffff_ffffn )
82
87
83
88
84
- let not {lo; hi } = mk ~lo: (lognot lo) ~hi: (lognot hi)
89
+ let not (Int64 {lo; hi } ) = mk ~lo: (lognot lo) ~hi: (lognot hi)
85
90
86
- let eq x y = x.hi = y.hi && x.lo = y.lo
91
+ let eq (Int64 x ) (Int64 y ) = x.hi = y.hi && x.lo = y.lo
87
92
88
93
let equal_null x y =
89
94
match Js. nullToOption y with
@@ -98,7 +103,7 @@ let equal_nullable x y =
98
103
| None -> false
99
104
| Some y -> eq x y
100
105
101
- let neg ({lo; hi} as x ) =
106
+ let neg (Int64 {lo; hi} as x ) =
102
107
if eq x min_int then
103
108
min_int
104
109
else add (not x) one
@@ -107,11 +112,11 @@ let neg ({lo; hi} as x) =
107
112
let sub x y =
108
113
add x (neg y)
109
114
110
- let lsl_ ({lo; hi} as x ) numBits =
115
+ let lsl_ (Int64 {lo; hi} as x ) numBits =
111
116
if numBits = 0 then
112
117
x
113
118
else if numBits > = 32 then
114
- {lo = 0n ; hi = Caml_nativeint_extern. shift_left lo (numBits - 32 ) }
119
+ mk ~lo: 0n ~hi: ( Caml_nativeint_extern. shift_left lo (numBits - 32 ))
115
120
else
116
121
mk ~lo: (Caml_nativeint_extern. shift_left lo numBits)
117
122
~hi:
@@ -120,7 +125,7 @@ let lsl_ ({lo; hi} as x) numBits =
120
125
(Caml_nativeint_extern. shift_left hi numBits))
121
126
122
127
123
- let lsr_ ({lo; hi} as x ) numBits =
128
+ let lsr_ (Int64 {lo; hi} as x ) numBits =
124
129
if numBits = 0 then x
125
130
else
126
131
let offset = numBits - 32 in
@@ -137,7 +142,7 @@ let lsr_ ({lo; hi} as x) numBits =
137
142
( lo >>> numBits))
138
143
139
144
140
- let asr_ ({lo; hi } as x ) numBits =
145
+ let asr_ (Int64 {lo; hi } as x ) numBits =
141
146
if numBits = 0 then
142
147
x
143
148
else
@@ -154,25 +159,25 @@ let asr_ ({lo; hi } as x) numBits =
154
159
155
160
156
161
let is_zero = function
157
- | {lo = 0n ; hi = 0n } -> true
162
+ | Int64 {lo = 0n ; hi = 0n } -> true
158
163
| _ -> false
159
164
160
165
161
166
162
167
let rec mul this
163
168
other =
164
169
match this, other with
165
- | {lo = 0n ; hi = 0n }, _
166
- | _, {lo = 0n ; hi = 0n }
170
+ | Int64 {lo = 0n ; hi = 0n }, _
171
+ | _, Int64 {lo = 0n ; hi = 0n }
167
172
-> zero
168
- | {lo = 0n ; hi = - 0x80000000n }, {lo }
169
- | {lo}, {lo = 0n ; hi = - 0x80000000n }
173
+ | Int64 {lo = 0n ; hi = - 0x80000000n }, Int64 {lo }
174
+ | Int64 {lo}, Int64 {lo = 0n ; hi = - 0x80000000n }
170
175
->
171
176
if (lo & 0x1n ) = 0n then
172
177
zero
173
178
else min_int
174
- | {lo = this_lo; hi = this_hi},
175
- {lo = other_lo; hi = other_hi }
179
+ | Int64 {lo = this_lo; hi = this_hi},
180
+ Int64 {lo = other_lo; hi = other_hi }
176
181
->
177
182
if this_hi < 0n then
178
183
if other_hi < 0n then
@@ -222,24 +227,24 @@ let rec mul this
222
227
223
228
224
229
225
- let swap {lo ; hi } =
230
+ let swap (Int64 {lo ; hi } ) =
226
231
mk ~lo: ( Caml_int32. caml_int32_bswap hi)
227
232
~hi: ( Caml_int32. caml_int32_bswap lo)
228
233
229
234
(* Dispatched by the compiler, idea: should we do maximum sharing
230
235
*)
231
- let xor {lo = this_lo ; hi = this_hi } {lo = other_lo ; hi = other_hi } =
236
+ let xor (Int64 {lo = this_lo ; hi = this_hi } ) (Int64 {lo = other_lo ; hi = other_hi } ) =
232
237
mk
233
238
~lo: (Caml_nativeint_extern. logxor this_lo other_lo)
234
239
~hi: (Caml_nativeint_extern. logxor this_hi other_hi)
235
240
236
241
237
- let or_ {lo = this_lo ; hi = this_hi } {lo = other_lo ; hi = other_hi } =
242
+ let or_ (Int64 {lo = this_lo ; hi = this_hi } ) (Int64 {lo = other_lo ; hi = other_hi } ) =
238
243
mk
239
244
~lo: (Caml_nativeint_extern. logor this_lo other_lo)
240
245
~hi: (Caml_nativeint_extern. logor this_hi other_hi)
241
246
242
- let and_ {lo = this_lo ; hi = this_hi } {lo = other_lo ; hi = other_hi } =
247
+ let and_ (Int64 {lo = this_lo ; hi = this_hi } ) (Int64 {lo = other_lo ; hi = other_hi } ) =
243
248
mk
244
249
~lo: (Caml_nativeint_extern. logand this_lo other_lo)
245
250
~hi: (Caml_nativeint_extern. logand this_hi other_hi)
@@ -253,7 +258,7 @@ let and_ {lo = this_lo; hi= this_hi} {lo = other_lo; hi = other_hi} =
253
258
254
259
type comparison = t -> t -> bool
255
260
256
- let ge ({hi; lo } : t ) ({hi = other_hi ; lo = other_lo } ) : bool =
261
+ let ge (Int64 {hi; lo } : t ) (Int64 {hi = other_hi ; lo = other_lo } ) : bool =
257
262
if hi > other_hi then true
258
263
else if hi < other_hi then false
259
264
else lo > = other_lo
@@ -262,7 +267,7 @@ let ge ({hi; lo } : t) ({hi = other_hi; lo = other_lo}) : bool =
262
267
263
268
let neq x y = Pervasives. not (eq x y)
264
269
let lt x y = Pervasives. not (ge x y)
265
- let gt x y =
270
+ let gt (Int64 x ) (Int64 y ) =
266
271
if x.hi > y.hi then
267
272
true
268
273
else if x.hi < y.hi then
@@ -275,7 +280,7 @@ let le x y = Pervasives.not (gt x y)
275
280
let min x y = if lt x y then x else y
276
281
let max x y = if gt x y then x else y
277
282
278
- let to_float ({hi; lo} : t ) =
283
+ let to_float (Int64 {hi; lo} : t ) =
279
284
Caml_nativeint_extern. to_float ( hi *~ [% raw{| 0x100000000 | }] +~ lo)
280
285
281
286
@@ -316,31 +321,31 @@ external ceil : float -> float = "ceil" [@@bs.val] [@@bs.scope "Math"]
316
321
317
322
let rec div self other =
318
323
match self, other with
319
- | _ , {lo = 0n ; hi = 0n } ->
324
+ | _ , Int64 {lo = 0n ; hi = 0n } ->
320
325
raise Division_by_zero
321
- | {lo = 0n ; hi = 0n }, _
326
+ | Int64 {lo = 0n ; hi = 0n }, _
322
327
-> zero
323
- | {lo = 0n ; hi = - 0x8000_0000n }, _
328
+ | Int64 {lo = 0n ; hi = - 0x8000_0000n }, _
324
329
->
325
330
begin
326
331
if eq other one || eq other neg_one then self
327
332
else if eq other min_int then one
328
333
else
329
- let other_hi = other.hi in
334
+ let ( Int64 {hi = other_hi}) = other in
330
335
(* now |other| >= 2, so |this/other| < |MIN_VALUE|*)
331
336
let half_this = asr_ self 1 in
332
337
let approx = lsl_ (div half_this other) 1 in
333
338
match approx with
334
- | {lo = 0n ; hi = 0n }
339
+ | Int64 {lo = 0n ; hi = 0n }
335
340
-> if other_hi < 0n then one else neg one
336
341
| _
337
342
->
338
343
let rem = sub self (mul other approx) in
339
344
add approx (div rem other)
340
345
end
341
- | _, {lo = 0n ; hi = - 0x8000_0000n }
346
+ | _, Int64 {lo = 0n ; hi = - 0x8000_0000n }
342
347
-> zero
343
- | {lo = _; hi = self_hi}, {lo = _; hi = other_hi}
348
+ | Int64 {lo = _; hi = self_hi}, Int64 {lo = _; hi = other_hi}
344
349
->
345
350
if self_hi < 0n then
346
351
if other_hi < 0n then
@@ -362,7 +367,7 @@ let rec div self other =
362
367
else 2. ** (log2 -. 48. ) in
363
368
let approxRes = ref (of_float approx.contents) in
364
369
let approxRem = ref (mul approxRes.contents other) in
365
- while approxRem.contents.hi < 0n || gt approxRem.contents rem.contents do
370
+ while ( match approxRem.contents with Int64 {hi} -> hi) < 0n || gt approxRem.contents rem.contents do
366
371
approx.contents < - approx.contents -. delta;
367
372
approxRes.contents < - of_float approx.contents;
368
373
approxRem.contents < - mul approxRes.contents other
@@ -382,7 +387,7 @@ let div_mod (self : int64) (other : int64) : int64 * int64 =
382
387
let quotient = div (unsafe_of_int64 self) (unsafe_of_int64 other) in
383
388
unsafe_to_int64 quotient, unsafe_to_int64 (sub (unsafe_of_int64 self) (mul quotient (unsafe_of_int64 other)))
384
389
385
- let compare self other =
390
+ let compare (Int64 self ) (Int64 other ) =
386
391
let v = Pervasives. compare self.hi other.hi in
387
392
if v = 0 then
388
393
Pervasives. compare self.lo other.lo
@@ -391,13 +396,13 @@ let compare self other =
391
396
let of_int32 (lo : nativeint ) =
392
397
mk ~lo ~hi: (if lo < 0n then - 1n else 0n )
393
398
394
- let to_int32 x = Caml_nativeint_extern. logor x.lo 0n (* signed integer *)
399
+ let to_int32 (Int64 x ) = Caml_nativeint_extern. logor x.lo 0n (* signed integer *)
395
400
396
401
397
402
(* width does matter, will it be relevant to endian order? *)
398
403
399
404
let to_hex (x : int64 ) =
400
- let {hi = x_hi; lo = x_lo} = unsafe_of_int64 x in
405
+ let Int64 {hi = x_hi; lo = x_lo} = unsafe_of_int64 x in
401
406
let aux v : string =
402
407
Caml_string_extern. of_int (Caml_nativeint_extern. to_int (Caml_nativeint_extern. shift_right_logical v 0 )) ~base: 16
403
408
in
@@ -413,8 +418,11 @@ let to_hex (x : int64) =
413
418
else
414
419
aux x_hi ^ Caml_utils. repeat pad " 0" ^ lo
415
420
421
+
416
422
let discard_sign (x : int64 ) : int64 =
417
- unsafe_to_int64 { (unsafe_of_int64 x) with hi = Caml_nativeint_extern. logand 0x7fff_ffffn (unsafe_of_int64 x).hi }
423
+ let v = unsafe_of_int64 x in
424
+ unsafe_to_int64
425
+ (match v with Int64 v -> Int64 { v with hi = Caml_nativeint_extern. logand 0x7fff_ffffn v.hi })
418
426
419
427
(* >>> 0 does not change its bit representation
420
428
it simply makes sure it is an unsigned integer
@@ -428,7 +436,7 @@ let discard_sign (x : int64) : int64 =
428
436
]}
429
437
*)
430
438
431
- let float_of_bits ( x : t ) : float =
439
+ let float_of_bits (Int64 x : t ) : float =
432
440
([% raw{| function (lo ,hi ){ return (new Float64Array(new Int32Array([lo,hi]).buffer))[0]} |}] : _ -> _ -> _ ) x.lo x.hi
433
441
434
442
(* let to_int32 (x : nativeint) = x |> Caml_nativeint_extern.to_int32
0 commit comments