mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Clean up scm_sum

Browse source 
* libguile/integers.h:
* libguile/integers.c (scm_integer_to_double_z):
(scm_integer_add_ii, scm_integer_add_zi, scm_integer_add_zz): New
internal functions.
* libguile/numbers.c (sum): New helper for scm_sum.  Clean up to avoid
repetition.  The dispatch is less optimal but the code is shorter and
more maintainable; in any case if speed is important, the compiler needs
to be involved.
(scm_sum): Adapt.
This commit is contained in:
Andy Wingo 2022-01-04 15:09:01 +01:00
parent 281aed8aa0
commit 10953e067c
3 changed files with 152 additions and 170 deletions
Download patch file Download diff file Expand all files Collapse all files

57
libguile/integers.c
View file

@ -2502,3 +2502,60 @@ scm_is_integer_negative_z (struct scm_bignum *x)
{ {
return bignum_is_negative (x); return bignum_is_negative (x);
} }
double
scm_integer_to_double_z (struct scm_bignum *x)
{
mpz_t zx;
alias_bignum_to_mpz (x, zx);
double result = mpz_get_d (zx);
scm_remember_upto_here_1 (x);
return result;
}
SCM
scm_integer_add_ii (scm_t_inum x, scm_t_inum y)
{
return long_to_scm (x + y);
}
SCM
scm_integer_add_zi (struct scm_bignum *x, scm_t_inum y)
{
if (y == 0)
return scm_from_bignum (x);
mpz_t result, zx;
mpz_init (result);
alias_bignum_to_mpz (x, zx);
if (y < 0)
{
mpz_sub_ui (result, zx, - y);
scm_remember_upto_here_1 (x);
// FIXME: We know that if X is negative, no need to check if
// result is fixable.
return take_mpz (result);
}
else
{
mpz_add_ui (result, zx, y);
scm_remember_upto_here_1 (x);
// FIXME: We know that if X is positive, no need to check if
// result is fixable.
return take_mpz (result);
}
}
SCM
scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum *y)
{
mpz_t result, zx, zy;
mpz_init (result);
alias_bignum_to_mpz (x, zx);
alias_bignum_to_mpz (y, zy);
mpz_add (result, zx, zy);
scm_remember_upto_here_2 (x, y);
// FIXME: We know that if X and Y have the same sign, no need to check
// if result is fixable.
return take_mpz (result);
}

6
libguile/integers.h
View file

@ -166,6 +166,12 @@ SCM_INTERNAL int scm_is_integer_less_than_rz (double y, struct scm_bignum *x);
SCM_INTERNAL int scm_is_integer_positive_z (struct scm_bignum *x); SCM_INTERNAL int scm_is_integer_positive_z (struct scm_bignum *x);
SCM_INTERNAL int scm_is_integer_negative_z (struct scm_bignum *x); SCM_INTERNAL int scm_is_integer_negative_z (struct scm_bignum *x);
SCM_INTERNAL double scm_integer_to_double_z (struct scm_bignum *x);
SCM_INTERNAL SCM scm_integer_add_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_add_zi (struct scm_bignum *x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_add_zz (struct scm_bignum *x, struct scm_bignum *y);
#endif /* SCM_INTEGERS_H */ #endif /* SCM_INTEGERS_H */

259
libguile/numbers.c
View file

@ -5132,185 +5132,104 @@ SCM_PRIMITIVE_GENERIC (scm_i_sum, "+", 0, 2, 1,
#define s_sum s_scm_i_sum #define s_sum s_scm_i_sum
#define g_sum g_scm_i_sum #define g_sum g_scm_i_sum
static SCM
sum (SCM x, SCM y)
{
if (SCM_I_INUMP (x))
{
if (SCM_I_INUMP (y))
return scm_integer_add_ii (SCM_I_INUM (x), SCM_I_INUM (y));
else if (SCM_BIGP (y))
return scm_integer_add_zi (scm_bignum (y), SCM_I_INUM (x));
else if (SCM_REALP (y))
return scm_i_from_double (SCM_I_INUM (x) + SCM_REAL_VALUE (y));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_I_INUM (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio
(scm_sum (SCM_FRACTION_NUMERATOR (y),
scm_product (x, SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
abort (); /* Unreachable. */
}
else if (SCM_BIGP (x))
{
if (SCM_BIGP (y))
return scm_integer_add_zz (scm_bignum (x), scm_bignum (y));
else if (SCM_REALP (y))
return scm_i_from_double (scm_integer_to_double_z (scm_bignum (x))
+ SCM_REAL_VALUE (y));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (scm_integer_to_double_z (scm_bignum (x))
+ SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (y),
scm_product (x, SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
else
return sum (y, x);
}
else if (SCM_REALP (x))
{
if (SCM_REALP (y))
return scm_i_from_double (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
else
return sum (y, x);
}
else if (SCM_COMPLEXP (x))
{
if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (x) + SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + scm_i_fraction2double (y),
SCM_COMPLEX_IMAG (x));
else
return sum (y, x);
}
else if (SCM_FRACTIONP (x))
{
if (SCM_FRACTIONP (y))
{
SCM nx = SCM_FRACTION_NUMERATOR (x);
SCM ny = SCM_FRACTION_NUMERATOR (y);
SCM dx = SCM_FRACTION_DENOMINATOR (x);
SCM dy = SCM_FRACTION_DENOMINATOR (y);
return scm_i_make_ratio (scm_sum (scm_product (nx, dy),
scm_product (ny, dx)),
scm_product (dx, dy));
}
else
return sum (y, x);
}
else
abort (); /* Unreachable. */
}
SCM SCM
scm_sum (SCM x, SCM y) scm_sum (SCM x, SCM y)
{ {
if (SCM_UNLIKELY (SCM_UNBNDP (y))) if (SCM_UNBNDP (y))
{ {
if (SCM_NUMBERP (x)) return x; if (SCM_NUMBERP (x)) return x;
if (SCM_UNBNDP (x)) return SCM_INUM0; if (SCM_UNBNDP (x)) return SCM_INUM0;
return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum); return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum);
} }
if (SCM_LIKELY (SCM_I_INUMP (x))) if (!SCM_NUMBERP (x))
{
if (SCM_LIKELY (SCM_I_INUMP (y)))
{
scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum yy = SCM_I_INUM (y);
scm_t_inum z = xx + yy;
return SCM_FIXABLE (z) ? SCM_I_MAKINUM (z) : scm_i_inum2big (z);
}
else if (SCM_BIGP (y))
{
SCM_SWAP (x, y);
goto add_big_inum;
}
else if (SCM_REALP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
return scm_i_from_double (xx + SCM_REAL_VALUE (y));
}
else if (SCM_COMPLEXP (y))
{
scm_t_inum xx = SCM_I_INUM (x);
return scm_c_make_rectangular (xx + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
}
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (y),
scm_product (x, SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_BIGP (x))
{
if (SCM_I_INUMP (y))
{
scm_t_inum inum;
int bigsgn;
add_big_inum:
inum = SCM_I_INUM (y);
if (inum == 0)
return x;
bigsgn = mpz_sgn (SCM_I_BIG_MPZ (x));
if (inum < 0)
{
SCM result = scm_i_mkbig ();
mpz_sub_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), - inum);
scm_remember_upto_here_1 (x);
/* we know the result will have to be a bignum */
if (bigsgn == -1)
return result;
return scm_i_normbig (result);
}
else
{
SCM result = scm_i_mkbig ();
mpz_add_ui (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (x), inum);
scm_remember_upto_here_1 (x);
/* we know the result will have to be a bignum */
if (bigsgn == 1)
return result;
return scm_i_normbig (result);
}
}
else if (SCM_BIGP (y))
{
SCM result = scm_i_mkbig ();
int sgn_x = mpz_sgn (SCM_I_BIG_MPZ (x));
int sgn_y = mpz_sgn (SCM_I_BIG_MPZ (y));
mpz_add (SCM_I_BIG_MPZ (result),
SCM_I_BIG_MPZ (x),
SCM_I_BIG_MPZ (y));
scm_remember_upto_here_2 (x, y);
/* we know the result will have to be a bignum */
if (sgn_x == sgn_y)
return result;
return scm_i_normbig (result);
}
else if (SCM_REALP (y))
{
double result = mpz_get_d (SCM_I_BIG_MPZ (x)) + SCM_REAL_VALUE (y);
scm_remember_upto_here_1 (x);
return scm_i_from_double (result);
}
else if (SCM_COMPLEXP (y))
{
double real_part = (mpz_get_d (SCM_I_BIG_MPZ (x))
+ SCM_COMPLEX_REAL (y));
scm_remember_upto_here_1 (x);
return scm_c_make_rectangular (real_part, SCM_COMPLEX_IMAG (y));
}
else if (SCM_FRACTIONP (y))
return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (y),
scm_product (x, SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_REALP (x))
{
if (SCM_I_INUMP (y))
return scm_i_from_double (SCM_REAL_VALUE (x) + SCM_I_INUM (y));
else if (SCM_BIGP (y))
{
double result = mpz_get_d (SCM_I_BIG_MPZ (y)) + SCM_REAL_VALUE (x);
scm_remember_upto_here_1 (y);
return scm_i_from_double (result);
}
else if (SCM_REALP (y))
return scm_i_from_double (SCM_REAL_VALUE (x) + SCM_REAL_VALUE (y));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_COMPLEXP (x))
{
if (SCM_I_INUMP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_I_INUM (y),
SCM_COMPLEX_IMAG (x));
else if (SCM_BIGP (y))
{
double real_part = (mpz_get_d (SCM_I_BIG_MPZ (y))
+ SCM_COMPLEX_REAL (x));
scm_remember_upto_here_1 (y);
return scm_c_make_rectangular (real_part, SCM_COMPLEX_IMAG (x));
}
else if (SCM_REALP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_REAL_VALUE (y),
SCM_COMPLEX_IMAG (x));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (x) + SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + scm_i_fraction2double (y),
SCM_COMPLEX_IMAG (x));
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_FRACTIONP (x))
{
if (SCM_I_INUMP (y))
return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (x),
scm_product (y, SCM_FRACTION_DENOMINATOR (x))),
SCM_FRACTION_DENOMINATOR (x));
else if (SCM_BIGP (y))
return scm_i_make_ratio (scm_sum (SCM_FRACTION_NUMERATOR (x),
scm_product (y, SCM_FRACTION_DENOMINATOR (x))),
SCM_FRACTION_DENOMINATOR (x));
else if (SCM_REALP (y))
return scm_i_from_double (SCM_REAL_VALUE (y) + scm_i_fraction2double (x));
else if (SCM_COMPLEXP (y))
return scm_c_make_rectangular (SCM_COMPLEX_REAL (y) + scm_i_fraction2double (x),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
/* a/b + c/d = (ad + bc) / bd */
return scm_i_make_ratio (scm_sum (scm_product (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (y)),
scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))),
scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y)));
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum); return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum);
} if (!SCM_NUMBERP (y))
return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG2, s_sum);
return sum (x, y);
}
SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0, SCM_DEFINE (scm_oneplus, "1+", 1, 0, 0,
(SCM x), (SCM x),
@ -5375,9 +5294,9 @@ scm_difference (SCM x, SCM y)
return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference); return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference);
} }
if (SCM_LIKELY (SCM_I_INUMP (x))) if (SCM_I_INUMP (x))
{ {
if (SCM_LIKELY (SCM_I_INUMP (y))) if (SCM_I_INUMP (y))
{ {
scm_t_inum xx = SCM_I_INUM (x); scm_t_inum xx = SCM_I_INUM (x);
scm_t_inum yy = SCM_I_INUM (y); scm_t_inum yy = SCM_I_INUM (y);