mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Andy Wingo
parent
f4db3ca3f9
commit
27910181c5
3 changed files with 158 additions and 43 deletions
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue