diff options
author | Andy Wingo <wingo@pobox.com> | 2021-12-03 22:34:09 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2022-01-13 09:37:16 +0100 |
commit | 31da9be6c49eb14c2292312ba9cff737a3a107e6 (patch) | |
tree | 737806097926e28bf9f74d34b44012cec3cae8e7 | |
parent | 44c654aa3e40a86b488ba189be66aee661999cae (diff) | |
download | guile-31da9be6c49eb14c2292312ba9cff737a3a107e6.tar.gz |
Implement floor-quotient with new integer lib
* libguile/integers.c (scm_integer_floor_quotient_ii)
(scm_integer_floor_quotient_iz, scm_integer_floor_quotient_zi)
(scm_integer_floor_quotient_zz): New internal functions.
(long_to_scm, ulong_to_scm, take_bignum_from_mpz): New helpers.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_floor_quotient): Use the new functions.
-rw-r--r-- | libguile/integers.c | 86 | ||||
-rw-r--r-- | libguile/integers.h | 5 | ||||
-rw-r--r-- | libguile/numbers.c | 68 |
3 files changed, 92 insertions, 67 deletions
diff --git a/libguile/integers.c b/libguile/integers.c index 34a1d4af8..87483a73f 100644 --- a/libguile/integers.c +++ b/libguile/integers.c @@ -180,10 +180,20 @@ long_to_bignum (long i) }; static SCM -inum_to_bignum (scm_t_inum i) +long_to_scm (long i) { + if (SCM_FIXABLE (i)) + return SCM_I_MAKINUM (i); return long_to_bignum (i); -}; +} + +static SCM +ulong_to_scm (unsigned long i) +{ + if (SCM_POSFIXABLE (i)) + return SCM_I_MAKINUM (i); + return ulong_to_bignum (i); +} static struct scm_bignum * clone_bignum (struct scm_bignum *z) @@ -212,6 +222,14 @@ make_bignum_from_mpz (mpz_srcptr mpz) return mpz_sgn (mpz) < 0 ? negate_bignum (ret) : ret; } +static struct scm_bignum * +take_bignum_from_mpz (mpz_ptr mpz) +{ + struct scm_bignum *res = make_bignum_from_mpz (mpz); + mpz_clear (mpz); + return res; +} + static SCM normalize_bignum (struct scm_bignum *z) { @@ -251,11 +269,7 @@ scm_integer_abs_i (scm_t_inum i) if (i >= 0) return SCM_I_MAKINUM (i); - unsigned long abs = long_magnitude (i); - if (SCM_LIKELY (SCM_POSFIXABLE (abs))) - return SCM_I_MAKINUM (abs); - - return ulong_to_bignum (abs); + return ulong_to_scm (long_magnitude (i)); } SCM @@ -266,3 +280,61 @@ scm_integer_abs_z (SCM z) return SCM_PACK (negate_bignum (clone_bignum (scm_bignum (z)))); } + +SCM +scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y) +{ + if (y > 0) + { + if (x < 0) + x = x - y + 1; + } + else if (y == 0) + scm_num_overflow ("floor-quotient"); + else if (x > 0) + x = x - y - 1; + scm_t_inum q = x / y; + return long_to_scm (q); +} + +SCM +scm_integer_floor_quotient_iz (scm_t_inum x, SCM y) +{ + if (x == 0 || ((x < 0) == bignum_is_negative (scm_bignum (y)))) + return SCM_INUM0; + return SCM_I_MAKINUM (-1); +} + +SCM +scm_integer_floor_quotient_zi (SCM x, scm_t_inum y) +{ + if (y == 0) + scm_num_overflow ("floor-quotient"); + else if (y == 1) + return x; + + mpz_t zx, q; + alias_bignum_to_mpz (scm_bignum (x), zx); + mpz_init (q); + if (y > 0) + mpz_fdiv_q_ui (q, zx, y); + else + { + mpz_cdiv_q_ui (q, zx, -y); + mpz_neg (q, q); + } + scm_remember_upto_here_1 (x); + return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q))); +} + +SCM +scm_integer_floor_quotient_zz (SCM x, SCM y) +{ + mpz_t zx, zy, q; + alias_bignum_to_mpz (scm_bignum (x), zx); + alias_bignum_to_mpz (scm_bignum (y), zy); + mpz_init (q); + mpz_fdiv_q (q, zx, zy); + scm_remember_upto_here_2 (x, y); + return SCM_PACK (normalize_bignum (take_bignum_from_mpz (q))); +} diff --git a/libguile/integers.h b/libguile/integers.h index 753ff1f74..99e4246cd 100644 --- a/libguile/integers.h +++ b/libguile/integers.h @@ -29,6 +29,11 @@ SCM_INTERNAL int scm_is_integer_odd_z (SCM z); SCM_INTERNAL SCM scm_integer_abs_i (scm_t_inum i); SCM_INTERNAL SCM scm_integer_abs_z (SCM z); +SCM_INTERNAL SCM scm_integer_floor_quotient_ii (scm_t_inum x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_floor_quotient_iz (scm_t_inum x, SCM y); +SCM_INTERNAL SCM scm_integer_floor_quotient_zi (SCM x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_floor_quotient_zz (SCM x, SCM y); + #endif /* SCM_INTEGERS_H */ diff --git a/libguile/numbers.c b/libguile/numbers.c index ea0cf67bb..d79ee214b 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1200,40 +1200,14 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_floor_quotient { - if (SCM_LIKELY (SCM_I_INUMP (x))) + if (SCM_I_INUMP (x)) { - scm_t_inum xx = SCM_I_INUM (x); - if (SCM_LIKELY (SCM_I_INUMP (y))) - { - scm_t_inum yy = SCM_I_INUM (y); - scm_t_inum xx1 = xx; - scm_t_inum qq; - if (SCM_LIKELY (yy > 0)) - { - if (SCM_UNLIKELY (xx < 0)) - xx1 = xx - yy + 1; - } - else if (SCM_UNLIKELY (yy == 0)) - scm_num_overflow (s_scm_floor_quotient); - else if (xx > 0) - xx1 = xx - yy - 1; - qq = xx1 / yy; - if (SCM_LIKELY (SCM_FIXABLE (qq))) - return SCM_I_MAKINUM (qq); - else - return scm_i_inum2big (qq); - } + if (SCM_I_INUMP (y)) + return scm_integer_floor_quotient_ii (SCM_I_INUM (x), SCM_I_INUM (y)); else if (SCM_BIGP (y)) - { - int sign = mpz_sgn (SCM_I_BIG_MPZ (y)); - scm_remember_upto_here_1 (y); - if (sign > 0) - return SCM_I_MAKINUM ((xx < 0) ? -1 : 0); - else - return SCM_I_MAKINUM ((xx > 0) ? -1 : 0); - } + return scm_integer_floor_quotient_iz (SCM_I_INUM (x), y); else if (SCM_REALP (y)) - return scm_i_inexact_floor_quotient (xx, SCM_REAL_VALUE (y)); + return scm_i_inexact_floor_quotient (SCM_I_INUM (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else @@ -1242,36 +1216,10 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, } else if (SCM_BIGP (x)) { - if (SCM_LIKELY (SCM_I_INUMP (y))) - { - scm_t_inum yy = SCM_I_INUM (y); - if (SCM_UNLIKELY (yy == 0)) - scm_num_overflow (s_scm_floor_quotient); - else if (SCM_UNLIKELY (yy == 1)) - return x; - else - { - SCM q = scm_i_mkbig (); - if (yy > 0) - mpz_fdiv_q_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (x), yy); - else - { - mpz_cdiv_q_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (x), -yy); - mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q)); - } - scm_remember_upto_here_1 (x); - return scm_i_normbig (q); - } - } + if (SCM_I_INUMP (y)) + return scm_integer_floor_quotient_zi (x, SCM_I_INUM (y)); else if (SCM_BIGP (y)) - { - SCM q = scm_i_mkbig (); - mpz_fdiv_q (SCM_I_BIG_MPZ (q), - SCM_I_BIG_MPZ (x), - SCM_I_BIG_MPZ (y)); - scm_remember_upto_here_2 (x, y); - return scm_i_normbig (q); - } + return scm_integer_floor_quotient_zz (x, y); else if (SCM_REALP (y)) return scm_i_inexact_floor_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); |