@@ -44,7 +44,7 @@ let ( & ) = Caml_nativeint_extern.logand
4444let ( << ) = Caml_nativeint_extern. shift_left
4545let 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
4949external unsafe_to_int64 : t -> int64 = " %identity"
5050external unsafe_of_int64 : int64 -> t = " %identity"
@@ -53,7 +53,7 @@ external unsafe_of_int64 : int64 -> t = "%identity"
5353let to_unsigned (x : nativeint ) =
5454 x >>> 0
5555
56- let mk ~lo ~hi = {lo = to_unsigned lo ; hi}
56+ let mk ~lo ~hi = Int64 {lo = to_unsigned lo ; hi}
5757(*
5858module N = struct
5959type nonrec t = t = private { hi : nativeint; lo : nativeint ; }
@@ -74,8 +74,8 @@ let neg_one = mk ~lo:(-1n) ~hi:(-1n)
7474let neg_signed x = (x & 0x8000_0000n ) <> 0n
7575
7676let add
77- ({lo = this_low_ ; hi = this_high_ } : t )
78- ({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 ) =
7979 let lo = ( this_low_ +~ other_low_) & 0xffff_ffffn in
8080 let overflow =
8181 if (neg_signed this_low_ && (neg_signed other_low_ || not (neg_signed lo)))
@@ -86,9 +86,9 @@ let add
8686 mk ~lo ~hi: (( this_high_ +~ other_high_ +~ overflow) & 0xffff_ffffn )
8787
8888
89- let not {lo; hi } = mk ~lo: (lognot lo) ~hi: (lognot hi)
89+ let not (Int64 {lo; hi } ) = mk ~lo: (lognot lo) ~hi: (lognot hi)
9090
91- 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
9292
9393let equal_null x y =
9494 match Js. nullToOption y with
@@ -103,7 +103,7 @@ let equal_nullable x y =
103103 | None -> false
104104 | Some y -> eq x y
105105
106- let neg ({lo; hi} as x ) =
106+ let neg (Int64 {lo; hi} as x ) =
107107 if eq x min_int then
108108 min_int
109109 else add (not x) one
@@ -112,7 +112,7 @@ let neg ({lo; hi} as x) =
112112let sub x y =
113113 add x (neg y)
114114
115- let lsl_ ({lo; hi} as x ) numBits =
115+ let lsl_ (Int64 {lo; hi} as x ) numBits =
116116 if numBits = 0 then
117117 x
118118 else if numBits > = 32 then
@@ -125,7 +125,7 @@ let lsl_ ({lo; hi} as x) numBits =
125125 (Caml_nativeint_extern. shift_left hi numBits))
126126
127127
128- let lsr_ ({lo; hi} as x ) numBits =
128+ let lsr_ (Int64 {lo; hi} as x ) numBits =
129129 if numBits = 0 then x
130130 else
131131 let offset = numBits - 32 in
@@ -142,7 +142,7 @@ let lsr_ ({lo; hi} as x) numBits =
142142 ( lo >>> numBits))
143143
144144
145- let asr_ ({lo; hi } as x ) numBits =
145+ let asr_ (Int64 {lo; hi } as x ) numBits =
146146 if numBits = 0 then
147147 x
148148 else
@@ -159,25 +159,25 @@ let asr_ ({lo; hi } as x) numBits =
159159
160160
161161let is_zero = function
162- | {lo = 0n ; hi = 0n } -> true
162+ | Int64 {lo = 0n ; hi = 0n } -> true
163163 | _ -> false
164164
165165
166166
167167let rec mul this
168168 other =
169169 match this, other with
170- | {lo = 0n ; hi = 0n }, _
171- | _, {lo = 0n ; hi = 0n }
170+ | Int64 {lo = 0n ; hi = 0n }, _
171+ | _, Int64 {lo = 0n ; hi = 0n }
172172 -> zero
173- | {lo = 0n ; hi = - 0x80000000n }, {lo }
174- | {lo}, {lo = 0n ; hi = - 0x80000000n }
173+ | Int64 {lo = 0n ; hi = - 0x80000000n }, Int64 {lo }
174+ | Int64 {lo}, Int64 {lo = 0n ; hi = - 0x80000000n }
175175 ->
176176 if (lo & 0x1n ) = 0n then
177177 zero
178178 else min_int
179- | {lo = this_lo; hi = this_hi},
180- {lo = other_lo; hi = other_hi }
179+ | Int64 {lo = this_lo; hi = this_hi},
180+ Int64 {lo = other_lo; hi = other_hi }
181181 ->
182182 if this_hi < 0n then
183183 if other_hi < 0n then
@@ -227,24 +227,24 @@ let rec mul this
227227
228228
229229
230- let swap {lo ; hi } =
230+ let swap (Int64 {lo ; hi } ) =
231231 mk ~lo: ( Caml_int32. caml_int32_bswap hi)
232232 ~hi: ( Caml_int32. caml_int32_bswap lo)
233233
234234(* Dispatched by the compiler, idea: should we do maximum sharing
235235*)
236- 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 } ) =
237237 mk
238238 ~lo: (Caml_nativeint_extern. logxor this_lo other_lo)
239239 ~hi: (Caml_nativeint_extern. logxor this_hi other_hi)
240240
241241
242- 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 } ) =
243243 mk
244244 ~lo: (Caml_nativeint_extern. logor this_lo other_lo)
245245 ~hi: (Caml_nativeint_extern. logor this_hi other_hi)
246246
247- 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 } ) =
248248 mk
249249 ~lo: (Caml_nativeint_extern. logand this_lo other_lo)
250250 ~hi: (Caml_nativeint_extern. logand this_hi other_hi)
@@ -258,7 +258,7 @@ let and_ {lo = this_lo; hi= this_hi} {lo = other_lo; hi = other_hi} =
258258
259259type comparison = t -> t -> bool
260260
261- 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 =
262262 if hi > other_hi then true
263263 else if hi < other_hi then false
264264 else lo > = other_lo
@@ -267,7 +267,7 @@ let ge ({hi; lo } : t) ({hi = other_hi; lo = other_lo}) : bool =
267267
268268let neq x y = Pervasives. not (eq x y)
269269let lt x y = Pervasives. not (ge x y)
270- let gt x y =
270+ let gt (Int64 x ) (Int64 y ) =
271271 if x.hi > y.hi then
272272 true
273273 else if x.hi < y.hi then
@@ -280,7 +280,7 @@ let le x y = Pervasives.not (gt x y)
280280let min x y = if lt x y then x else y
281281let max x y = if gt x y then x else y
282282
283- let to_float ({hi; lo} : t ) =
283+ let to_float (Int64 {hi; lo} : t ) =
284284 Caml_nativeint_extern. to_float ( hi *~ [% raw{| 0x100000000 | }] +~ lo)
285285
286286
@@ -321,31 +321,31 @@ external ceil : float -> float = "ceil" [@@bs.val] [@@bs.scope "Math"]
321321
322322let rec div self other =
323323 match self, other with
324- | _ , {lo = 0n ; hi = 0n } ->
324+ | _ , Int64 {lo = 0n ; hi = 0n } ->
325325 raise Division_by_zero
326- | {lo = 0n ; hi = 0n }, _
326+ | Int64 {lo = 0n ; hi = 0n }, _
327327 -> zero
328- | {lo = 0n ; hi = - 0x8000_0000n }, _
328+ | Int64 {lo = 0n ; hi = - 0x8000_0000n }, _
329329 ->
330330 begin
331331 if eq other one || eq other neg_one then self
332332 else if eq other min_int then one
333333 else
334- let other_hi = other.hi in
334+ let ( Int64 {hi = other_hi}) = other in
335335 (* now |other| >= 2, so |this/other| < |MIN_VALUE|*)
336336 let half_this = asr_ self 1 in
337337 let approx = lsl_ (div half_this other) 1 in
338338 match approx with
339- | {lo = 0n ; hi = 0n }
339+ | Int64 {lo = 0n ; hi = 0n }
340340 -> if other_hi < 0n then one else neg one
341341 | _
342342 ->
343343 let rem = sub self (mul other approx) in
344344 add approx (div rem other)
345345 end
346- | _, {lo = 0n ; hi = - 0x8000_0000n }
346+ | _, Int64 {lo = 0n ; hi = - 0x8000_0000n }
347347 -> zero
348- | {lo = _; hi = self_hi}, {lo = _; hi = other_hi}
348+ | Int64 {lo = _; hi = self_hi}, Int64 {lo = _; hi = other_hi}
349349 ->
350350 if self_hi < 0n then
351351 if other_hi < 0n then
@@ -367,7 +367,7 @@ let rec div self other =
367367 else 2. ** (log2 -. 48. ) in
368368 let approxRes = ref (of_float approx.contents) in
369369 let approxRem = ref (mul approxRes.contents other) in
370- 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
371371 approx.contents < - approx.contents -. delta;
372372 approxRes.contents < - of_float approx.contents;
373373 approxRem.contents < - mul approxRes.contents other
@@ -387,7 +387,7 @@ let div_mod (self : int64) (other : int64) : int64 * int64 =
387387 let quotient = div (unsafe_of_int64 self) (unsafe_of_int64 other) in
388388 unsafe_to_int64 quotient, unsafe_to_int64 (sub (unsafe_of_int64 self) (mul quotient (unsafe_of_int64 other)))
389389
390- let compare self other =
390+ let compare (Int64 self ) (Int64 other ) =
391391 let v = Pervasives. compare self.hi other.hi in
392392 if v = 0 then
393393 Pervasives. compare self.lo other.lo
@@ -396,13 +396,13 @@ let compare self other =
396396let of_int32 (lo : nativeint ) =
397397 mk ~lo ~hi: (if lo < 0n then - 1n else 0n )
398398
399- 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 *)
400400
401401
402402(* width does matter, will it be relevant to endian order? *)
403403
404404let to_hex (x : int64 ) =
405- 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
406406 let aux v : string =
407407 Caml_string_extern. of_int (Caml_nativeint_extern. to_int (Caml_nativeint_extern. shift_right_logical v 0 )) ~base: 16
408408 in
@@ -422,7 +422,7 @@ let to_hex (x : int64) =
422422let discard_sign (x : int64 ) : int64 =
423423 let v = unsafe_of_int64 x in
424424 unsafe_to_int64
425- { v with hi = Caml_nativeint_extern. logand 0x7fff_ffffn v.hi }
425+ ( match v with Int64 v -> Int64 { v with hi = Caml_nativeint_extern. logand 0x7fff_ffffn v.hi })
426426
427427(* >>> 0 does not change its bit representation
428428 it simply makes sure it is an unsigned integer
@@ -436,7 +436,7 @@ let discard_sign (x : int64) : int64 =
436436 ]}
437437*)
438438
439- let float_of_bits ( x : t ) : float =
439+ let float_of_bits (Int64 x : t ) : float =
440440 ([% raw{| function (lo ,hi ){ return (new Float64Array(new Int32Array([lo,hi]).buffer))[0]} |}] : _ -> _ -> _ ) x.lo x.hi
441441
442442 (* let to_int32 (x : nativeint) = x |> Caml_nativeint_extern.to_int32
0 commit comments