Source file int32.ml

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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
(*                                                                        *)
(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(* Module [Int32]: 32-bit integers *)

external neg : int32 -> int32 = "%int32_neg"
external add : int32 -> int32 -> int32 = "%int32_add"
external sub : int32 -> int32 -> int32 = "%int32_sub"
external mul : int32 -> int32 -> int32 = "%int32_mul"
external div : int32 -> int32 -> int32 = "%int32_div"
external rem : int32 -> int32 -> int32 = "%int32_mod"
external logand : int32 -> int32 -> int32 = "%int32_and"
external logor : int32 -> int32 -> int32 = "%int32_or"
external logxor : int32 -> int32 -> int32 = "%int32_xor"
external shift_left : int32 -> int -> int32 = "%int32_lsl"
external shift_right : int32 -> int -> int32 = "%int32_asr"
external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
external of_int : int -> int32 = "%int32_of_int"
external to_int : int32 -> int = "%int32_to_int"
external of_float : float -> int32
  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
  [@@unboxed] [@@noalloc]
external to_float : int32 -> float
  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
  [@@unboxed] [@@noalloc]
external bits_of_float : float -> int32
  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
  [@@unboxed] [@@noalloc]
external float_of_bits : int32 -> float
  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
  [@@unboxed] [@@noalloc]

let zero = 0l
let one = 1l
let minus_one = -1l
let succ n = add n 1l
let pred n = sub n 1l
let abs n = if n >= 0l then n else neg n
let min_int = 0x80000000l
let max_int = 0x7FFFFFFFl
let lognot n = logxor n (-1l)

let unsigned_to_int =
  match Sys.word_size with
  | 32 ->
      let max_int = of_int Stdlib.max_int in
      fun n ->
        if n >= 0l && n <= max_int then
          Some (to_int n)
        else
          None
  | 64 ->
      (* So that it compiles in 32-bit *)
      let mask = 0xFFFF lsl 16 lor 0xFFFF in
      fun n -> Some (to_int n land mask)
  | _ ->
      assert false

external format : string -> int32 -> string = "caml_int32_format"
let to_string n = format "%d" n

external of_string : string -> int32 = "caml_int32_of_string"

let of_string_opt s =
  try Some (of_string s)
  with Failure _ -> None

type t = int32

let compare (x: t) (y: t) = Stdlib.compare x y
let equal (x: t) (y: t) = x = y

let unsigned_compare n m =
  compare (sub n min_int) (sub m min_int)

let unsigned_lt n m =
  sub n min_int < sub m min_int

let min x y : t = if x <= y then x else y
let max x y : t = if x >= y then x else y

(* Unsigned division from signed division of the same bitness.
   See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
*)
let unsigned_div n d =
  if d < zero then
    if unsigned_lt n d then zero else one
  else
    let q = shift_left (div (shift_right_logical n 1) d) 1 in
    let r = sub n (mul q d) in
    if unsigned_lt r d then q else succ q

let unsigned_rem n d =
  sub n (mul (unsigned_div n d) d)

(* Floor division, ceil division *)

let fdiv n d =
  let q = div n d in
  if logxor n d >= 0l (* n and d have same sign *) || n = mul q d
  then q else pred q

let cdiv n d =
  let q = div n d in
  if logxor n d < 0l (* n and d have different signs *) || n = mul q d
  then q else succ q

(* Euclidean division and remainder *)

let erem n d =
  let r = rem n d in
  if r >= 0l then r else if d >= 0l then add r d else sub r d

let ediv n d =
  let q = div n d in
  let r = sub n (mul q d) in
  if r >= 0l then q else if d >= 0l then pred q else succ q

(* Number of leading zeros.  Hacker's Delight (2 ed.), algorithm 5.12 *)

let leading_zeros x =
  let x = ref x and n = ref 32 in
  let y = shift_right_logical !x 16 in
  if y <> 0l then (n := !n - 16; x := y);
  let y = shift_right_logical !x  8 in
  if y <> 0l then (n := !n -  8; x := y);
  let y = shift_right_logical !x  4 in
  if y <> 0l then (n := !n -  4; x := y);
  let y = shift_right_logical !x 2 in
  if y <> 0l then (n := !n -  2; x := y);
  let y = shift_right_logical !x 1 in
  if y <> 0l then !n - 2 else !n - to_int !x

let unsigned_bitsize x =
  32 - leading_zeros x

(* Number of leading sign bits. *)

let leading_sign_bits x =
  if x >= 0l then leading_zeros x - 1 else leading_zeros (lognot x) - 1

let signed_bitsize x =
  32 - leading_sign_bits x

(* Number of trailing zeros.  Hacker's Delight (2 ed.), algorithm 5.21 *)

let trailing_zeros x =
  if x = 0l then 32 else begin
    let x = ref x and n = ref 31 in
    let y = shift_left !x 16 in
    if y <> 0l then (n := !n - 16; x := y);
    let y = shift_left !x  8 in
    if y <> 0l then (n := !n -  8; x := y);
    let y = shift_left !x  4 in
    if y <> 0l then (n := !n -  4; x := y);
    let y = shift_left !x  2 in
    if y <> 0l then (n := !n -  2; x := y);
    let y = shift_left !x  1 in
    if y <> 0l then !n - 1 else !n
  end

(* Population count.  Hacker's Delight (2 ed.), algorithm 5.2 *)

let popcount x =
  let x = sub x (logand (shift_right_logical x 1) 0x5555_5555l) in
  let x = add (logand x 0x3333_3333l)
              (logand (shift_right_logical x 2) 0x3333_3333l) in
  let x = logand (add x (shift_right_logical x 4)) 0x0F0F_0F0Fl in
  let x = add x (shift_right_logical x 8) in
  let x = add x (shift_right_logical x 16) in
  to_int x land 0x3F

external seeded_hash_param :
  int -> int -> int -> 'a -> int = "caml_hash" [@@noalloc]
let seeded_hash seed x = seeded_hash_param 10 100 seed x
let hash x = seeded_hash_param 10 100 0 x