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
127
128
129
(* SPDX-License-Identifier: Apache-2.0 *)
(* Copyright 2017 WebAssembly Community Group participants *)
(* This file is originally from the WebAssembly reference interpreter available at https://github.com/WebAssembly/spec/tree/main/interpreter *)
(* SPDX-License-Identifier: MIT *)
(* Copyright (c) 2016--2024 Jane Street Group, LLC <opensource-contacts@janestreet.com> *)
(* The code of the `popcnt` function is originally from the `base` library available at https://github.com/janestreet/base *)
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2024 OCamlPro *)
(* Modified by the Owi programmers *)
include Prelude.Int64
let clz n = of_int (Ocaml_intrinsics.Int64.count_leading_zeros n)
let ctz n = of_int (Ocaml_intrinsics.Int64.count_trailing_zeros n)
(* Taken from Base *)
let popcnt =
let ( + ) = add in
let ( - ) = sub in
let ( * ) = mul in
let ( lsr ) = shift_right_logical in
let ( land ) = logand in
let m1 = 0x5555555555555555L in
(* 0b01010101... *)
let m2 = 0x3333333333333333L in
(* 0b00110011... *)
let m4 = 0x0f0f0f0f0f0f0f0fL in
(* 0b00001111... *)
let h01 = 0x0101010101010101L in
(* 1 bit set per byte *)
fun[@inline] x ->
(* gather the bit count for every pair of bits *)
let x = x - ((x lsr 1) land m1) in
(* gather the bit count for every 4 bits *)
let x = (x land m2) + ((x lsr 2) land m2) in
(* gather the bit count for every byte *)
let x = (x + (x lsr 4)) land m4 in
(* sum the bit counts in the top byte and shift it down *)
(x * h01) lsr 56
let eq (x : int64) y = equal x y [@@inline]
let ne (x : int64) y = not (equal x y) [@@inline]
let lt (x : int64) y = compare x y < 0 [@@inline]
let le (x : int64) y = compare x y <= 0 [@@inline]
let lt_u (x : int64) y = unsigned_compare x y < 0 [@@inline]
let le_u (x : int64) y = unsigned_compare x y <= 0 [@@inline]
(* In OCaml, `shift_{left,right,right_logical} are unspecified if y < 0 or y >= 64, but they're not in Wasm and thus we need to mask `y`` to only keep the low 7 bits. *)
let shl x y = shift_left x (to_int (logand y 63L)) [@@inline]
let ashr x y = shift_right x (to_int (logand y 63L)) [@@inline]
let lshr x y = shift_right_logical x (to_int (logand y 63L)) [@@inline]
let rotate_left x y =
let n = logand y 63L in
logor (shl x n) (lshr x (sub 64L n))
let rotate_right x y =
let n = logand y 63L in
logor (lshr x n) (shl x (sub 64L n))
let extend_s n x =
let shift = 64 - n in
shift_right (shift_left x shift) shift
(* String conversion that allows leading signs and unsigned values *)
let max_upper = unsigned_div minus_one 10L
let max_lower = unsigned_rem minus_one 10L
let of_string_exn s =
let len = String.length s in
let rec parse_hex i num =
if i = len then num
else
let c = s.[i] in
if Char.equal c '_' then parse_hex (i + 1) num
else begin
let digit = of_int (Char.Ascii.hex_digit_to_int c) in
if not (le_u num (lshr minus_one (of_int 4))) then
Fmt.failwith "of_string (int64)"
else parse_hex (i + 1) (logor (shift_left num 4) digit)
end
in
let rec parse_dec i num =
if i = len then num
else
let c = s.[i] in
if Char.equal c '_' then parse_dec (i + 1) num
else begin
let digit = of_int (Char.Ascii.digit_to_int c) in
if not (lt_u num max_upper || (eq num max_upper && le_u digit max_lower))
then Fmt.failwith "of_string (int64)"
else parse_dec (i + 1) (add (mul num 10L) digit)
end
in
let parse_int i =
if not (len - i > 0) then Fmt.failwith "of_string (int64)"
else if i + 2 <= len && Char.equal s.[i] '0' && Char.equal s.[i + 1] 'x'
then parse_hex (i + 2) zero
else parse_dec i zero
in
match s.[0] with
| '+' -> parse_int 1
| '-' ->
let n = parse_int 1 in
if not (le minus_one (sub n one)) then Fmt.failwith "of_string (int64)"
else neg n
| _ -> parse_int 0
let of_string s = try Some (of_string_exn s) with Failure _ -> None
let fits_in_u32 n = unsigned_compare n 0xFFFF_FFFFL <= 0
let to_string_u = Fmt.str "%Lu"