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
17type repr =
18  | Int32 of int32
19  | Int64 of int64
20
21module type S = sig
22  type t
23  val zero : t
24  val one : t
25  val minus_one : t
26  val neg : t -> t
27  val add : t -> t -> t
28  val sub : t -> t -> t
29  val mul : t -> t -> t
30  val div : t -> t -> t
31  val rem : t -> t -> t
32  val succ : t -> t
33  val pred : t -> t
34  val abs : t -> t
35  val max_int : t
36  val min_int : t
37  val logand : t -> t -> t
38  val logor : t -> t -> t
39  val logxor : t -> t -> t
40  val lognot : t -> t
41  val shift_left : t -> int -> t
42  val shift_right : t -> int -> t
43  val shift_right_logical : t -> int -> t
44  val of_int : int -> t
45  val of_int_exn : int -> t
46  val to_int : t -> int
47  val of_float : float -> t
48  val to_float : t -> float
49  val of_int32 : int32 -> t
50  val to_int32 : t -> int32
51  val of_int64 : int64 -> t
52  val to_int64 : t -> int64
53  val of_string : string -> t
54  val to_string : t -> string
55  val compare: t -> t -> int
56  val equal: t -> t -> bool
57  val repr: t -> repr
58end
59
60let size = Sys.word_size
61(* Later, this will be set by the configure script
62   in order to support cross-compilation. *)
63
64module Int32 = struct
65  include Int32
66  let of_int_exn =
67    match Sys.word_size with (* size of [int] *)
68    | 32 ->
69        Int32.of_int
70    | 64 ->
71        fun n ->
72          if n < Int32.(to_int min_int) || n > Int32.(to_int max_int) then
73            Misc.fatal_errorf "Targetint.of_int_exn: 0x%x out of range" n
74          else
75            Int32.of_int n
76    | _ ->
77        assert false
78  let of_int32 x = x
79  let to_int32 x = x
80  let of_int64 = Int64.to_int32
81  let to_int64 = Int64.of_int32
82  let repr x = Int32 x
83end
84
85module Int64 = struct
86  include Int64
87  let of_int_exn = Int64.of_int
88  let of_int64 x = x
89  let to_int64 x = x
90  let repr x = Int64 x
91end
92
93include (val
94          (match size with
95           | 32 -> (module Int32)
96           | 64 -> (module Int64)
97           | _ -> assert false
98          ) : S)
99