Skip to content

Commit 0766477

Browse files
authored
Merge pull request #4098 from BuckleScript/int64_encoding_as_tuple
int64 encoding use tuple to avoid breaking changes
2 parents 369abba + ef9b359 commit 0766477

31 files changed

+4480
-4467
lines changed

jscomp/core/js_long.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,8 @@ let int64_call (fn : string) args =
3535

3636

3737
(* TODO: make layout easier to change later *)
38-
let record_info : Lam_tag_info.t = Blk_record [| "hi"; "lo"|]
38+
let record_info : Lam_tag_info.t =
39+
Blk_record_inlined ([|"hi";"lo"|],"Int64",1)
3940
let make_const ~lo ~hi =
4041
E.make_block
4142
~comment:"int64" (E.zero_int_literal)

jscomp/runtime/caml_int64.ml

Lines changed: 47 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ let ( & ) = Caml_nativeint_extern.logand
4444
let ( << ) = Caml_nativeint_extern.shift_left
4545
let lognot x = Caml_nativeint_extern.logxor x (-1n)
4646

47-
type t = { hi : nativeint; lo : nativeint ; }
47+
type t = Int64 of { hi : nativeint; lo : nativeint ; }
4848

4949
external unsafe_to_int64 : t -> int64 = "%identity"
5050
external unsafe_of_int64 : int64 -> t = "%identity"
@@ -53,8 +53,13 @@ external unsafe_of_int64 : int64 -> t = "%identity"
5353
let to_unsigned (x : nativeint) =
5454
x >>> 0
5555

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+
*)
5863
let min_int = mk ~lo: 0n ~hi:(-0x80000000n)
5964

6065
let max_int =
@@ -69,8 +74,8 @@ let neg_one = mk ~lo:(-1n) ~hi:(-1n)
6974
let neg_signed x = (x & 0x8000_0000n) <> 0n
7075

7176
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) =
7479
let lo = ( this_low_ +~ other_low_) & 0xffff_ffffn in
7580
let overflow =
7681
if (neg_signed this_low_ && (neg_signed other_low_ || not (neg_signed lo)))
@@ -81,9 +86,9 @@ let add
8186
mk ~lo ~hi:(( this_high_ +~ other_high_ +~ overflow) & 0xffff_ffffn)
8287

8388

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)
8590

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
8792

8893
let equal_null x y =
8994
match Js.nullToOption y with
@@ -98,7 +103,7 @@ let equal_nullable x y =
98103
| None -> false
99104
| Some y -> eq x y
100105

101-
let neg ({lo; hi} as x) =
106+
let neg (Int64 {lo; hi} as x) =
102107
if eq x min_int then
103108
min_int
104109
else add (not x) one
@@ -107,11 +112,11 @@ let neg ({lo; hi} as x) =
107112
let sub x y =
108113
add x (neg y)
109114

110-
let lsl_ ({lo; hi} as x) numBits =
115+
let lsl_ (Int64 {lo; hi} as x) numBits =
111116
if numBits = 0 then
112117
x
113118
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))
115120
else
116121
mk ~lo:(Caml_nativeint_extern.shift_left lo numBits)
117122
~hi:
@@ -120,7 +125,7 @@ let lsl_ ({lo; hi} as x) numBits =
120125
(Caml_nativeint_extern.shift_left hi numBits))
121126

122127

123-
let lsr_ ({lo; hi} as x) numBits =
128+
let lsr_ (Int64 {lo; hi} as x) numBits =
124129
if numBits = 0 then x
125130
else
126131
let offset = numBits - 32 in
@@ -137,7 +142,7 @@ let lsr_ ({lo; hi} as x) numBits =
137142
( lo >>> numBits))
138143

139144

140-
let asr_ ({lo; hi } as x) numBits =
145+
let asr_ (Int64 {lo; hi } as x) numBits =
141146
if numBits = 0 then
142147
x
143148
else
@@ -154,25 +159,25 @@ let asr_ ({lo; hi } as x) numBits =
154159

155160

156161
let is_zero = function
157-
| {lo = 0n ; hi = 0n} -> true
162+
| Int64 {lo = 0n ; hi = 0n} -> true
158163
| _ -> false
159164

160165

161166

162167
let rec mul this
163168
other =
164169
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}
167172
-> 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}
170175
->
171176
if (lo & 0x1n) = 0n then
172177
zero
173178
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 }
176181
->
177182
if this_hi < 0n then
178183
if other_hi < 0n then
@@ -222,24 +227,24 @@ let rec mul this
222227

223228

224229

225-
let swap {lo ; hi } =
230+
let swap (Int64 {lo ; hi }) =
226231
mk ~lo:( Caml_int32.caml_int32_bswap hi)
227232
~hi:( Caml_int32.caml_int32_bswap lo)
228233

229234
(* Dispatched by the compiler, idea: should we do maximum sharing
230235
*)
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}) =
232237
mk
233238
~lo:(Caml_nativeint_extern.logxor this_lo other_lo)
234239
~hi:(Caml_nativeint_extern.logxor this_hi other_hi)
235240

236241

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}) =
238243
mk
239244
~lo:(Caml_nativeint_extern.logor this_lo other_lo)
240245
~hi:(Caml_nativeint_extern.logor this_hi other_hi)
241246

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}) =
243248
mk
244249
~lo:(Caml_nativeint_extern.logand this_lo other_lo)
245250
~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} =
253258

254259
type comparison = t -> t -> bool
255260

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 =
257262
if hi > other_hi then true
258263
else if hi < other_hi then false
259264
else lo >= other_lo
@@ -262,7 +267,7 @@ let ge ({hi; lo } : t) ({hi = other_hi; lo = other_lo}) : bool =
262267

263268
let neq x y = Pervasives.not (eq x y)
264269
let lt x y = Pervasives.not (ge x y)
265-
let gt x y =
270+
let gt (Int64 x) (Int64 y) =
266271
if x.hi > y.hi then
267272
true
268273
else if x.hi < y.hi then
@@ -275,7 +280,7 @@ let le x y = Pervasives.not (gt x y)
275280
let min x y = if lt x y then x else y
276281
let max x y = if gt x y then x else y
277282

278-
let to_float ({hi; lo} : t) =
283+
let to_float (Int64 {hi; lo} : t) =
279284
Caml_nativeint_extern.to_float ( hi *~ [%raw{|0x100000000|}] +~ lo)
280285

281286

@@ -316,31 +321,31 @@ external ceil : float -> float = "ceil" [@@bs.val] [@@bs.scope "Math"]
316321

317322
let rec div self other =
318323
match self, other with
319-
| _, {lo = 0n ; hi = 0n} ->
324+
| _, Int64 {lo = 0n ; hi = 0n} ->
320325
raise Division_by_zero
321-
| {lo = 0n; hi = 0n}, _
326+
| Int64 {lo = 0n; hi = 0n}, _
322327
-> zero
323-
| {lo = 0n ; hi = -0x8000_0000n}, _
328+
| Int64 {lo = 0n ; hi = -0x8000_0000n}, _
324329
->
325330
begin
326331
if eq other one || eq other neg_one then self
327332
else if eq other min_int then one
328333
else
329-
let other_hi = other.hi in
334+
let (Int64 {hi = other_hi}) = other in
330335
(* now |other| >= 2, so |this/other| < |MIN_VALUE|*)
331336
let half_this = asr_ self 1 in
332337
let approx = lsl_ (div half_this other) 1 in
333338
match approx with
334-
| {lo = 0n ; hi = 0n}
339+
| Int64 {lo = 0n ; hi = 0n}
335340
-> if other_hi < 0n then one else neg one
336341
| _
337342
->
338343
let rem = sub self (mul other approx) in
339344
add approx (div rem other)
340345
end
341-
| _, {lo = 0n; hi = - 0x8000_0000n}
346+
| _, Int64 {lo = 0n; hi = - 0x8000_0000n}
342347
-> zero
343-
| {lo = _; hi = self_hi}, {lo = _; hi = other_hi}
348+
| Int64 {lo = _; hi = self_hi}, Int64 {lo = _; hi = other_hi}
344349
->
345350
if self_hi < 0n then
346351
if other_hi <0n then
@@ -362,7 +367,7 @@ let rec div self other =
362367
else 2. ** (log2 -. 48.) in
363368
let approxRes = ref (of_float approx.contents) in
364369
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
366371
approx.contents <- approx.contents -. delta;
367372
approxRes.contents <- of_float approx.contents;
368373
approxRem.contents <- mul approxRes.contents other
@@ -382,7 +387,7 @@ let div_mod (self : int64) (other : int64) : int64 * int64 =
382387
let quotient = div (unsafe_of_int64 self) (unsafe_of_int64 other) in
383388
unsafe_to_int64 quotient, unsafe_to_int64 (sub (unsafe_of_int64 self) (mul quotient (unsafe_of_int64 other)))
384389

385-
let compare self other =
390+
let compare (Int64 self) (Int64 other) =
386391
let v = Pervasives.compare self.hi other.hi in
387392
if v = 0 then
388393
Pervasives.compare self.lo other.lo
@@ -391,13 +396,13 @@ let compare self other =
391396
let of_int32 (lo : nativeint) =
392397
mk ~lo ~hi:(if lo < 0n then -1n else 0n)
393398

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 *)
395400

396401

397402
(* width does matter, will it be relevant to endian order? *)
398403

399404
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
401406
let aux v : string =
402407
Caml_string_extern.of_int (Caml_nativeint_extern.to_int (Caml_nativeint_extern.shift_right_logical v 0)) ~base:16
403408
in
@@ -413,8 +418,11 @@ let to_hex (x : int64) =
413418
else
414419
aux x_hi ^ Caml_utils.repeat pad "0" ^ lo
415420

421+
416422
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 })
418426

419427
(* >>> 0 does not change its bit representation
420428
it simply makes sure it is an unsigned integer
@@ -428,7 +436,7 @@ let discard_sign (x : int64) : int64 =
428436
]}
429437
*)
430438

431-
let float_of_bits ( x : t) : float =
439+
let float_of_bits (Int64 x : t) : float =
432440
([%raw{|function(lo,hi){ return (new Float64Array(new Int32Array([lo,hi]).buffer))[0]}|}] : _ -> _ -> _ ) x.lo x.hi
433441

434442
(* let to_int32 (x : nativeint) = x |> Caml_nativeint_extern.to_int32

jscomp/test/bs_min_max_test.js

Lines changed: 32 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -43,38 +43,38 @@ var f5_min = Caml_obj.caml_min;
4343

4444
var f5_max = Caml_obj.caml_max;
4545

46-
b("File \"bs_min_max_test.ml\", line 28, characters 4-11", Caml_int64.eq(Caml_int64.min(/* int64 */{
47-
hi: 0,
48-
lo: 0
49-
}, /* int64 */{
50-
hi: 0,
51-
lo: 1
52-
}), /* int64 */{
53-
hi: 0,
54-
lo: 0
55-
}));
56-
57-
b("File \"bs_min_max_test.ml\", line 29, characters 4-11", Caml_int64.eq(Caml_int64.max(/* int64 */{
58-
hi: 0,
59-
lo: 22
60-
}, /* int64 */{
61-
hi: 0,
62-
lo: 1
63-
}), /* int64 */{
64-
hi: 0,
65-
lo: 22
66-
}));
67-
68-
b("File \"bs_min_max_test.ml\", line 30, characters 4-11", Caml_int64.eq(Caml_int64.max(/* int64 */{
69-
hi: -1,
70-
lo: 4294967293
71-
}, /* int64 */{
72-
hi: 0,
73-
lo: 3
74-
}), /* int64 */{
75-
hi: 0,
76-
lo: 3
77-
}));
46+
b("File \"bs_min_max_test.ml\", line 28, characters 4-11", Caml_int64.eq(Caml_int64.min(/* int64 */[
47+
/* hi */0,
48+
/* lo */0
49+
], /* int64 */[
50+
/* hi */0,
51+
/* lo */1
52+
]), /* int64 */[
53+
/* hi */0,
54+
/* lo */0
55+
]));
56+
57+
b("File \"bs_min_max_test.ml\", line 29, characters 4-11", Caml_int64.eq(Caml_int64.max(/* int64 */[
58+
/* hi */0,
59+
/* lo */22
60+
], /* int64 */[
61+
/* hi */0,
62+
/* lo */1
63+
]), /* int64 */[
64+
/* hi */0,
65+
/* lo */22
66+
]));
67+
68+
b("File \"bs_min_max_test.ml\", line 30, characters 4-11", Caml_int64.eq(Caml_int64.max(/* int64 */[
69+
/* hi */-1,
70+
/* lo */4294967293
71+
], /* int64 */[
72+
/* hi */0,
73+
/* lo */3
74+
]), /* int64 */[
75+
/* hi */0,
76+
/* lo */3
77+
]));
7878

7979
eq("File \"bs_min_max_test.ml\", line 31, characters 5-12", Caml_obj.caml_min(undefined, 3), undefined);
8080

0 commit comments

Comments
 (0)