flambda-backend: Enhance numbers.ml with more primitive types (#544)

Author: poechsel

utils/numbers.ml

@@ -48,11 +48,34 @@ module Int8 = struct
       i
 
   let to_int i = i
+
+  let print ppf t = Format.pp_print_int ppf t
+end
+
+module Uint8 = struct
+  type t = int
+
+  let print ppf t = Format.pp_print_int ppf t
+
+  let zero = 0
+
+  let one = 1
+
+  let of_nonnegative_int_exn i =
+    if i < 0 || i > (1 lsl 8) - 1
+    then Misc.fatal_errorf "Uint8.of_nonnegative_int_exn: %d is out of range" i
+    else i
+
+  let to_int i = i
 end
 
 module Int16 = struct
   type t = int
 
+  let zero = 0
+
+  let one = 1
+
   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
@@ -71,8 +94,115 @@ module Int16 = struct
       Int64.to_int i
 
   let to_int t = t
+
+  let print ppf t = Format.pp_print_int ppf t
+end
+
+module Uint16 = struct
+  type t = int
+
+  let print ppf t = Format.pp_print_int ppf t
+
+  let of_nonnegative_int_exn i =
+    if i < 0 || i > (1 lsl 16) - 1
+    then Misc.fatal_errorf "Uint16.of_nonnegative_int_exn: %d is out of range" i
+    else i
+
+  let upper_int64 = Int64.sub (Int64.shift_left Int64.one 16) Int64.one
+
+  let of_nonnegative_int64_exn i =
+    if Int64.compare i 0L < 0 || Int64.compare i upper_int64 > 0
+    then
+      Misc.fatal_errorf "Uint16.of_nonnegative_int64_exn: %Ld is out of range" i
+    else Int64.to_int i
+
+  let to_int t = t
+end
+
+module Uint32 = struct
+  type t = Int64.t
+
+  let zero = 0L
+
+  let print ppf t = Format.fprintf ppf "0x%Lx" t
+
+  let upper_int64 = Int64.sub (Int64.shift_left Int64.one 32) Int64.one
+
+  let of_nonnegative_int_exn i =
+    if i < 0
+    then Misc.fatal_errorf "Uint32.of_nonnegative_int_exn: %d is out of range" i
+    else
+      let i64 = Int64.of_int i in
+      if Int64.compare i64 upper_int64 > 0
+      then
+        Misc.fatal_errorf "Uint32.of_nonnegative_int_exn: %d is out of range" i
+      else i64
+
+  let of_nonnegative_int64_exn i =
+    if Int64.compare i 0L < 0 || Int64.compare i upper_int64 > 0
+    then
+      Misc.fatal_errorf "Uint32.of_nonnegative_int64_exn: %Ld is out of range" i
+    else i
+
+  let of_nonnegative_int32_exn i =
+    if Int32.compare i 0l < 0
+    then
+      Misc.fatal_errorf "Uint32.of_nonnegative_int32_exn: %ld is out of range" i
+    else Int64.of_int32 i
+
+  let to_int64 t = t
+end
+
+module Uint64 = struct
+  type t = Int64.t
+
+  let zero = 0L
+
+  let succ t = Int64.add 1L t
+
+  let of_nonnegative_int_exn i =
+    if i < 0
+    then Misc.fatal_errorf "Uint64.of_nonnegative_int_exn: %d is out of range" i
+    else Int64.of_int i
+
+  let of_uint8 i = Int64.of_int i
+
+  let of_uint16 i = Int64.of_int i
+
+  let of_uint32 i = i
+
+  let of_nonnegative_int32_exn i =
+    if Int32.compare i 0l < 0
+    then
+      Misc.fatal_errorf "Uint64.of_nonnegative_int32_exn: %ld is out of range" i
+    else Int64.of_int32 i
+
+  let of_nonnegative_int64_exn i =
+    if Int64.compare i 0L < 0
+    then
+      Misc.fatal_errorf "Uint64.of_nonnegative_int64_exn: %Ld is out of range" i
+    else i
+
+  let to_int64 t = t
+
+  include Identifiable.Make (struct
+    type nonrec t = t
+
+    let compare t1 t2 =
+      (* Only a consistent order is needed here *)
+      Int64.compare t1 t2
+
+    let equal t1 t2 = compare t1 t2 = 0
+
+    let hash t = Hashtbl.hash t
+
+    let print ppf t = Format.fprintf ppf "0x%Lx" t
+
+    let output _ _ = Misc.fatal_error "Not yet implemented"
+  end)
 end
 
+
 module Float = struct
   type t = float
 

utils/numbers.mli

@@ -37,15 +37,89 @@ module Int8 : sig
 
   val of_int_exn : int -> t
   val to_int : t -> int
+  val print : Format.formatter -> t -> unit
+end
+
+(** Do not use polymorphic comparison on the unsigned integer types. *)
+
+module Uint8 : sig
+  type t
+
+  val print : Format.formatter -> t -> unit
+
+  val zero : t
+
+  val one : t
+
+  val of_nonnegative_int_exn : int -> t
+
+  val to_int : t -> int
 end
 
 module Int16 : sig
   type t
 
+  val zero : t
+  val one : t
+
   val of_int_exn : int -> t
   val of_int64_exn : Int64.t -> t
 
   val to_int : t -> int
+  val print : Format.formatter -> t -> unit
+end
+
+module Uint16 : sig
+  type t
+
+  val print : Format.formatter -> t -> unit
+
+  val of_nonnegative_int_exn : int -> t
+
+  val of_nonnegative_int64_exn : Int64.t -> t
+
+  val to_int : t -> int
+end
+
+module Uint32 : sig
+  type t
+
+  val print : Format.formatter -> t -> unit
+
+  val zero : t
+
+  val of_nonnegative_int_exn : int -> t
+
+  val of_nonnegative_int32_exn : Int32.t -> t
+
+  val of_nonnegative_int64_exn : Int64.t -> t
+
+  val to_int64 : t -> Int64.t
+end
+
+module Uint64 : sig
+  type t
+
+  val zero : t
+
+  val succ : t -> t
+
+  val of_uint8 : Uint8.t -> t
+
+  val of_uint16 : Uint16.t -> t
+
+  val of_uint32 : Uint32.t -> t
+
+  val of_nonnegative_int_exn : int -> t
+
+  val of_nonnegative_int32_exn : Int32.t -> t
+
+  val of_nonnegative_int64_exn : Int64.t -> t
+
+  val to_int64 : t -> Int64.t
+
+  include Identifiable.S with type t := t
 end
 
+
 module Float : Identifiable.S with type t = float