[Guile-commits] 49/69: Reimplement scm_is_{un, }signed_integer for bignums

[Andy Wingo]

wingo pushed a commit to branch wip-inline-digits
in repository guile.

commit 3b4b722ff4646049a316f30916433c554d482c20
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jan 6 11:10:02 2022 +0100

    Reimplement scm_is_{un,}signed_integer for bignums
    
    * libguile/integers.c (negative_int64):
    (int64_magnitude):
    (negative_uint64_to_int64):
    (positive_uint64_to_int64):
    (bignum_to_int64):
    (bignum_to_uint64): New helpers.
    (scm_integer_to_int64_z):
    (scm_integer_to_uint64_z): New internal functions.
    * libguile/integers.h: Declare internal functions.
    * libguile/numbers.c (scm_is_signed_integer):
    (scm_is_unsigned_integer): Simplify bigint cases.
---
 libguile/integers.c | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/integers.h |   3 ++
 libguile/numbers.c  |  87 +++++++------------------------------------
 3 files changed, 120 insertions(+), 74 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index 2e35bc2d5..b8cb1a908 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -25,6 +25,7 @@
 
 #include <math.h>
 #include <stdlib.h>
+#include <stdint.h>
 #include <stdio.h>
 #include <string.h>
 #include <verify.h>
@@ -115,6 +116,22 @@ negative_long (unsigned long mag)
   return ~mag + 1;
 }
 
+static inline int64_t
+negative_int64 (uint64_t mag)
+{
+  ASSERT (mag <= (uint64_t) INT64_MIN);
+  return ~mag + 1;
+}
+
+static inline uint64_t
+int64_magnitude (int64_t i)
+{
+  uint64_t mag = i;
+  if (i < 0)
+    mag = ~mag + 1;
+  return mag;
+}
+
 static inline scm_t_bits
 inum_magnitude (scm_t_inum i)
 {
@@ -266,6 +283,82 @@ long_sign (long l)
   return 1;
 }
 
+static int
+negative_uint64_to_int64 (uint64_t magnitude, int64_t *val)
+{
+  if (magnitude > int64_magnitude (INT64_MIN))
+    return 0;
+  *val = negative_int64 (magnitude);
+  return 1;
+}
+
+static int
+positive_uint64_to_int64 (uint64_t magnitude, int64_t *val)
+{
+  if (magnitude > INT64_MAX)
+    return 0;
+  *val = magnitude;
+  return 1;
+}
+
+static int
+bignum_to_int64 (struct scm_bignum *z, int64_t *val)
+{
+  switch (bignum_size (z))
+    {
+#if SCM_SIZEOF_LONG == 4
+    case -2:
+      {
+        uint64_t mag = bignum_limbs (z)[0];
+        mag |= ((uint64_t) bignum_limbs (z)[1]) << 32;
+        return negative_uint64_to_int64 (mag, val);
+      }
+#endif
+    case -1:
+      return negative_uint64_to_int64 (bignum_limbs (z)[0], val);
+    case 0:
+      *val = 0;
+      return 1;
+    case 1:
+      return positive_uint64_to_int64 (bignum_limbs (z)[0], val);
+#if SCM_SIZEOF_LONG == 4
+    case 2:
+      {
+        uint64_t mag = bignum_limbs (z)[0];
+        mag |= ((uint64_t) bignum_limbs (z)[1]) << 32;
+        return positive_uint64_to_int64 (mag, val);
+      }
+#endif
+    default:
+      return 0;
+    }
+}
+
+static int
+bignum_to_uint64 (struct scm_bignum *z, uint64_t *val)
+{
+  switch (bignum_size (z))
+    {
+    case 0:
+      *val = 0;
+      return 1;
+    case 1:
+      *val = bignum_limbs (z)[0];
+      return 1;
+#if SCM_SIZEOF_LONG == 4
+    case 2:
+      {
+        uint64_t mag = bignum_limbs (z)[0];
+        mag |= ((uint64_t) bignum_limbs (z)[1]) << 32;
+        *val = mag;
+        return 1;
+      }
+#endif
+    default:
+      return 0;
+    }
+}
+
 static int
 bignum_cmp_long (struct scm_bignum *z, long l)
 {
@@ -2803,3 +2896,14 @@ scm_integer_exact_quotient_zz (struct scm_bignum *n, 
struct scm_bignum *d)
   return take_mpz (q);
 }
 
+int
+scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val)
+{
+  return bignum_to_int64 (z, val);
+}
+
+int
+scm_integer_to_uint64_z (struct scm_bignum *z, uint64_t *val)
+{
+  return bignum_to_uint64 (z, val);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index bda575774..60e3ea9bd 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -199,6 +199,9 @@ SCM_INTERNAL SCM scm_integer_exact_quotient_zi (struct 
scm_bignum *n,
 SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct scm_bignum *n,
                                                 struct scm_bignum *d);
 
+SCM_INTERNAL int scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val);
+SCM_INTERNAL int scm_integer_to_uint64_z (struct scm_bignum *z, uint64_t *val);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 549b730ec..8657a6ebe 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6788,59 +6788,24 @@ scm_is_exact_integer (SCM val)
   return SCM_I_INUMP (val) || SCM_BIGP (val);
 }
 
+// Given that there is no way to extend intmax_t to encompass types
+// larger than int64, and that we must have int64, intmax will always be
+// 8 bytes wide, and we can treat intmax arguments as int64's.
+verify(SCM_SIZEOF_INTMAX == 8);
+
 int
 scm_is_signed_integer (SCM val, intmax_t min, intmax_t max)
 {
   if (SCM_I_INUMP (val))
     {
       scm_t_signed_bits n = SCM_I_INUM (val);
-      return n >= min && n <= max;
+      return min <= n && n <= max;
     }
   else if (SCM_BIGP (val))
     {
-      if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM)
-       return 0;
-      else if (min >= LONG_MIN && max <= LONG_MAX)
-       {
-         if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
-           {
-             long n = mpz_get_si (SCM_I_BIG_MPZ (val));
-             return n >= min && n <= max;
-           }
-         else
-           return 0;
-       }
-      else
-       {
-         uintmax_t abs_n;
-         intmax_t n;
-         size_t count;
-
-         if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) 
-             > CHAR_BIT*sizeof (uintmax_t))
-           return 0;
-         
-         mpz_export (&abs_n, &count, 1, sizeof (uintmax_t), 0, 0,
-                     SCM_I_BIG_MPZ (val));
-
-         if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
-           {
-             if (abs_n <= max)
-               n = abs_n;
-             else
-               return 0;
-           }
-         else
-           {
-             /* Carefully avoid signed integer overflow. */
-             if (min < 0 && abs_n - 1 <= -(min + 1))
-               n = -1 - (intmax_t)(abs_n - 1);
-             else
-               return 0;
-           }
-
-         return n >= min && n <= max;
-       }
+      int64_t n;
+      return scm_integer_to_int64_z (scm_bignum (val), &n)
+        && min <= n && n <= max;
     }
   else
     return 0;
@@ -6856,35 +6821,9 @@ scm_is_unsigned_integer (SCM val, uintmax_t min, 
uintmax_t max)
     }
   else if (SCM_BIGP (val))
     {
-      if (max <= SCM_MOST_POSITIVE_FIXNUM)
-       return 0;
-      else if (max <= ULONG_MAX)
-       {
-         if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val)))
-           {
-             unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val));
-             return n >= min && n <= max;
-           }
-         else
-           return 0;
-       }
-      else
-       {
-         uintmax_t n;
-         size_t count;
-
-         if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0)
-           return 0;
-
-         if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
-             > CHAR_BIT*sizeof (uintmax_t))
-           return 0;
-         
-         mpz_export (&n, &count, 1, sizeof (uintmax_t), 0, 0,
-                     SCM_I_BIG_MPZ (val));
-
-         return n >= min && n <= max;
-       }
+      uint64_t n;
+      return scm_integer_to_uint64_z (scm_bignum (val), &n)
+        && min <= n && n <= max;
     }
   else
     return 0;
@@ -6895,7 +6834,7 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
 {
   scm_error (scm_out_of_range_key,
             NULL,
-            "Value out of range ~S to ~S: ~S",
+            "Value out of range ~S to< ~S: ~S",
              scm_list_3 (min, max, bad_val),
              scm_list_1 (bad_val));
 }