Add Numeric_types (#515)

compilerlibs/Makefile.compilerlibs

@@ -180,6 +180,7 @@ MIDDLE_END_FLAMBDA_COMPILENV_DEPS=\
   middle_end/flambda/compilenv_deps/one_bit_fewer.cmo \
   middle_end/flambda/compilenv_deps/lmap.cmo \
   middle_end/flambda/compilenv_deps/targetint_32_64.cmo \
+  middle_end/flambda/compilenv_deps/numeric_types.cmo \
   middle_end/flambda/compilenv_deps/targetint_31_63.cmo \
   middle_end/flambda/compilenv_deps/tag.cmo \
   middle_end/flambda/compilenv_deps/table_by_int_id.cmo \

middle_end/closure/closure.ml

@@ -23,7 +23,7 @@ open Switch
 open Clambda
 module P = Clambda_primitives
 
-module Int = Numbers.Int
+module Int = Numeric_types.Int
 module Storer =
   Switch.Store
     (struct

middle_end/flambda/basic/apply_cont_rewrite_id.ml

@@ -16,7 +16,7 @@
 
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
-include Numbers.Int
+include Numeric_types.Int
 
 let next = ref 0
 

middle_end/flambda/basic/code_id.ml

@@ -125,7 +125,7 @@ end
 
 module Set = Patricia_tree.Make_set (struct let print = print end)
 module Map = Patricia_tree.Make_map (struct let print = print end) (Set)
-module Tbl = Identifiable.Make_tbl (Numbers.Int) (Map)
+module Tbl = Identifiable.Make_tbl (Numeric_types.Int) (Map)
 module Lmap = Lmap.Make(T)
 
 let invert_map map =

middle_end/flambda/basic/continuation.ml

@@ -181,7 +181,7 @@ end)
 module Set = Patricia_tree.Make_set (struct let print = print end)
 module Map = Patricia_tree.Make_map (struct let print = print end) (Set)
 (* CR mshinwell: The [Tbl]s will still print integers! *)
-module Tbl = Identifiable.Make_tbl (Numbers.Int) (Map)
+module Tbl = Identifiable.Make_tbl (Numeric_types.Int) (Map)
 
 let print_with_cache ~cache:_ ppf t = print ppf t
 

middle_end/flambda/basic/scope.ml

@@ -14,7 +14,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-include Numbers.Int
+include Numeric_types.Int
 
 let initial = 0
 
@@ -39,4 +39,4 @@ let max t1 t2 = max t1 t2
 
 module Set = Patricia_tree.Make_set (struct let print = print end)
 module Map = Patricia_tree.Make_map (struct let print = print end) (Set)
-module Tbl = Identifiable.Make_tbl (Numbers.Int) (Map)
+module Tbl = Identifiable.Make_tbl (Numeric_types.Int) (Map)

middle_end/flambda/compilenv_deps/numeric_types.ml

@@ -0,0 +1,213 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 Jane Street Group LLC                           *)
+(*                                                                        *)
+(*   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 Int_base = Identifiable.Make (struct
+  type t = int
+
+  let compare = Int.compare
+  let output oc x = Printf.fprintf oc "%i" x
+  let hash i = i
+  let equal (i : int) j = i = j
+  let print = Format.pp_print_int
+end)
+
+module Int = struct
+  type t = int
+
+  include Int_base
+
+  let rec zero_to_n n =
+    if n < 0 then Set.empty else Set.add n (zero_to_n (n-1))
+
+  let to_string n = Int.to_string n
+end
+
+module Int8 = struct
+  type t = int
+
+  let zero = 0
+  let one = 1
+
+  let of_int_exn i =
+    if i < -(1 lsl 7) || i > ((1 lsl 7) - 1) then
+      Misc.fatal_errorf "Int8.of_int_exn: %d is out of range" i
+    else
+      i
+
+  let to_int i = i
+end
+
+module Int16 = struct
+  type t = int
+
+  let of_int_exn i =
+    if i < -(1 lsl 15) || i > ((1 lsl 15) - 1) then
+      Misc.fatal_errorf "Int16.of_int_exn: %d is out of range" i
+    else
+      i
+
+  let lower_int64 = Int64.neg (Int64.shift_left Int64.one 15)
+  let upper_int64 = Int64.sub (Int64.shift_left Int64.one 15) Int64.one
+
+  let of_int64_exn i =
+    if Int64.compare i lower_int64 < 0
+        || Int64.compare i upper_int64 > 0
+    then
+      Misc.fatal_errorf "Int16.of_int64_exn: %Ld is out of range" i
+    else
+      Int64.to_int i
+
+  let to_int t = t
+end
+
+module Float = struct
+  type t = float
+
+  include Identifiable.Make (struct
+    type t = float
+
+    let compare x y = Stdlib.compare x y
+    let output oc x = Printf.fprintf oc "%f" x
+    let hash f = Hashtbl.hash f
+    let equal (i : float) j = i = j
+    let print = Format.pp_print_float
+  end)
+end
+
+module Float_by_bit_pattern = struct
+  let create f = Int64.bits_of_float f
+
+  let of_bits bits = bits
+  let of_string str = create (float_of_string str)
+
+  let to_float t = Int64.float_of_bits t
+
+  let zero = create 0.
+  let one = create 1.
+  let minus_one = create (-1.)
+
+  module T0 = struct
+    type t = Int64.t
+
+    let compare = Int64.compare
+    let equal = Int64.equal
+    let hash f = Hashtbl.hash f
+
+    let print ppf t = Format.pp_print_float ppf (Int64.float_of_bits t)
+    let output chan t = Printf.fprintf chan "%g" (Int64.float_of_bits t)
+  end
+
+  include T0
+
+  module Self = Identifiable.Make (T0)
+  include Self
+
+  module Pair = struct
+    include Identifiable.Make_pair
+      (struct type nonrec t = t include Self end)
+      (struct type nonrec t = t include Self end)
+
+    type nonrec t = t * t
+  end
+
+  let cross_product = Pair.create_from_cross_product
+
+  module IEEE_semantics = struct
+    let add t1 t2 = create (Stdlib.(+.) (to_float t1) (to_float t2))
+    let sub t1 t2 = create (Stdlib.(-.) (to_float t1) (to_float t2))
+    let mul t1 t2 = create (Stdlib.( *. ) (to_float t1) (to_float t2))
+    let div t1 t2 = create (Stdlib.(/.) (to_float t1) (to_float t2))
+    let mod_ t1 t2 = create (Stdlib.mod_float (to_float t1) (to_float t2))
+
+    let neg t = create (Stdlib.(~-.) (to_float t))
+    let abs t = create (Stdlib.abs_float (to_float t))
+
+    let compare t1 t2 =
+      Stdlib.compare (to_float t1) (to_float t2)
+
+    let equal t1 t2 =
+      (* N.B. This can't just be defined in terms of [compare_ieee]! *)
+      Stdlib.(=) (to_float t1) (to_float t2)
+  end
+
+  let is_any_nan t =
+    match classify_float (to_float t) with
+    | FP_nan -> true
+    | FP_normal | FP_subnormal | FP_infinite | FP_zero -> false
+
+  let is_either_zero t =
+    match classify_float (to_float t) with
+    | FP_zero -> true
+    | FP_normal | FP_subnormal | FP_infinite | FP_nan -> false
+end
+
+module Int32 = struct
+  include Int32
+
+  external swap_byte_endianness : t -> t = "%bswap_int32"
+
+  module T0 = struct
+    type t = Int32.t
+
+    let compare x y = Int32.compare x y
+    let equal t1 t2 = (compare t1 t2 = 0)
+    let hash f = Hashtbl.hash f
+    let print ppf t = Format.fprintf ppf "%ld" t
+    let output chan t = Printf.fprintf chan "%ld" t
+  end
+
+  module Self = Identifiable.Make (T0)
+  include Self
+
+  module Pair = struct
+    include Identifiable.Make_pair
+      (struct type nonrec t = t include Self end)
+      (struct type nonrec t = t include Self end)
+
+    type nonrec t = t * t
+  end
+
+  let cross_product = Pair.create_from_cross_product
+end
+
+module Int64 = struct
+  include Int64
+
+  external swap_byte_endianness : t -> t = "%bswap_int64"
+
+  module T0 = struct
+    type t = Int64.t
+
+    let compare x y = Int64.compare x y
+    let equal t1 t2 = (compare t1 t2 = 0)
+    let hash f = Hashtbl.hash f
+    let print ppf t = Format.fprintf ppf "%Ld" t
+    let output chan t = Printf.fprintf chan "%Ld" t
+  end
+
+  module Self = Identifiable.Make (T0)
+  include Self
+
+  module Pair = struct
+    include Identifiable.Make_pair
+      (struct type nonrec t = t include Self end)
+      (struct type nonrec t = t include Self end)
+
+    type nonrec t = t * t
+  end
+
+  let cross_product = Pair.create_from_cross_product
+end

middle_end/flambda/compilenv_deps/numeric_types.mli

@@ -0,0 +1,119 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                       Pierre Chambart, OCamlPro                        *)
+(*           Mark Shinwell and Leo White, Jane Street Europe              *)
+(*                                                                        *)
+(*   Copyright 2013--2016 OCamlPro SAS                                    *)
+(*   Copyright 2014--2016 Jane Street Group LLC                           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Modules about numbers, some of which satisfy {!Identifiable.S}.
+
+  {b Warning:} this module is unstable and part of
+  {{!Compiler_libs}compiler-libs}.
+
+*)
+
+module Int : sig
+  include Identifiable.S with type t = int
+
+  (** [zero_to_n n] is the set of numbers \{0, ..., n\} (inclusive). *)
+  val zero_to_n : int -> Set.t
+  val to_string : int -> string
+end
+
+module Int8 : sig
+  type t
+
+  val zero : t
+  val one : t
+
+  val of_int_exn : int -> t
+  val to_int : t -> int
+end
+
+module Int16 : sig
+  type t
+
+  val of_int_exn : int -> t
+  val of_int64_exn : Int64.t -> t
+
+  val to_int : t -> int
+end
+
+module Float : Identifiable.S with type t = float
+
+module Float_by_bit_pattern : sig
+  (** Floating point numbers whose comparison and equality relations are
+      the usual [Int64] relations on the bit patterns of the floats.  This
+      in particular means that different representations of NaN will be
+      distinguished, as will the two signed zeros.
+
+      Never use [Stdlib.compare] on values of type [t].  Use either
+      [compare] (comparison on bit patterns) or [IEEE_semantics.compare]
+      depending on which semantics you want.  Likewise for equality.
+  *)
+
+  include Identifiable.S
+
+  val create : float -> t
+
+  val of_bits : Int64.t -> t
+  val of_string : string -> t
+
+  val to_float : t -> float
+
+  val one : t
+  val zero : t
+  val minus_one : t
+
+  val is_either_zero : t -> bool
+  val is_any_nan : t -> bool
+
+  module IEEE_semantics : sig
+    val add : t -> t -> t
+    val sub : t -> t -> t
+    val mul : t -> t -> t
+    val div : t -> t -> t
+    val mod_ : t -> t -> t
+
+    val neg : t -> t
+    val abs : t -> t
+
+    val compare : t -> t -> int
+    val equal : t -> t -> bool
+  end
+
+  module Pair : Identifiable.S with type t = t * t
+
+  val cross_product : Set.t -> Set.t -> Pair.Set.t
+end
+
+module Int32 : sig
+  include module type of struct include Int32 end
+  include Identifiable.S with type t := Int32.t
+
+  val swap_byte_endianness : t -> t
+
+  module Pair : Identifiable.S with type t = t * t
+
+  val cross_product : Set.t -> Set.t -> Pair.Set.t
+end
+
+module Int64 : sig
+  include module type of struct include Int64 end
+  include Identifiable.S with type t := Int64.t
+
+  val swap_byte_endianness : t -> t
+
+  module Pair : Identifiable.S with type t = t * t
+
+  val cross_product : Set.t -> Set.t -> Pair.Set.t
+end