From 5a0677e5daafa6dd10dd7612468d1ea1e38692b7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 10 Feb 2011 18:18:34 -0500 Subject: [PATCH] Optimize division operators handling of fractions * libguile/numbers.c: (scm_euclidean_quotient, scm_euclidean_remainder, scm_euclidean_divide, scm_floor_quotient, scm_floor_remainder, scm_floor_divide, scm_ceiling_quotient, scm_ceiling_remainder, scm_ceiling_divide, scm_truncate_quotient, scm_truncate_remainder, scm_truncate_divide, scm_centered_quotient, scm_centered_remainder, scm_centered_divide, scm_round_quotient, scm_round_remainder, scm_round_divide): Optimize case where both arguments are exact and at least one is a fraction, by reducing to a subproblem involving only integers, and then adjusting the resulting remainder as needed. --- libguile/numbers.c | 622 +++++++++++++++++++++------------------------------- 1 files changed, 249 insertions(+), 373 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 90e449f..3ef8fe5 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1070,7 +1070,7 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0, #undef FUNC_NAME static SCM scm_i_inexact_euclidean_quotient (double x, double y); -static SCM scm_i_slow_exact_euclidean_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_euclidean_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, (SCM x, SCM y), @@ -1125,7 +1125,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_euclidean_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_quotient (x, y); + return scm_i_exact_rational_euclidean_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG2, s_scm_euclidean_quotient); @@ -1171,7 +1171,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, return scm_i_inexact_euclidean_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_quotient (x, y); + return scm_i_exact_rational_euclidean_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG2, s_scm_euclidean_quotient); @@ -1191,8 +1191,11 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_euclidean_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_euclidean_quotient (x, y); else - return scm_i_slow_exact_euclidean_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG2, + s_scm_euclidean_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG1, @@ -1213,28 +1216,16 @@ scm_i_inexact_euclidean_quotient (double x, double y) return scm_nan (); } -/* Compute exact euclidean_quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_euclidean_quotient (SCM x, SCM y) +scm_i_exact_rational_euclidean_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG1, - s_scm_euclidean_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_quotient, x, y, SCM_ARG2, - s_scm_euclidean_quotient); - else if (scm_is_true (scm_positive_p (y))) - return scm_floor (scm_divide (x, y)); - else if (scm_is_true (scm_negative_p (y))) - return scm_ceiling (scm_divide (x, y)); - else - scm_num_overflow (s_scm_euclidean_quotient); + return scm_euclidean_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_euclidean_remainder (double x, double y); -static SCM scm_i_slow_exact_euclidean_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_euclidean_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0, (SCM x, SCM y), @@ -1294,7 +1285,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_euclidean_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_remainder (x, y); + return scm_i_exact_rational_euclidean_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG2, s_scm_euclidean_remainder); @@ -1329,7 +1320,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0, return scm_i_inexact_euclidean_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_remainder (x, y); + return scm_i_exact_rational_euclidean_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG2, s_scm_euclidean_remainder); @@ -1349,8 +1340,11 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_remainder, "euclidean-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_euclidean_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_euclidean_remainder (x, y); else - return scm_i_slow_exact_euclidean_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG2, + s_scm_euclidean_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG1, @@ -1383,32 +1377,19 @@ scm_i_inexact_euclidean_remainder (double x, double y) return scm_from_double (x - q * y); } -/* Compute exact euclidean_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_euclidean_remainder (SCM x, SCM y) +scm_i_exact_rational_euclidean_remainder (SCM x, SCM y) { - SCM q; - - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG1, - s_scm_euclidean_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_remainder, x, y, SCM_ARG2, - s_scm_euclidean_remainder); - else if (scm_is_true (scm_positive_p (y))) - q = scm_floor (scm_divide (x, y)); - else if (scm_is_true (scm_negative_p (y))) - q = scm_ceiling (scm_divide (x, y)); - else - scm_num_overflow (s_scm_euclidean_remainder); - return scm_difference (x, scm_product (y, q)); + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_euclidean_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_euclidean_divide (double x, double y); -static SCM scm_i_slow_exact_euclidean_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_euclidean_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, (SCM x, SCM y), @@ -1477,7 +1458,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_euclidean_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_divide (x, y); + return scm_i_exact_rational_euclidean_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, s_scm_euclidean_divide); @@ -1525,7 +1506,7 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, return scm_i_inexact_euclidean_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_euclidean_divide (x, y); + return scm_i_exact_rational_euclidean_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, s_scm_euclidean_divide); @@ -1545,8 +1526,11 @@ SCM_PRIMITIVE_GENERIC (scm_euclidean_divide, "euclidean/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_euclidean_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_euclidean_divide (x, y); else - return scm_i_slow_exact_euclidean_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, + s_scm_euclidean_divide); } else SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, @@ -1572,32 +1556,23 @@ scm_i_inexact_euclidean_divide (double x, double y) scm_from_double (r))); } -/* Compute exact euclidean quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_euclidean_divide (SCM x, SCM y) +scm_i_exact_rational_euclidean_divide (SCM x, SCM y) { - SCM q, r; + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG1, - s_scm_euclidean_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_euclidean_divide, x, y, SCM_ARG2, - s_scm_euclidean_divide); - else if (scm_is_true (scm_positive_p (y))) - q = scm_floor (scm_divide (x, y)); - else if (scm_is_true (scm_negative_p (y))) - q = scm_ceiling (scm_divide (x, y)); - else - scm_num_overflow (s_scm_euclidean_divide); - r = scm_difference (x, scm_product (q, y)); + scm_i_extract_values_2 + (scm_euclidean_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); return scm_values (scm_list_2 (q, r)); } static SCM scm_i_inexact_floor_quotient (double x, double y); -static SCM scm_i_slow_exact_floor_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_floor_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, (SCM x, SCM y), @@ -1647,7 +1622,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_floor_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_quotient (x, y); + return scm_i_exact_rational_floor_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, s_scm_floor_quotient); @@ -1688,7 +1663,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, return scm_i_inexact_floor_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_quotient (x, y); + return scm_i_exact_rational_floor_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, s_scm_floor_quotient); @@ -1708,8 +1683,11 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient, "floor-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_floor_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_floor_quotient (x, y); else - return scm_i_slow_exact_floor_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG1, @@ -1726,26 +1704,16 @@ scm_i_inexact_floor_quotient (double x, double y) return scm_from_double (floor (x / y)); } -/* Compute exact floor_quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_floor_quotient (SCM x, SCM y) +scm_i_exact_rational_floor_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG1, - s_scm_floor_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_floor_quotient); - else - return scm_floor (scm_divide (x, y)); + return scm_floor_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_floor_remainder (double x, double y); -static SCM scm_i_slow_exact_floor_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_floor_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, (SCM x, SCM y), @@ -1814,7 +1782,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_floor_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_remainder (x, y); + return scm_i_exact_rational_floor_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, s_scm_floor_remainder); @@ -1850,7 +1818,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, return scm_i_inexact_floor_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_remainder (x, y); + return scm_i_exact_rational_floor_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, s_scm_floor_remainder); @@ -1870,8 +1838,11 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder, "floor-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_floor_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_floor_remainder (x, y); else - return scm_i_slow_exact_floor_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG1, @@ -1896,28 +1867,19 @@ scm_i_inexact_floor_remainder (double x, double y) return scm_from_double (x - y * floor (x / y)); } -/* Compute exact floor_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_floor_remainder (SCM x, SCM y) +scm_i_exact_rational_floor_remainder (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG1, - s_scm_floor_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_floor_remainder); - else - return scm_difference - (x, scm_product (y, scm_floor (scm_divide (x, y)))); + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_floor_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_floor_divide (double x, double y); -static SCM scm_i_slow_exact_floor_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_floor_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_floor_divide, "floor/", 2, 0, 0, (SCM x, SCM y), @@ -1998,7 +1960,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_divide, "floor/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_floor_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_divide (x, y); + return scm_i_exact_rational_floor_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG2, s_scm_floor_divide); @@ -2042,7 +2004,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor_divide, "floor/", 2, 0, 0, return scm_i_inexact_floor_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_floor_divide (x, y); + return scm_i_exact_rational_floor_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG2, s_scm_floor_divide); @@ -2062,8 +2024,11 @@ SCM_PRIMITIVE_GENERIC (scm_floor_divide, "floor/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_floor_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_floor_divide (x, y); else - return scm_i_slow_exact_floor_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG2, + s_scm_floor_divide); } else SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG1, @@ -2085,30 +2050,23 @@ scm_i_inexact_floor_divide (double x, double y) scm_from_double (r))); } -/* Compute exact floor quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_floor_divide (SCM x, SCM y) +scm_i_exact_rational_floor_divide (SCM x, SCM y) { - SCM q, r; + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG1, - s_scm_floor_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_floor_divide, x, y, SCM_ARG2, - s_scm_floor_divide); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_floor_divide); - else - q = scm_floor (scm_divide (x, y)); - r = scm_difference (x, scm_product (q, y)); + scm_i_extract_values_2 + (scm_floor_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); return scm_values (scm_list_2 (q, r)); } static SCM scm_i_inexact_ceiling_quotient (double x, double y); -static SCM scm_i_slow_exact_ceiling_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_ceiling_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, (SCM x, SCM y), @@ -2178,7 +2136,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_ceiling_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_quotient (x, y); + return scm_i_exact_rational_ceiling_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, s_scm_ceiling_quotient); @@ -2219,7 +2177,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, return scm_i_inexact_ceiling_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_quotient (x, y); + return scm_i_exact_rational_ceiling_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, s_scm_ceiling_quotient); @@ -2239,8 +2197,11 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient, "ceiling-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_ceiling_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_ceiling_quotient (x, y); else - return scm_i_slow_exact_ceiling_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, @@ -2257,26 +2218,16 @@ scm_i_inexact_ceiling_quotient (double x, double y) return scm_from_double (ceil (x / y)); } -/* Compute exact ceiling_quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_ceiling_quotient (SCM x, SCM y) +scm_i_exact_rational_ceiling_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, - s_scm_ceiling_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_ceiling_quotient); - else - return scm_ceiling (scm_divide (x, y)); + return scm_ceiling_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_ceiling_remainder (double x, double y); -static SCM scm_i_slow_exact_ceiling_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_ceiling_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, (SCM x, SCM y), @@ -2355,7 +2306,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_ceiling_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_remainder (x, y); + return scm_i_exact_rational_ceiling_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, s_scm_ceiling_remainder); @@ -2391,7 +2342,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, return scm_i_inexact_ceiling_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_remainder (x, y); + return scm_i_exact_rational_ceiling_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, s_scm_ceiling_remainder); @@ -2411,8 +2362,11 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder, "ceiling-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_ceiling_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_ceiling_remainder (x, y); else - return scm_i_slow_exact_ceiling_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, @@ -2437,27 +2391,18 @@ scm_i_inexact_ceiling_remainder (double x, double y) return scm_from_double (x - y * ceil (x / y)); } -/* Compute exact ceiling_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_ceiling_remainder (SCM x, SCM y) +scm_i_exact_rational_ceiling_remainder (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, - s_scm_ceiling_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_ceiling_remainder); - else - return scm_difference - (x, scm_product (y, scm_ceiling (scm_divide (x, y)))); + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_ceiling_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_ceiling_divide (double x, double y); -static SCM scm_i_slow_exact_ceiling_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_ceiling_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_ceiling_divide, "ceiling/", 2, 0, 0, (SCM x, SCM y), @@ -2548,7 +2493,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_divide, "ceiling/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_ceiling_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_divide (x, y); + return scm_i_exact_rational_ceiling_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG2, s_scm_ceiling_divide); @@ -2592,7 +2537,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_divide, "ceiling/", 2, 0, 0, return scm_i_inexact_ceiling_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_ceiling_divide (x, y); + return scm_i_exact_rational_ceiling_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG2, s_scm_ceiling_divide); @@ -2612,8 +2557,11 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_divide, "ceiling/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_ceiling_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_ceiling_divide (x, y); else - return scm_i_slow_exact_ceiling_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG2, + s_scm_ceiling_divide); } else SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG1, @@ -2635,30 +2583,23 @@ scm_i_inexact_ceiling_divide (double x, double y) scm_from_double (r))); } -/* Compute exact ceiling quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_ceiling_divide (SCM x, SCM y) +scm_i_exact_rational_ceiling_divide (SCM x, SCM y) { - SCM q, r; + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG1, - s_scm_ceiling_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_ceiling_divide, x, y, SCM_ARG2, - s_scm_ceiling_divide); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_ceiling_divide); - else - q = scm_ceiling (scm_divide (x, y)); - r = scm_difference (x, scm_product (q, y)); + scm_i_extract_values_2 + (scm_ceiling_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); return scm_values (scm_list_2 (q, r)); } static SCM scm_i_inexact_truncate_quotient (double x, double y); -static SCM scm_i_slow_exact_truncate_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_truncate_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, (SCM x, SCM y), @@ -2706,7 +2647,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_truncate_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_quotient (x, y); + return scm_i_exact_rational_truncate_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, s_scm_truncate_quotient); @@ -2747,7 +2688,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, return scm_i_inexact_truncate_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_quotient (x, y); + return scm_i_exact_rational_truncate_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, s_scm_truncate_quotient); @@ -2767,8 +2708,11 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient, "truncate-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_truncate_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_truncate_quotient (x, y); else - return scm_i_slow_exact_truncate_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, @@ -2785,26 +2729,16 @@ scm_i_inexact_truncate_quotient (double x, double y) return scm_from_double (trunc (x / y)); } -/* Compute exact truncate_quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_truncate_quotient (SCM x, SCM y) +scm_i_exact_rational_truncate_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, - s_scm_truncate_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_truncate_quotient); - else - return scm_truncate_number (scm_divide (x, y)); + return scm_truncate_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_truncate_remainder (double x, double y); -static SCM scm_i_slow_exact_truncate_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_truncate_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, (SCM x, SCM y), @@ -2848,7 +2782,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_truncate_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_remainder (x, y); + return scm_i_exact_rational_truncate_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, s_scm_truncate_remainder); @@ -2882,7 +2816,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, return scm_i_inexact_truncate_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_remainder (x, y); + return scm_i_exact_rational_truncate_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, s_scm_truncate_remainder); @@ -2902,8 +2836,11 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_truncate_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_truncate_remainder (x, y); else - return scm_i_slow_exact_truncate_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, @@ -2927,28 +2864,19 @@ scm_i_inexact_truncate_remainder (double x, double y) return scm_from_double (x - y * trunc (x / y)); } -/* Compute exact truncate_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_truncate_remainder (SCM x, SCM y) +scm_i_exact_rational_truncate_remainder (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, - s_scm_truncate_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_truncate_remainder); - else - return scm_difference - (x, scm_product (y, scm_truncate_number (scm_divide (x, y)))); + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_truncate_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_truncate_divide (double x, double y); -static SCM scm_i_slow_exact_truncate_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_truncate_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_truncate_divide, "truncate/", 2, 0, 0, (SCM x, SCM y), @@ -3002,7 +2930,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_divide, "truncate/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_truncate_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_divide (x, y); + return scm_i_exact_rational_truncate_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG2, s_scm_truncate_divide); @@ -3047,7 +2975,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_divide, "truncate/", 2, 0, 0, return scm_i_inexact_truncate_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_truncate_divide (x, y); + return scm_i_exact_rational_truncate_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG2, s_scm_truncate_divide); @@ -3067,8 +2995,11 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_divide, "truncate/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_truncate_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_truncate_divide (x, y); else - return scm_i_slow_exact_truncate_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG2, + s_scm_truncate_divide); } else SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG1, @@ -3090,31 +3021,24 @@ scm_i_inexact_truncate_divide (double x, double y) scm_from_double (r))); } -/* Compute exact truncate quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_truncate_divide (SCM x, SCM y) +scm_i_exact_rational_truncate_divide (SCM x, SCM y) { - SCM q, r; + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG1, - s_scm_truncate_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_truncate_divide, x, y, SCM_ARG2, - s_scm_truncate_divide); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_truncate_divide); - else - q = scm_truncate_number (scm_divide (x, y)); - r = scm_difference (x, scm_product (q, y)); + scm_i_extract_values_2 + (scm_truncate_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); return scm_values (scm_list_2 (q, r)); } static SCM scm_i_inexact_centered_quotient (double x, double y); static SCM scm_i_bigint_centered_quotient (SCM x, SCM y); -static SCM scm_i_slow_exact_centered_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_centered_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, (SCM x, SCM y), @@ -3184,7 +3108,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_centered_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_quotient (x, y); + return scm_i_exact_rational_centered_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, s_scm_centered_quotient); @@ -3233,7 +3157,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, return scm_i_inexact_centered_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_quotient (x, y); + return scm_i_exact_rational_centered_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, s_scm_centered_quotient); @@ -3253,8 +3177,11 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient, "centered-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_centered_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_centered_quotient (x, y); else - return scm_i_slow_exact_centered_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG1, @@ -3318,31 +3245,17 @@ scm_i_bigint_centered_quotient (SCM x, SCM y) return scm_i_normbig (q); } -/* Compute exact centered quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_centered_quotient (SCM x, SCM y) +scm_i_exact_rational_centered_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG1, - s_scm_centered_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); - else if (scm_is_true (scm_positive_p (y))) - return scm_floor (scm_sum (scm_divide (x, y), - exactly_one_half)); - else if (scm_is_true (scm_negative_p (y))) - return scm_ceiling (scm_difference (scm_divide (x, y), - exactly_one_half)); - else - scm_num_overflow (s_scm_centered_quotient); + return scm_centered_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_centered_remainder (double x, double y); static SCM scm_i_bigint_centered_remainder (SCM x, SCM y); -static SCM scm_i_slow_exact_centered_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_centered_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, (SCM x, SCM y), @@ -3409,7 +3322,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_centered_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_remainder (x, y); + return scm_i_exact_rational_centered_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, s_scm_centered_remainder); @@ -3450,7 +3363,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, return scm_i_inexact_centered_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_remainder (x, y); + return scm_i_exact_rational_centered_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, s_scm_centered_remainder); @@ -3470,8 +3383,11 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder, "centered-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_centered_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_centered_remainder (x, y); else - return scm_i_slow_exact_centered_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG1, @@ -3544,33 +3460,20 @@ scm_i_bigint_centered_remainder (SCM x, SCM y) return scm_i_normbig (r); } -/* Compute exact centered_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_centered_remainder (SCM x, SCM y) +scm_i_exact_rational_centered_remainder (SCM x, SCM y) { - SCM q; - - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG1, - s_scm_centered_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); - else if (scm_is_true (scm_positive_p (y))) - q = scm_floor (scm_sum (scm_divide (x, y), exactly_one_half)); - else if (scm_is_true (scm_negative_p (y))) - q = scm_ceiling (scm_difference (scm_divide (x, y), exactly_one_half)); - else - scm_num_overflow (s_scm_centered_remainder); - return scm_difference (x, scm_product (y, q)); + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_centered_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_centered_divide (double x, double y); static SCM scm_i_bigint_centered_divide (SCM x, SCM y); -static SCM scm_i_slow_exact_centered_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_centered_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, (SCM x, SCM y), @@ -3643,7 +3546,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_centered_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_divide (x, y); + return scm_i_exact_rational_centered_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, s_scm_centered_divide); @@ -3697,7 +3600,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, return scm_i_inexact_centered_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_centered_divide (x, y); + return scm_i_exact_rational_centered_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, s_scm_centered_divide); @@ -3708,7 +3611,7 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_inexact_centered_divide (SCM_REAL_VALUE (x), scm_to_double (y)); - else + else SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, s_scm_centered_divide); } @@ -3717,8 +3620,11 @@ SCM_PRIMITIVE_GENERIC (scm_centered_divide, "centered/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_centered_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_centered_divide (x, y); else - return scm_i_slow_exact_centered_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, + s_scm_centered_divide); } else SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1, @@ -3796,35 +3702,24 @@ scm_i_bigint_centered_divide (SCM x, SCM y) scm_i_normbig (r))); } -/* Compute exact centered quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_centered_divide (SCM x, SCM y) +scm_i_exact_rational_centered_divide (SCM x, SCM y) { - SCM q, r; + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG1, - s_scm_centered_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_centered_divide, x, y, SCM_ARG2, - s_scm_centered_divide); - else if (scm_is_true (scm_positive_p (y))) - q = scm_floor (scm_sum (scm_divide (x, y), - exactly_one_half)); - else if (scm_is_true (scm_negative_p (y))) - q = scm_ceiling (scm_difference (scm_divide (x, y), - exactly_one_half)); - else - scm_num_overflow (s_scm_centered_divide); - r = scm_difference (x, scm_product (q, y)); + scm_i_extract_values_2 + (scm_centered_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); return scm_values (scm_list_2 (q, r)); } static SCM scm_i_inexact_round_quotient (double x, double y); static SCM scm_i_bigint_round_quotient (SCM x, SCM y); -static SCM scm_i_slow_exact_round_quotient (SCM x, SCM y); +static SCM scm_i_exact_rational_round_quotient (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, (SCM x, SCM y), @@ -3893,7 +3788,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_round_quotient (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_quotient (x, y); + return scm_i_exact_rational_round_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, s_scm_round_quotient); @@ -3944,7 +3839,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, return scm_i_inexact_round_quotient (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_quotient (x, y); + return scm_i_exact_rational_round_quotient (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, s_scm_round_quotient); @@ -3964,8 +3859,11 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient, "round-quotient", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_round_quotient (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_round_quotient (x, y); else - return scm_i_slow_exact_round_quotient (x, y); + SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG1, @@ -4014,27 +3912,17 @@ scm_i_bigint_round_quotient (SCM x, SCM y) return scm_i_normbig (q); } -/* Compute exact round quotient the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_round_quotient (SCM x, SCM y) +scm_i_exact_rational_round_quotient (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG1, - s_scm_round_quotient); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_round_quotient); - else - return scm_round_number (scm_divide (x, y)); + return scm_round_quotient + (scm_product (scm_numerator (x), scm_denominator (y)), + scm_product (scm_numerator (y), scm_denominator (x))); } static SCM scm_i_inexact_round_remainder (double x, double y); static SCM scm_i_bigint_round_remainder (SCM x, SCM y); -static SCM scm_i_slow_exact_round_remainder (SCM x, SCM y); +static SCM scm_i_exact_rational_round_remainder (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, (SCM x, SCM y), @@ -4104,7 +3992,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_round_remainder (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_remainder (x, y); + return scm_i_exact_rational_round_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, s_scm_round_remainder); @@ -4152,7 +4040,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, return scm_i_inexact_round_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_remainder (x, y); + return scm_i_exact_rational_round_remainder (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, s_scm_round_remainder); @@ -4172,8 +4060,11 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder, "round-remainder", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_round_remainder (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_round_remainder (x, y); else - return scm_i_slow_exact_round_remainder (x, y); + SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG1, @@ -4234,31 +4125,20 @@ scm_i_bigint_round_remainder (SCM x, SCM y) return scm_i_normbig (r); } -/* Compute exact round_remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_round_remainder (SCM x, SCM y) +scm_i_exact_rational_round_remainder (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG1, - s_scm_round_remainder); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_round_remainder); - else - { - SCM q = scm_round_number (scm_divide (x, y)); - return scm_difference (x, scm_product (q, y)); - } + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + SCM r1 = scm_round_remainder (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)); + return scm_divide (r1, scm_product (xd, yd)); } static SCM scm_i_inexact_round_divide (double x, double y); static SCM scm_i_bigint_round_divide (SCM x, SCM y); -static SCM scm_i_slow_exact_round_divide (SCM x, SCM y); +static SCM scm_i_exact_rational_round_divide (SCM x, SCM y); SCM_PRIMITIVE_GENERIC (scm_round_divide, "round/", 2, 0, 0, (SCM x, SCM y), @@ -4332,7 +4212,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_divide, "round/", 2, 0, 0, else if (SCM_REALP (y)) return scm_i_inexact_round_divide (xx, SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_divide (x, y); + return scm_i_exact_rational_round_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG2, s_scm_round_divide); @@ -4385,7 +4265,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_divide, "round/", 2, 0, 0, return scm_i_inexact_round_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) - return scm_i_slow_exact_round_divide (x, y); + return scm_i_exact_rational_round_divide (x, y); else SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG2, s_scm_round_divide); @@ -4396,7 +4276,7 @@ SCM_PRIMITIVE_GENERIC (scm_round_divide, "round/", 2, 0, 0, SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_inexact_round_divide (SCM_REAL_VALUE (x), scm_to_double (y)); - else + else SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG2, s_scm_round_divide); } @@ -4405,8 +4285,11 @@ SCM_PRIMITIVE_GENERIC (scm_round_divide, "round/", 2, 0, 0, if (SCM_REALP (y)) return scm_i_inexact_round_divide (scm_i_fraction2double (x), SCM_REAL_VALUE (y)); + else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) + return scm_i_exact_rational_round_divide (x, y); else - return scm_i_slow_exact_round_divide (x, y); + SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG2, + s_scm_round_divide); } else SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG1, @@ -4464,26 +4347,19 @@ scm_i_bigint_round_divide (SCM x, SCM y) scm_i_normbig (r))); } -/* Compute exact round quotient and remainder the slow way. - We use this only if both arguments are exact, - and at least one of them is a fraction */ static SCM -scm_i_slow_exact_round_divide (SCM x, SCM y) +scm_i_exact_rational_round_divide (SCM x, SCM y) { - if (!(SCM_I_INUMP (x) || SCM_BIGP (x) || SCM_FRACTIONP (x))) - SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG1, - s_scm_round_divide); - else if (!(SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))) - SCM_WTA_DISPATCH_2 (g_scm_round_divide, x, y, SCM_ARG2, - s_scm_round_divide); - else if (scm_is_true (scm_zero_p (y))) - scm_num_overflow (s_scm_round_divide); - else - { - SCM q = scm_round_number (scm_divide (x, y)); - SCM r = scm_difference (x, scm_product (q, y)); - return scm_values (scm_list_2 (q, r)); - } + SCM q, r, r1; + SCM xd = scm_denominator (x); + SCM yd = scm_denominator (y); + + scm_i_extract_values_2 + (scm_round_divide (scm_product (scm_numerator (x), yd), + scm_product (scm_numerator (y), xd)), + &q, &r1); + r = scm_divide (r1, scm_product (xd, yd)); + return scm_values (scm_list_2 (q, r)); } -- 1.5.6.5