1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
6(*                        Nicolas Ojeda Bar, LexiFi                       *)
7(*                                                                        *)
8(*   Copyright 2016 Institut National de Recherche en Informatique et     *)
9(*     en Automatique.                                                    *)
10(*                                                                        *)
11(*   All rights reserved.  This file is distributed under the terms of    *)
12(*   the GNU Lesser General Public License version 2.1, with the          *)
13(*   special exception on linking described in the file LICENSE.          *)
14(*                                                                        *)
15(**************************************************************************)
16
17(** Target processor-native integers.
18
19   This module provides operations on the type of
20   signed 32-bit integers (on 32-bit target platforms) or
21   signed 64-bit integers (on 64-bit target platforms).
22   This integer type has exactly the same width as that of a
23   pointer type in the C compiler.  All arithmetic operations over
24   are taken modulo 2{^32} or 2{^64} depending
25   on the word size of the target architecture.
26*)
27
28type t
29(** The type of target integers. *)
30
31val zero : t
32(** The target integer 0.*)
33
34val one : t
35(** The target integer 1.*)
36
37val minus_one : t
38(** The target integer -1.*)
39
40val neg : t -> t
41(** Unary negation. *)
42
43val add : t -> t -> t
44(** Addition. *)
45
46val sub : t -> t -> t
47(** Subtraction. *)
48
49val mul : t -> t -> t
50(** Multiplication. *)
51
52val div : t -> t -> t
53(** Integer division.  Raise [Division_by_zero] if the second
54   argument is zero.  This division rounds the real quotient of
55   its arguments towards zero, as specified for {!Pervasives.(/)}. *)
56
57val rem : t -> t -> t
58(** Integer remainder.  If [y] is not zero, the result
59   of [Targetint.rem x y] satisfies the following properties:
60   [Targetint.zero <= Nativeint.rem x y < Targetint.abs y] and
61   [x = Targetint.add (Targetint.mul (Targetint.div x y) y)
62                      (Targetint.rem x y)].
63   If [y = 0], [Targetint.rem x y] raises [Division_by_zero]. *)
64
65val succ : t -> t
66(** Successor.
67   [Targetint.succ x] is [Targetint.add x Targetint.one]. *)
68
69val pred : t -> t
70(** Predecessor.
71   [Targetint.pred x] is [Targetint.sub x Targetint.one]. *)
72
73val abs : t -> t
74(** Return the absolute value of its argument. *)
75
76val size : int
77(** The size in bits of a target native integer. *)
78
79val max_int : t
80(** The greatest representable target integer,
81    either 2{^31} - 1 on a 32-bit platform,
82    or 2{^63} - 1 on a 64-bit platform. *)
83
84val min_int : t
85(** The smallest representable target integer,
86   either -2{^31} on a 32-bit platform,
87   or -2{^63} on a 64-bit platform. *)
88
89val logand : t -> t -> t
90(** Bitwise logical and. *)
91
92val logor : t -> t -> t
93(** Bitwise logical or. *)
94
95val logxor : t -> t -> t
96(** Bitwise logical exclusive or. *)
97
98val lognot : t -> t
99(** Bitwise logical negation *)
100
101val shift_left : t -> int -> t
102(** [Targetint.shift_left x y] shifts [x] to the left by [y] bits.
103    The result is unspecified if [y < 0] or [y >= bitsize],
104    where [bitsize] is [32] on a 32-bit platform and
105    [64] on a 64-bit platform. *)
106
107val shift_right : t -> int -> t
108(** [Targetint.shift_right x y] shifts [x] to the right by [y] bits.
109    This is an arithmetic shift: the sign bit of [x] is replicated
110    and inserted in the vacated bits.
111    The result is unspecified if [y < 0] or [y >= bitsize]. *)
112
113val shift_right_logical : t -> int -> t
114(** [Targetint.shift_right_logical x y] shifts [x] to the right
115    by [y] bits.
116    This is a logical shift: zeroes are inserted in the vacated bits
117    regardless of the sign of [x].
118    The result is unspecified if [y < 0] or [y >= bitsize]. *)
119
120val of_int : int -> t
121(** Convert the given integer (type [int]) to a target integer
122    (type [t]), module the target word size. *)
123
124val of_int_exn : int -> t
125(** Convert the given integer (type [int]) to a target integer
126    (type [t]).  Raises a fatal error if the conversion is not exact. *)
127
128val to_int : t -> int
129(** Convert the given target integer (type [t]) to an
130    integer (type [int]).  The high-order bit is lost during
131    the conversion. *)
132
133val of_float : float -> t
134(** Convert the given floating-point number to a target integer,
135   discarding the fractional part (truncate towards 0).
136   The result of the conversion is undefined if, after truncation,
137   the number is outside the range
138   \[{!Targetint.min_int}, {!Targetint.max_int}\]. *)
139
140val to_float : t -> float
141(** Convert the given target integer to a floating-point number. *)
142
143val of_int32 : int32 -> t
144(** Convert the given 32-bit integer (type [int32])
145    to a target integer. *)
146
147val to_int32 : t -> int32
148(** Convert the given target integer to a
149    32-bit integer (type [int32]).  On 64-bit platforms,
150    the 64-bit native integer is taken modulo 2{^32},
151    i.e. the top 32 bits are lost.  On 32-bit platforms,
152    the conversion is exact. *)
153
154val of_int64 : int64 -> t
155(** Convert the given 64-bit integer (type [int64])
156    to a target integer. *)
157
158val to_int64 : t -> int64
159(** Convert the given target integer to a
160    64-bit integer (type [int64]). *)
161
162val of_string : string -> t
163(** Convert the given string to a target integer.
164    The string is read in decimal (by default) or in hexadecimal,
165    octal or binary if the string begins with [0x], [0o] or [0b]
166    respectively.
167    Raise [Failure "int_of_string"] if the given string is not
168    a valid representation of an integer, or if the integer represented
169    exceeds the range of integers representable in type [nativeint]. *)
170
171val to_string : t -> string
172(** Return the string representation of its argument, in decimal. *)
173
174val compare: t -> t -> int
175(** The comparison function for target integers, with the same specification as
176    {!Pervasives.compare}.  Along with the type [t], this function [compare]
177    allows the module [Targetint] to be passed as argument to the functors
178    {!Set.Make} and {!Map.Make}. *)
179
180val equal: t -> t -> bool
181(** The equal function for target ints. *)
182
183type repr =
184  | Int32 of int32
185  | Int64 of int64
186
187val repr : t -> repr
188(** The concrete representation of a native integer. *)
189