summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-02-13 07:14:57 -0500
committerAndy Wingo <wingo@pobox.com>2011-02-14 20:31:14 +0100
commit8b56bcec442b203fcde509b40bd5866e62aaa111 (patch)
tree9aea4b1f6ba7adc9cce70beefa39493cd38abda9 /libguile/numbers.c
parent8f9da3406b507058475db2e8dde6fbb50d12faf7 (diff)
downloadguile-8b56bcec442b203fcde509b40bd5866e62aaa111.tar.gz
Optimize truncate, round, floor, and ceiling
* libguile/numbers.c (scm_c_truncate): Use ceil (x) instead of -floor (-x). (scm_truncate_number): Implement directly instead of by checking the sign and using scm_floor or scm_ceiling. Use scm_truncate_quotient for fractions. Make extensible, so that new number types implemented in GOOPS will be able to do the job more efficiently, since it is often easier to implement truncate than floor or ceiling. (scm_round_number): Optimize fractions case by using scm_round_quotient. Make extensible, so that new number types implemented in GOOPS will be able to do the job efficiently. (scm_floor, scm_ceiling): Optimize fractions case by using scm_floor_quotient and scm_ceiling_quotient, respectively. * test-suite/tests/numbers.test: Add test cases.
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c87
1 files changed, 29 insertions, 58 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 9107c8191..40a3ee35b 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -8851,8 +8851,9 @@ scm_c_truncate (double x)
return trunc (x);
#else
if (x < 0.0)
- return -floor (-x);
- return floor (x);
+ return ceil (x);
+ else
+ return floor (x);
#endif
}
@@ -8898,43 +8899,41 @@ scm_c_round (double x)
: result);
}
-SCM_DEFINE (scm_truncate_number, "truncate", 1, 0, 0,
- (SCM x),
- "Round the number @var{x} towards zero.")
+SCM_PRIMITIVE_GENERIC (scm_truncate_number, "truncate", 1, 0, 0,
+ (SCM x),
+ "Round the number @var{x} towards zero.")
#define FUNC_NAME s_scm_truncate_number
{
- if (scm_is_false (scm_negative_p (x)))
- return scm_floor (x);
+ if (SCM_I_INUMP (x) || SCM_BIGP (x))
+ return x;
+ else if (SCM_REALP (x))
+ return scm_from_double (scm_c_truncate (SCM_REAL_VALUE (x)));
+ else if (SCM_FRACTIONP (x))
+ return scm_truncate_quotient (SCM_FRACTION_NUMERATOR (x),
+ SCM_FRACTION_DENOMINATOR (x));
else
- return scm_ceiling (x);
+ SCM_WTA_DISPATCH_1 (g_scm_truncate_number, x, SCM_ARG1,
+ s_scm_truncate_number);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_round_number, "round", 1, 0, 0,
- (SCM x),
- "Round the number @var{x} towards the nearest integer. "
- "When it is exactly halfway between two integers, "
- "round towards the even one.")
+SCM_PRIMITIVE_GENERIC (scm_round_number, "round", 1, 0, 0,
+ (SCM x),
+ "Round the number @var{x} towards the nearest integer. "
+ "When it is exactly halfway between two integers, "
+ "round towards the even one.")
#define FUNC_NAME s_scm_round_number
{
if (SCM_I_INUMP (x) || SCM_BIGP (x))
return x;
else if (SCM_REALP (x))
return scm_from_double (scm_c_round (SCM_REAL_VALUE (x)));
+ else if (SCM_FRACTIONP (x))
+ return scm_round_quotient (SCM_FRACTION_NUMERATOR (x),
+ SCM_FRACTION_DENOMINATOR (x));
else
- {
- /* OPTIMIZE-ME: Fraction case could be done more efficiently by a
- single quotient+remainder division then examining to see which way
- the rounding should go. */
- SCM plus_half = scm_sum (x, exactly_one_half);
- SCM result = scm_floor (plus_half);
- /* Adjust so that the rounding is towards even. */
- if (scm_is_true (scm_num_eq_p (plus_half, result))
- && scm_is_true (scm_odd_p (result)))
- return scm_difference (result, SCM_INUM1);
- else
- return result;
- }
+ SCM_WTA_DISPATCH_1 (g_scm_round_number, x, SCM_ARG1,
+ s_scm_round_number);
}
#undef FUNC_NAME
@@ -8948,22 +8947,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0,
else if (SCM_REALP (x))
return scm_from_double (floor (SCM_REAL_VALUE (x)));
else if (SCM_FRACTIONP (x))
- {
- SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x),
- SCM_FRACTION_DENOMINATOR (x));
- if (scm_is_false (scm_negative_p (x)))
- {
- /* For positive x, rounding towards zero is correct. */
- return q;
- }
- else
- {
- /* For negative x, we need to return q-1 unless x is an
- integer. But fractions are never integer, per our
- assumptions. */
- return scm_difference (q, SCM_INUM1);
- }
- }
+ return scm_floor_quotient (SCM_FRACTION_NUMERATOR (x),
+ SCM_FRACTION_DENOMINATOR (x));
else
SCM_WTA_DISPATCH_1 (g_scm_floor, x, 1, s_scm_floor);
}
@@ -8979,22 +8964,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
else if (SCM_REALP (x))
return scm_from_double (ceil (SCM_REAL_VALUE (x)));
else if (SCM_FRACTIONP (x))
- {
- SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x),
- SCM_FRACTION_DENOMINATOR (x));
- if (scm_is_false (scm_positive_p (x)))
- {
- /* For negative x, rounding towards zero is correct. */
- return q;
- }
- else
- {
- /* For positive x, we need to return q+1 unless x is an
- integer. But fractions are never integer, per our
- assumptions. */
- return scm_sum (q, SCM_INUM1);
- }
- }
+ return scm_ceiling_quotient (SCM_FRACTION_NUMERATOR (x),
+ SCM_FRACTION_DENOMINATOR (x));
else
SCM_WTA_DISPATCH_1 (g_scm_ceiling, x, 1, s_scm_ceiling);
}