[Guile-commits] 49/85: Reimplement scm_from_int8 etc

[Andy Wingo]

wingo pushed a commit to branch main
in repository guile.

commit 27910181c53a7f836bfc8dc9c5619e2e3110eeaf
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jan 6 20:12:06 2022 +0100

    Reimplement scm_from_int8 etc
    
    * libguile/integers.c (make_bignum_from_uint64):
    (make_bignum_from_int64): New helpers.
    (scm_integer_from_int64):
    (scm_integer_from_uint64): New internal functions.
    * libguile/integers.h: Declare new internal functions.
    * libguile/numbers.c (range_error): Declare as noreturn.xo
    (inum_in_range): New helper.
    (scm_from_signed_integer):
    (scm_to_signed_integer):
    (scm_from_unsigned_integer):
    (scm_to_unsigned_integer):
    (scm_to_int8):
    (scm_from_int8):
    (scm_to_uint8):
    (scm_from_uint8):
    (scm_to_int16):
    (scm_from_int16):
    (scm_to_uint16):
    (scm_from_uint16): Implement manually.
---
 libguile/integers.c |  41 ++++++++++++++
 libguile/integers.h |   3 +
 libguile/numbers.c  | 157 ++++++++++++++++++++++++++++++++++++++--------------
 3 files changed, 158 insertions(+), 43 deletions(-)

diff --git a/libguile/integers.c b/libguile/integers.c
index b8cb1a908..9ec42694f 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -182,6 +182,31 @@ make_bignum_1 (int is_negative, mp_limb_t limb)
   return is_negative ? negate_bignum(z) : z;
 }
 
+static struct scm_bignum *
+make_bignum_from_uint64 (uint64_t val)
+{
+#if SCM_SIZEOF_LONG == 4
+  mp_limb_t lo = val, hi = val >> 32;
+  struct scm_bignum *z = allocate_bignum (hi ? 2 : 1);
+  z->limbs[0] = lo;
+  if (hi)
+    z->limbs[1] = hi;
+  return z;
+#else
+  struct scm_bignum *z = allocate_bignum (1);
+  z->limbs[0] = val;
+  return z;
+#endif
+}
+
+static struct scm_bignum *
+make_bignum_from_int64 (int64_t val)
+{
+  return val < 0
+    ? negate_bignum (make_bignum_from_uint64 (int64_magnitude (val)))
+    : make_bignum_from_uint64 (val);
+}
+
 static struct scm_bignum *
 ulong_to_bignum (unsigned long u)
 {
@@ -2896,6 +2921,22 @@ scm_integer_exact_quotient_zz (struct scm_bignum *n, 
struct scm_bignum *d)
   return take_mpz (q);
 }
 
+SCM
+scm_integer_from_int64 (int64_t n)
+{
+  if (SCM_FIXABLE (n))
+    return SCM_I_MAKINUM (n);
+  return scm_from_bignum (make_bignum_from_int64 (n));
+}
+
+SCM
+scm_integer_from_uint64 (uint64_t n)
+{
+  if (SCM_POSFIXABLE (n))
+    return SCM_I_MAKINUM (n);
+  return scm_from_bignum (make_bignum_from_uint64 (n));
+}
+
 int
 scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val)
 {
diff --git a/libguile/integers.h b/libguile/integers.h
index 60e3ea9bd..8bf91f567 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -202,6 +202,9 @@ SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct 
scm_bignum *n,
 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);
 
+SCM_INTERNAL SCM scm_integer_from_int64 (int64_t n);
+SCM_INTERNAL SCM scm_integer_from_uint64 (uint64_t n);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 8657a6ebe..b1ef37752 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6829,8 +6829,9 @@ scm_is_unsigned_integer (SCM val, uintmax_t min, 
uintmax_t max)
     return 0;
 }
 
+static void range_error (SCM bad_val, SCM min, SCM max) SCM_NORETURN;
 static void
-scm_i_range_error (SCM bad_val, SCM min, SCM max)
+range_error (SCM bad_val, SCM min, SCM max)
 {
   scm_error (scm_out_of_range_key,
             NULL,
@@ -6838,54 +6839,124 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max)
              scm_list_3 (min, max, bad_val),
              scm_list_1 (bad_val));
 }
+#define scm_i_range_error range_error
 
-#define TYPE                     intmax_t
-#define TYPE_MIN                 min
-#define TYPE_MAX                 max
-#define SIZEOF_TYPE              0
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_signed_integer (arg, intmax_t min, 
intmax_t max)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_signed_integer (arg)
-#include "conv-integer.i.c"
+static scm_t_inum
+inum_in_range (SCM x, scm_t_inum min, scm_t_inum max)
+{
+  if (SCM_LIKELY (SCM_I_INUMP (x)))
+    {
+      scm_t_inum val = SCM_I_INUM (x);
+      if (min <= val && val <= max)
+        return val;
+    }
+  else if (!SCM_BIGP (x))
+    scm_wrong_type_arg_msg (NULL, 0, x, "exact integer");
+  range_error (x, scm_from_long (min), scm_from_long (max));
+}
 
-#define TYPE                     uintmax_t
-#define TYPE_MIN                 min
-#define TYPE_MAX                 max
-#define SIZEOF_TYPE              0
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_unsigned_integer (arg, uintmax_t min, 
uintmax_t max)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_unsigned_integer (arg)
-#include "conv-uinteger.i.c"
+SCM
+scm_from_signed_integer (intmax_t arg)
+{
+  return scm_integer_from_int64 (arg);
+}
 
-#define TYPE                     int8_t
-#define TYPE_MIN                 INT8_MIN
-#define TYPE_MAX                 INT8_MAX
-#define SIZEOF_TYPE              1
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_int8 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_int8 (arg)
-#include "conv-integer.i.c"
+intmax_t
+scm_to_signed_integer (SCM arg, intmax_t min, intmax_t max)
+{
+  int64_t ret;
+  if (SCM_I_INUMP (arg))
+    ret = SCM_I_INUM (arg);
+  else if (SCM_BIGP (arg))
+    {
+      if (!scm_integer_to_int64_z (scm_bignum (arg), &ret))
+        goto out_of_range;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer");
+  if (min <= ret && ret <= max)
+    return ret;
+ out_of_range:
+  range_error (arg, scm_from_intmax (min), scm_from_intmax (max));
+}
 
-#define TYPE                     uint8_t
-#define TYPE_MIN                 0
-#define TYPE_MAX                 UINT8_MAX
-#define SIZEOF_TYPE              1
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_uint8 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_uint8 (arg)
-#include "conv-uinteger.i.c"
+SCM
+scm_from_unsigned_integer (uintmax_t arg)
+{
+  return scm_integer_from_uint64 (arg);
+}
 
-#define TYPE                     int16_t
-#define TYPE_MIN                 INT16_MIN
-#define TYPE_MAX                 INT16_MAX
-#define SIZEOF_TYPE              2
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_int16 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_int16 (arg)
-#include "conv-integer.i.c"
+uintmax_t
+scm_to_unsigned_integer (SCM arg, uintmax_t min, uintmax_t max)
+{
+  uint64_t ret;
+  if (SCM_I_INUMP (arg))
+    {
+      scm_t_inum n = SCM_I_INUM (arg);
+      if (n < 0)
+        goto out_of_range;
+      ret = n;
+    }
+  else if (SCM_BIGP (arg))
+    {
+      if (!scm_integer_to_uint64_z (scm_bignum (arg), &ret))
+        goto out_of_range;
+    }
+  else
+    scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer");
+  if (min <= ret && ret <= max)
+    return ret;
+ out_of_range:
+  range_error (arg, scm_from_uintmax (min), scm_from_uintmax (max));
+}
 
-#define TYPE                     uint16_t
-#define TYPE_MIN                 0
-#define TYPE_MAX                 UINT16_MAX
-#define SIZEOF_TYPE              2
-#define SCM_TO_TYPE_PROTO(arg)   scm_to_uint16 (arg)
-#define SCM_FROM_TYPE_PROTO(arg) scm_from_uint16 (arg)
-#include "conv-uinteger.i.c"
+int8_t
+scm_to_int8 (SCM arg)
+{
+  return inum_in_range (arg, INT8_MIN, INT8_MAX);
+}
+
+SCM
+scm_from_int8 (int8_t arg)
+{
+  return SCM_I_MAKINUM (arg);
+}
+
+uint8_t
+scm_to_uint8 (SCM arg)
+{
+  return inum_in_range (arg, 0, UINT8_MAX);
+}
+
+SCM
+scm_from_uint8 (uint8_t arg)
+{
+  return SCM_I_MAKINUM (arg);
+}
+
+int16_t
+scm_to_int16 (SCM arg)
+{
+  return inum_in_range (arg, INT16_MIN, INT16_MAX);
+}
+
+SCM
+scm_from_int16 (int16_t arg)
+{
+  return SCM_I_MAKINUM (arg);
+}
+
+uint16_t
+scm_to_uint16 (SCM arg)
+{
+  return inum_in_range (arg, 0, UINT16_MAX);
+}
+
+SCM
+scm_from_uint16 (uint16_t arg)
+{
+  return SCM_I_MAKINUM (arg);
+}
 
 #define TYPE                     int32_t
 #define TYPE_MIN                 INT32_MIN