diff options
author | Andy Wingo <wingo@pobox.com> | 2021-12-19 09:52:39 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2022-01-13 09:37:16 +0100 |
commit | 6fa9fcb313e75164316dbc048aba4cd65e531676 (patch) | |
tree | a5dc7e8fced5a23d9856a0f6838897ebe968f8a5 | |
parent | 1e0797db7289ad27758a1cf77d89105459475ee7 (diff) | |
download | guile-6fa9fcb313e75164316dbc048aba4cd65e531676.tar.gz |
Implement lcm with new integer lib
* libguile/integers.c (scm_integer_lcm_ii)
(scm_integer_lcm_zi, scm_integer_lcm_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_lcm): Use the new functions.
-rw-r--r-- | libguile/integers.c | 37 | ||||
-rw-r--r-- | libguile/integers.h | 4 | ||||
-rw-r--r-- | libguile/numbers.c | 48 |
3 files changed, 50 insertions, 39 deletions
diff --git a/libguile/integers.c b/libguile/integers.c index cca40bc8b..3c7a86709 100644 --- a/libguile/integers.c +++ b/libguile/integers.c @@ -1817,3 +1817,40 @@ scm_integer_gcd_zz (SCM x, SCM y) scm_remember_upto_here_2 (x, y); return take_mpz (result); } + +SCM +scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y) +{ + SCM d = scm_integer_gcd_ii (x, y); + if (scm_is_eq (d, SCM_INUM0)) + return d; + else + return scm_abs (scm_product (SCM_I_MAKINUM (x), + scm_quotient (SCM_I_MAKINUM (y), d))); +} + +SCM +scm_integer_lcm_zi (SCM x, scm_t_inum y) +{ + if (y == 0) return SCM_INUM0; + if (y < 0) y = - y; + mpz_t result, zx; + mpz_init (result); + alias_bignum_to_mpz (scm_bignum (x), zx); + mpz_lcm_ui (result, zx, y); + scm_remember_upto_here_1 (x); + return take_mpz (result); +} + +SCM +scm_integer_lcm_zz (SCM x, SCM y) +{ + mpz_t result, zx, zy; + mpz_init (result); + alias_bignum_to_mpz (scm_bignum (x), zx); + alias_bignum_to_mpz (scm_bignum (y), zy); + mpz_lcm (result, zx, zy); + scm_remember_upto_here_2 (x, y); + /* shouldn't need to normalize b/c lcm of 2 bigs should be big */ + return take_mpz (result); +} diff --git a/libguile/integers.h b/libguile/integers.h index 699525b3f..31407b79e 100644 --- a/libguile/integers.h +++ b/libguile/integers.h @@ -128,6 +128,10 @@ SCM_INTERNAL SCM scm_integer_gcd_ii (scm_t_inum x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_gcd_zi (SCM x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_gcd_zz (SCM x, SCM y); +SCM_INTERNAL SCM scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_lcm_zi (SCM x, scm_t_inum y); +SCM_INTERNAL SCM scm_integer_lcm_zz (SCM x, SCM y); + #endif /* SCM_INTEGERS_H */ diff --git a/libguile/numbers.c b/libguile/numbers.c index f0ddc9379..7aea6661a 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2844,33 +2844,15 @@ SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1, SCM scm_lcm (SCM n1, SCM n2) { - if (SCM_UNLIKELY (SCM_UNBNDP (n2))) + if (SCM_UNBNDP (n2)) return SCM_UNBNDP (n1) ? SCM_INUM1 : scm_abs (n1); - if (SCM_LIKELY (SCM_I_INUMP (n1))) + if (SCM_I_INUMP (n1)) { - if (SCM_LIKELY (SCM_I_INUMP (n2))) - { - SCM d = scm_gcd (n1, n2); - if (scm_is_eq (d, SCM_INUM0)) - return d; - else - return scm_abs (scm_product (n1, scm_quotient (n2, d))); - } - else if (SCM_LIKELY (SCM_BIGP (n2))) - { - /* inum n1, big n2 */ - inumbig: - { - SCM result = scm_i_mkbig (); - scm_t_inum nn1 = SCM_I_INUM (n1); - if (nn1 == 0) return SCM_INUM0; - if (nn1 < 0) nn1 = - nn1; - mpz_lcm_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n2), nn1); - scm_remember_upto_here_1 (n2); - return result; - } - } + if (SCM_I_INUMP (n2)) + return scm_integer_lcm_ii (SCM_I_INUM (n1), SCM_I_INUM (n2)); + else if (SCM_BIGP (n2)) + return scm_integer_lcm_zi (n2, SCM_I_INUM (n1)); else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else @@ -2878,22 +2860,10 @@ scm_lcm (SCM n1, SCM n2) } else if (SCM_LIKELY (SCM_BIGP (n1))) { - /* big n1 */ if (SCM_I_INUMP (n2)) - { - SCM_SWAP (n1, n2); - goto inumbig; - } - else if (SCM_LIKELY (SCM_BIGP (n2))) - { - SCM result = scm_i_mkbig (); - mpz_lcm(SCM_I_BIG_MPZ (result), - SCM_I_BIG_MPZ (n1), - SCM_I_BIG_MPZ (n2)); - scm_remember_upto_here_2(n1, n2); - /* shouldn't need to normalize b/c lcm of 2 bigs should be big */ - return result; - } + return scm_integer_lcm_zi (n1, SCM_I_INUM (n2)); + else if (SCM_BIGP (n2)) + return scm_integer_lcm_zz (n1, n2); else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else |