Source file int.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
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*                         The OCaml programmers                          *)
(*                                                                        *)
(*   Copyright 2018 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.          *)
(*                                                                        *)
(**************************************************************************)

type t = int

let zero = 0
let one = 1
let minus_one = -1
external neg : int -> int = "%negint"
external add : int -> int -> int = "%addint"
external sub : int -> int -> int = "%subint"
external mul : int -> int -> int = "%mulint"
external div : int -> int -> int = "%divint"
external rem : int -> int -> int = "%modint"
external succ : int -> int = "%succint"
external pred : int -> int = "%predint"
let abs x = if x >= 0 then x else -x
let max_int = (-1) lsr 1
let min_int = max_int + 1
external logand : int -> int -> int = "%andint"
external logor : int -> int -> int = "%orint"
external logxor : int -> int -> int = "%xorint"
let lognot x = logxor x (-1)
external shift_left : int -> int -> int = "%lslint"
external shift_right : int -> int -> int = "%asrint"
external shift_right_logical : int -> int -> int = "%lsrint"
let equal : int -> int -> bool = ( = )
let compare : int -> int -> int = Stdlib.compare
let min x y : t = if x <= y then x else y
let max x y : t = if x >= y then x else y

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

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

let unsigned_bitsize x =
  Sys.int_size - leading_zeros x

(* Number of leading sign bits. *)

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

let signed_bitsize x =
  Sys.int_size - leading_sign_bits x

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

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

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

external int64_to_int : int64 -> int = "%int64_to_int"
let cst1 = int64_to_int 0x5555_5555_5555_5555L
let cst2 = int64_to_int 0x3333_3333_3333_3333L
let cst3 = int64_to_int 0x0F0F_0F0F_0F0F_0F0FL

let popcount x =
  let x = sub x (logand (shift_right_logical x 1) cst1) in
  let x = add (logand x cst2)
              (logand (shift_right_logical x 2) cst2) in
  let x = logand (add x (shift_right_logical x 4)) cst3 in
  let x = add x (shift_right_logical x 8) in
  let x = add x (shift_right_logical x 16) in
  if Sys.int_size > 32 then begin
    let x = add x (shift_right_logical x 32) in
    x land 0x7F
  end else
    x land 0x3F

external to_float : int -> float = "%floatofint"
external of_float : float -> int = "%intoffloat"

(*
external int_of_string : string -> int = "caml_int_of_string"
let of_string s = try Some (int_of_string s) with Failure _ -> None
*)

external format_int : string -> int -> string = "caml_format_int"
let to_string x = format_int "%d" x

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

(* Floor division, ceil division *)

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

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

(* Euclidean division and remainder *)

let erem n d =
  let r = rem n d in
  if r >= 0 then r else if d >= 0 then r + d else r - d

let ediv n d =
  let q = div n d in
  let r = n - q * d in
  if r >= 0 then q else if d >= 0 then pred q else succ q