diff options
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 61 |
1 files changed, 27 insertions, 34 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 3be5314e0..a8c8996fa 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -452,28 +452,21 @@ scm_i_make_ratio (SCM numerator, SCM denominator) /* No, it's a proper fraction. */ - return scm_double_cell (scm_tc16_fraction, - SCM_UNPACK (numerator), - SCM_UNPACK (denominator), 0); + { + SCM divisor = scm_gcd (numerator, denominator); + if (!(scm_is_eq (divisor, SCM_I_MAKINUM(1)))) + { + numerator = scm_divide (numerator, divisor); + denominator = scm_divide (denominator, divisor); + } + + return scm_double_cell (scm_tc16_fraction, + SCM_UNPACK (numerator), + SCM_UNPACK (denominator), 0); + } } #undef FUNC_NAME -static void scm_i_fraction_reduce (SCM z) -{ - if (!(SCM_FRACTION_REDUCED (z))) - { - SCM divisor; - divisor = scm_gcd (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); - if (!(scm_is_eq (divisor, SCM_I_MAKINUM(1)))) - { - /* is this safe? */ - SCM_FRACTION_SET_NUMERATOR (z, scm_divide (SCM_FRACTION_NUMERATOR (z), divisor)); - SCM_FRACTION_SET_DENOMINATOR (z, scm_divide (SCM_FRACTION_DENOMINATOR (z), divisor)); - } - SCM_FRACTION_REDUCED_SET (z); - } -} - double scm_i_fraction2double (SCM z) { @@ -2387,7 +2380,6 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0, } else if (SCM_FRACTIONP (n)) { - scm_i_fraction_reduce (n); return scm_string_append (scm_list_3 (scm_number_to_string (SCM_FRACTION_NUMERATOR (n), radix), scm_from_locale_string ("/"), scm_number_to_string (SCM_FRACTION_DENOMINATOR (n), radix))); @@ -2441,7 +2433,6 @@ int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { SCM str; - scm_i_fraction_reduce (sexp); str = scm_number_to_string (sexp, SCM_UNDEFINED); scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port); scm_remember_upto_here_1 (str); @@ -3109,8 +3100,6 @@ scm_complex_equalp (SCM x, SCM y) SCM scm_i_fraction_equalp (SCM x, SCM y) { - scm_i_fraction_reduce (x); - scm_i_fraction_reduce (y); if (scm_is_false (scm_equal_p (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_NUMERATOR (y))) || scm_is_false (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), @@ -4492,7 +4481,12 @@ scm_product (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_I_INUMP (y)) - return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x)); + { + /* inexact*exact0 => exact 0, per R5RS "Exactness" section */ + if (scm_is_eq (y, SCM_INUM0)) + return y; + return scm_from_double (SCM_I_INUM (y) * SCM_REAL_VALUE (x)); + } else if (SCM_BIGP (y)) { double result = mpz_get_d (SCM_I_BIG_MPZ (y)) * SCM_REAL_VALUE (x); @@ -4512,8 +4506,13 @@ scm_product (SCM x, SCM y) else if (SCM_COMPLEXP (x)) { if (SCM_I_INUMP (y)) - return scm_c_make_rectangular (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x), - SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x)); + { + /* inexact*exact0 => exact 0, per R5RS "Exactness" section */ + if (scm_is_eq (y, SCM_INUM0)) + return y; + return scm_c_make_rectangular (SCM_I_INUM (y) * SCM_COMPLEX_REAL (x), + SCM_I_INUM (y) * SCM_COMPLEX_IMAG (x)); + } else if (SCM_BIGP (y)) { double z = mpz_get_d (SCM_I_BIG_MPZ (y)); @@ -5425,10 +5424,7 @@ scm_numerator (SCM z) else if (SCM_BIGP (z)) return z; else if (SCM_FRACTIONP (z)) - { - scm_i_fraction_reduce (z); - return SCM_FRACTION_NUMERATOR (z); - } + return SCM_FRACTION_NUMERATOR (z); else if (SCM_REALP (z)) return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); else @@ -5447,10 +5443,7 @@ scm_denominator (SCM z) else if (SCM_BIGP (z)) return SCM_I_MAKINUM (1); else if (SCM_FRACTIONP (z)) - { - scm_i_fraction_reduce (z); - return SCM_FRACTION_DENOMINATOR (z); - } + return SCM_FRACTION_DENOMINATOR (z); else if (SCM_REALP (z)) return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); else |