feat: add small signed integers

.gitignore

@@ -1,4 +1,5 @@
 *~
 _build
+_opam
 integers.install
 .merlin

src/dune

@@ -3,6 +3,6 @@
  (public_name integers)
  (wrapped false)
  (install_c_headers ocaml_integers)
- (c_names unsigned_stubs)
+ (c_names unsigned_stubs signed_stubs)
  (libraries stdlib-shims)
  (synopsis "Signed and unsigned integers of various sizes"))

src/ocaml_integers.h

@@ -26,9 +26,27 @@ CAMLextern value integers_copy_uint64(uint64_t u);
 #define Integers_val_uint8(t) ((Val_int((uint8_t)t)))
 #define Integers_val_uint16(t) ((Val_int((uint16_t)t)))
 
+#define Integers_val_int8(t) ((Val_int((int8_t)t)))
+#define Integers_val_int16(t) ((Val_int((int16_t)t)))
+
 #define Uint8_val(V) ((uint8_t)(Int_val(V)))
 #define Uint16_val(V) ((uint16_t)(Int_val(V)))
 #define Uint32_val(V) (*((uint32_t *) Data_custom_val(V)))
 #define Uint64_val(V) (*((uint64_t *) Data_custom_val(V)))
 
+#define Int8_val(V) ((int8_t)(Int_val(V)))
+#define Int16_val(V) ((int16_t)(Int_val(V)))
+
+static int parse_digit(char c)
+{
+  if (c >= '0' && c <= '9')
+    return c - '0';
+  else if (c >= 'A' && c <= 'F')
+    return c - 'A' + 10;
+  else if (c >= 'a' && c <= 'f')
+    return c - 'a' + 10;
+  else
+    return -1;
+}
+
 #endif /* INTEGERS_UNSIGNED_STUBS_H */

src/signed.ml

@@ -6,6 +6,9 @@
  * See the file LICENSE for details.
  *)
 
+external int_size' : unit -> int = "integers_int_size"
+let int_size = int_size' ()
+
 module type Infix = sig
   type t
   include Unsigned.Infix with type t := t
@@ -62,8 +65,93 @@ struct
   let (asr) = shift_right
 end
 
+module type Small = sig
+  val bits : int
+
+  val min : unit -> int
+  val max : unit -> int
+  val of_string : string -> int
+  val to_string : int -> string
+  val to_hexstring : int -> string
+end
+
+module MakeSmall(S : Small) =
+struct
+  open S
+
+  let fix i = (i lsl (int_size - bits)) asr (int_size - bits)
+
+  module Basics =
+  struct
+    type t = int
+    external to_int : t -> int = "%identity"
+    let min_int = S.min ()
+    let max_int = S.max ()
+    let of_string = of_string
+    let to_string = to_string
+    let to_hexstring = to_hexstring
+
+    let add : t -> t -> t = fun x y -> fix (x + y)
+    let sub : t -> t -> t = fun x y -> fix (x - y)
+    let mul : t -> t -> t = fun x y -> fix (x * y)
+    let div : t -> t -> t = ( / )
+    let rem : t -> t -> t = ( mod )
+    let logand : t -> t -> t = ( land )
+    let logor : t -> t -> t = ( lor )
+    let logxor : t -> t -> t = ( lxor )
+    let shift_left : t -> int -> t = fun x y -> fix (x lsl y)
+    let shift_right : t -> int -> t = ( asr )
+    let shift_right_logical : t -> int -> t = fun x y ->
+      ((x lsl (int_size - bits)) lsr y) asr (int_size - bits)
+    let of_int : int -> t = fix
+    let of_string_opt s = try Some (of_string s) with Failure _ -> None
+    let zero = 0
+    let one = 1
+    let minus_one = -1
+    let lognot = lnot
+    let succ : t -> t = fun x -> fix (Stdlib.succ x)
+    let pred : t -> t = fun x -> fix (Stdlib.pred x)
+    let compare : t -> t -> int = Stdlib.compare
+    let equal : t -> t -> bool = Stdlib.( = )
+    let min : t -> t -> t = Stdlib.min
+    let max : t -> t -> t = Stdlib.max
+  end
+  include Basics
+  module Infix = MakeInfix(Basics)
+  let pp fmt x = Format.fprintf fmt "%s" (to_string x)
+  let pp_hex fmt x = Format.fprintf fmt "%s" (to_hexstring x)
+  let neg = fun x -> fix (- x)
+  let abs = fun x -> fix (abs x)
+  let of_int64 = fun x -> fix (Int64.to_int x)
+  let to_int64 = Int64.of_int
+  let of_nativeint = fun x -> fix (Nativeint.to_int x)
+  let to_nativeint = Nativeint.of_int
+end
+
 external format_int : string -> int -> string = "caml_format_int"
 
+module Int8 = MakeSmall(
+struct
+  let bits = 8
+
+  external of_string : string -> int = "integers_int8_of_string"
+  external to_string : int -> string = "integers_int8_to_string"
+  external to_hexstring : int -> string = "integers_int8_to_hexstring"
+  external max : unit -> int = "integers_int8_max"
+  external min : unit -> int = "integers_int8_min"
+end)
+
+module Int16 = MakeSmall(
+struct
+  let bits = 16
+
+  external of_string : string -> int = "integers_int16_of_string"
+  external to_string : int -> string = "integers_int16_to_string"
+  external to_hexstring : int -> string = "integers_int16_to_hexstring"
+  external max : unit -> int = "integers_int16_max"
+  external min : unit -> int = "integers_int16_min"
+end)
+
 module Int =
 struct
   module Basics =

src/signed.mli

@@ -56,6 +56,12 @@ module type S = sig
 end
 (** Signed integer operations *)
 
+module Int8 : S with type t = private int
+(** Signed 8-bit integer type and operations. *)
+
+module Int16 : S with type t = private int
+(** Signed 16-bit integer type and operations. *)
+
 module Int : S with type t = int
 (** Signed integer type and operations. *)
 

src/signed_stubs.c

@@ -0,0 +1,143 @@
+#if !__USE_MINGW_ANSI_STDIO && (defined(__MINGW32__) || defined(__MINGW64__))
+#define __USE_MINGW_ANSI_STDIO 1
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/custom.h>
+#include <caml/alloc.h>
+#include <caml/intext.h>
+#include <caml/fail.h>
+
+#include <inttypes.h>
+#include <stdint.h>
+#include <limits.h>
+#include <stdio.h>
+
+#define OCAML_INTEGERS_INTERNAL 1
+#include "ocaml_integers.h"
+
+CAMLprim value integers_int_size(value unit)
+{
+  return Val_long(8 * sizeof(value) - 1) ;
+}
+
+#define INT_SMALL_DECLS(BITS)                                               \
+  /* of_string : string -> t */                                             \
+  extern value integers_int ## BITS ## _of_string(value a);                 \
+  /* to_string : t -> string */                                             \
+  extern value integers_int ## BITS ## _to_string(value a);                 \
+  /* max : unit -> t */                                                     \
+  extern value integers_int ## BITS ## _max(value a);
+
+INT_SMALL_DECLS(8)
+INT_SMALL_DECLS(16)
+
+#define TYPE(SIZE) int ## SIZE ## _t
+#define UTYPE(SIZE) uint ## SIZE ## _t
+#define BUF_SIZE(TYPE) ((sizeof(TYPE) * CHAR_BIT + 2) / 3 + 2)
+
+#define INT_OF_STRING(BITS, COPY)                                            \
+  value integers_int ## BITS ## _of_string(value a)                          \
+  {                                                                          \
+    TYPE(BITS) i, max_prefix;                                                \
+    const char *pos = String_val(a);                                         \
+    int base = 10, d, sign = 1, signedness = 1;                              \
+                                                                             \
+    /* Detect sign, if given */                                              \
+    if (*pos == '-') {                                                       \
+       sign = -1;                                                            \
+      pos++;                                                                 \
+    } else if (*pos == '+') {                                                \
+      pos++;                                                                 \
+    }                                                                        \
+    if (*pos == '0') {                                                       \
+      switch (pos[1]) {                                                      \
+        case 'x': case 'X':                                                  \
+          base = 16; pos += 2; break;                                        \
+        case 'o': case 'O':                                                  \
+          base = 8; pos += 2; break;                                         \
+        case 'b': case 'B':                                                  \
+          base = 2; pos += 2; break;                                         \
+        case 'u': case 'U': /* Unsigned prefix. No-op for unsigned types */  \
+          signedness = 0; pos += 2; break;                                   \
+      }                                                                      \
+    }                                                                        \
+                                                                             \
+    max_prefix = ((UTYPE(BITS)) -1) / base;                                  \
+                                                                             \
+    d = parse_digit(*pos);                                                   \
+    if (d < 0 || d >= base) {                                                \
+      caml_failwith("Int"#BITS".of_string");                                 \
+    }                                                                        \
+    i = sign < 0 ? (TYPE(BITS)) (- d) : (TYPE(BITS)) d;                      \
+    pos++;                                                                   \
+                                                                             \
+    for (;; pos++) {                                                         \
+      if (*pos == '_') continue;                                             \
+      d = parse_digit(*pos);                                                 \
+      /* Halt if the digit isn't valid (or this is the string terminator) */ \
+      if (d < 0 || d >= base) break;                                         \
+      /* Check that we can add another digit */                              \
+      if (i > max_prefix) break;                                             \
+      i = (sign < 0 ? (- d) : d) + i * base;                                 \
+      /* Check for overflow */                                               \
+      if (sign < 0) {                                                        \
+        if (i > ((TYPE(BITS)) (- d))) break;                                 \
+      } else {                                                               \
+        if (i < (TYPE(BITS)) d) break;                                       \
+      }                                                                      \
+    }                                                                        \
+                                                                             \
+    if (pos != String_val(a) + caml_string_length(a)){                       \
+      caml_failwith("Int"#BITS".of_string");                                 \
+    }                                                                        \
+                                                                             \
+    return COPY(i);                                                          \
+  }                                                                          \
+
+#define INT_SMALL_DEFS(BITS)                                                 \
+  /* of_string : string -> t */                                              \
+  INT_OF_STRING(BITS, Integers_val_int ## BITS)                              \
+                                                                             \
+  /* to_string : t -> string */                                              \
+  value integers_int ## BITS ## _to_string(value a)                          \
+  {                                                                          \
+    char buf[BUF_SIZE(TYPE(BITS))];                                          \
+    if (sprintf(buf, "%" PRId ## BITS , Int ## BITS ##_val(a)) < 0)          \
+      caml_failwith("Int ## BITS ## .to_string");                            \
+    else                                                                     \
+      return caml_copy_string(buf);                                          \
+  }                                                                          \
+                                                                             \
+  /* to_hexstring : t -> string */                                           \
+  value integers_int ## BITS ## _to_hexstring(value a)                       \
+  {                                                                          \
+    char buf[BUF_SIZE(TYPE(BITS))];                                          \
+    char* c = buf;                                                           \
+    /* Use intnat in case d is MIN_INT(BITS) */                              \
+    intnat d = Int_val(a);                                                   \
+    if (d < 0) {                                                             \
+      *c = '-';                                                              \
+      c++;                                                                   \
+      d = (- d);                                                             \
+    }                                                                        \
+    if (sprintf(c, "%" PRIx ## BITS , (TYPE(BITS)) d) < 0)                   \
+      caml_failwith("Int ## BITS ## .to_hexstring");                         \
+    else                                                                     \
+      return caml_copy_string(buf);                                          \
+  }                                                                          \
+                                                                             \
+  /* max : unit -> t */                                                      \
+  value integers_int ## BITS ## _max(value unit)                             \
+  {                                                                          \
+    return Integers_val_int ## BITS(~(1 << (BITS - 1)));                     \
+  }                                                                          \
+                                                                             \
+  /* min : unit -> t */                                                      \
+  value integers_int ## BITS ## _min(value unit)                             \
+  {                                                                          \
+    return Integers_val_int ## BITS((- 1) << (BITS - 1));                    \
+  }
+
+INT_SMALL_DEFS(8)
+INT_SMALL_DEFS(16)

src/unsigned_stubs.c

@@ -76,19 +76,6 @@ extern value integers_uint_size (value _);
 extern value integers_ulong_size (value _);
 extern value integers_ulonglong_size (value _);
 
-
-static int parse_digit(char c)
-{
-  if (c >= '0' && c <= '9')
-    return c - '0';
-  else if (c >= 'A' && c <= 'F')
-    return c - 'A' + 10;
-  else if (c >= 'a' && c <= 'f')
-    return c - 'a' + 10;
-  else
-    return -1;
-}
-
 #define Uint_custom_val(SIZE, V) Uint_custom_val_(SIZE, V)
 #define Uint_custom_val_(SIZE, V) \
   (*(uint ## SIZE ## _t *)(Data_custom_val(V)))

test/dune

@@ -1,5 +1,5 @@
 (tests
   (package integers)
   (libraries integers)
-  (names hexprinting uint64conversions uint32conversions))
+  (names hexprinting uint64conversions uint32conversions smallsint))