summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/numbers.c87
-rw-r--r--test-suite/tests/numbers.test412
2 files changed, 432 insertions, 67 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);
}
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index ef59a02ca..1f2ee035d 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -3307,6 +3307,284 @@
(= (/ 25+125i 4+3i) 19.0+17.0i))))
;;;
+;;; floor
+;;;
+
+(with-test-prefix "floor"
+ (pass-if (= 1 (floor 1.75)))
+ (pass-if (= 1 (floor 1.5)))
+ (pass-if (= 1 (floor 1.25)))
+ (pass-if (= 0 (floor 0.75)))
+ (pass-if (= 0 (floor 0.5)))
+ (pass-if (= 0 (floor 0.0)))
+ (pass-if (= -1 (floor -0.5)))
+ (pass-if (= -2 (floor -1.25)))
+ (pass-if (= -2 (floor -1.5)))
+
+ (with-test-prefix "inum"
+ (pass-if "0"
+ (and (= 0 (floor 0))
+ (exact? (floor 0))))
+
+ (pass-if "1"
+ (and (= 1 (floor 1))
+ (exact? (floor 1))))
+
+ (pass-if "-1"
+ (and (= -1 (floor -1))
+ (exact? (floor -1)))))
+
+ (with-test-prefix "bignum"
+ (let ((x (1+ most-positive-fixnum)))
+ (pass-if "(1+ most-positive-fixnum)"
+ (and (= x (floor x))
+ (exact? (floor x)))))
+
+ (let ((x (1- most-negative-fixnum)))
+ (pass-if "(1- most-negative-fixnum)"
+ (and (= x (floor x))
+ (exact? (floor x))))))
+
+ (with-test-prefix "frac"
+ (define (=exact x y)
+ (and (= x y)
+ (exact? y)))
+
+ (pass-if (=exact -3 (floor -7/3)))
+ (pass-if (=exact -2 (floor -5/3)))
+ (pass-if (=exact -2 (floor -4/3)))
+ (pass-if (=exact -1 (floor -2/3)))
+ (pass-if (=exact -1 (floor -1/3)))
+ (pass-if (=exact 0 (floor 1/3)))
+ (pass-if (=exact 0 (floor 2/3)))
+ (pass-if (=exact 1 (floor 4/3)))
+ (pass-if (=exact 1 (floor 5/3)))
+ (pass-if (=exact 2 (floor 7/3)))
+
+ (pass-if (=exact -3 (floor -17/6)))
+ (pass-if (=exact -3 (floor -16/6)))
+ (pass-if (=exact -3 (floor -15/6)))
+ (pass-if (=exact -3 (floor -14/6)))
+ (pass-if (=exact -3 (floor -13/6)))
+ (pass-if (=exact -2 (floor -11/6)))
+ (pass-if (=exact -2 (floor -10/6)))
+ (pass-if (=exact -2 (floor -9/6)))
+ (pass-if (=exact -2 (floor -8/6)))
+ (pass-if (=exact -2 (floor -7/6)))
+ (pass-if (=exact -1 (floor -5/6)))
+ (pass-if (=exact -1 (floor -4/6)))
+ (pass-if (=exact -1 (floor -3/6)))
+ (pass-if (=exact -1 (floor -2/6)))
+ (pass-if (=exact -1 (floor -1/6)))
+ (pass-if (=exact 0 (floor 1/6)))
+ (pass-if (=exact 0 (floor 2/6)))
+ (pass-if (=exact 0 (floor 3/6)))
+ (pass-if (=exact 0 (floor 4/6)))
+ (pass-if (=exact 0 (floor 5/6)))
+ (pass-if (=exact 1 (floor 7/6)))
+ (pass-if (=exact 1 (floor 8/6)))
+ (pass-if (=exact 1 (floor 9/6)))
+ (pass-if (=exact 1 (floor 10/6)))
+ (pass-if (=exact 1 (floor 11/6)))
+ (pass-if (=exact 2 (floor 13/6)))
+ (pass-if (=exact 2 (floor 14/6)))
+ (pass-if (=exact 2 (floor 15/6)))
+ (pass-if (=exact 2 (floor 16/6)))
+ (pass-if (=exact 2 (floor 17/6))))
+
+ (with-test-prefix "real"
+ (pass-if "0.0"
+ (and (= 0.0 (floor 0.0))
+ (inexact? (floor 0.0))))
+
+ (pass-if "1.0"
+ (and (= 1.0 (floor 1.0))
+ (inexact? (floor 1.0))))
+
+ (pass-if "-1.0"
+ (and (= -1.0 (floor -1.0))
+ (inexact? (floor -1.0))))
+
+ (pass-if "-3.1"
+ (and (= -4.0 (floor -3.1))
+ (inexact? (floor -3.1))))
+
+ (pass-if "3.1"
+ (and (= 3.0 (floor 3.1))
+ (inexact? (floor 3.1))))
+
+ (pass-if "3.9"
+ (and (= 3.0 (floor 3.9))
+ (inexact? (floor 3.9))))
+
+ (pass-if "-3.9"
+ (and (= -4.0 (floor -3.9))
+ (inexact? (floor -3.9))))
+
+ (pass-if "1.5"
+ (and (= 1.0 (floor 1.5))
+ (inexact? (floor 1.5))))
+
+ (pass-if "2.5"
+ (and (= 2.0 (floor 2.5))
+ (inexact? (floor 2.5))))
+
+ (pass-if "3.5"
+ (and (= 3.0 (floor 3.5))
+ (inexact? (floor 3.5))))
+
+ (pass-if "-1.5"
+ (and (= -2.0 (floor -1.5))
+ (inexact? (floor -1.5))))
+
+ (pass-if "-2.5"
+ (and (= -3.0 (floor -2.5))
+ (inexact? (floor -2.5))))
+
+ (pass-if "-3.5"
+ (and (= -4.0 (floor -3.5))
+ (inexact? (floor -3.5))))))
+
+;;;
+;;; ceiling
+;;;
+
+(with-test-prefix "ceiling"
+ (pass-if (= 2 (ceiling 1.75)))
+ (pass-if (= 2 (ceiling 1.5)))
+ (pass-if (= 2 (ceiling 1.25)))
+ (pass-if (= 1 (ceiling 0.75)))
+ (pass-if (= 1 (ceiling 0.5)))
+ (pass-if (= 0 (ceiling 0.0)))
+ (pass-if (= 0 (ceiling -0.5)))
+ (pass-if (= -1 (ceiling -1.25)))
+ (pass-if (= -1 (ceiling -1.5)))
+
+ (with-test-prefix "inum"
+ (pass-if "0"
+ (and (= 0 (ceiling 0))
+ (exact? (ceiling 0))))
+
+ (pass-if "1"
+ (and (= 1 (ceiling 1))
+ (exact? (ceiling 1))))
+
+ (pass-if "-1"
+ (and (= -1 (ceiling -1))
+ (exact? (ceiling -1)))))
+
+ (with-test-prefix "bignum"
+ (let ((x (1+ most-positive-fixnum)))
+ (pass-if "(1+ most-positive-fixnum)"
+ (and (= x (ceiling x))
+ (exact? (ceiling x)))))
+
+ (let ((x (1- most-negative-fixnum)))
+ (pass-if "(1- most-negative-fixnum)"
+ (and (= x (ceiling x))
+ (exact? (ceiling x))))))
+
+ (with-test-prefix "frac"
+ (define (=exact x y)
+ (and (= x y)
+ (exact? y)))
+
+ (pass-if (=exact -2 (ceiling -7/3)))
+ (pass-if (=exact -1 (ceiling -5/3)))
+ (pass-if (=exact -1 (ceiling -4/3)))
+ (pass-if (=exact 0 (ceiling -2/3)))
+ (pass-if (=exact 0 (ceiling -1/3)))
+ (pass-if (=exact 1 (ceiling 1/3)))
+ (pass-if (=exact 1 (ceiling 2/3)))
+ (pass-if (=exact 2 (ceiling 4/3)))
+ (pass-if (=exact 2 (ceiling 5/3)))
+ (pass-if (=exact 3 (ceiling 7/3)))
+
+ (pass-if (=exact -2 (ceiling -17/6)))
+ (pass-if (=exact -2 (ceiling -16/6)))
+ (pass-if (=exact -2 (ceiling -15/6)))
+ (pass-if (=exact -2 (ceiling -14/6)))
+ (pass-if (=exact -2 (ceiling -13/6)))
+ (pass-if (=exact -1 (ceiling -11/6)))
+ (pass-if (=exact -1 (ceiling -10/6)))
+ (pass-if (=exact -1 (ceiling -9/6)))
+ (pass-if (=exact -1 (ceiling -8/6)))
+ (pass-if (=exact -1 (ceiling -7/6)))
+ (pass-if (=exact 0 (ceiling -5/6)))
+ (pass-if (=exact 0 (ceiling -4/6)))
+ (pass-if (=exact 0 (ceiling -3/6)))
+ (pass-if (=exact 0 (ceiling -2/6)))
+ (pass-if (=exact 0 (ceiling -1/6)))
+ (pass-if (=exact 1 (ceiling 1/6)))
+ (pass-if (=exact 1 (ceiling 2/6)))
+ (pass-if (=exact 1 (ceiling 3/6)))
+ (pass-if (=exact 1 (ceiling 4/6)))
+ (pass-if (=exact 1 (ceiling 5/6)))
+ (pass-if (=exact 2 (ceiling 7/6)))
+ (pass-if (=exact 2 (ceiling 8/6)))
+ (pass-if (=exact 2 (ceiling 9/6)))
+ (pass-if (=exact 2 (ceiling 10/6)))
+ (pass-if (=exact 2 (ceiling 11/6)))
+ (pass-if (=exact 3 (ceiling 13/6)))
+ (pass-if (=exact 3 (ceiling 14/6)))
+ (pass-if (=exact 3 (ceiling 15/6)))
+ (pass-if (=exact 3 (ceiling 16/6)))
+ (pass-if (=exact 3 (ceiling 17/6))))
+
+ (with-test-prefix "real"
+ (pass-if "0.0"
+ (and (= 0.0 (ceiling 0.0))
+ (inexact? (ceiling 0.0))))
+
+ (pass-if "1.0"
+ (and (= 1.0 (ceiling 1.0))
+ (inexact? (ceiling 1.0))))
+
+ (pass-if "-1.0"
+ (and (= -1.0 (ceiling -1.0))
+ (inexact? (ceiling -1.0))))
+
+ (pass-if "-3.1"
+ (and (= -3.0 (ceiling -3.1))
+ (inexact? (ceiling -3.1))))
+
+ (pass-if "3.1"
+ (and (= 4.0 (ceiling 3.1))
+ (inexact? (ceiling 3.1))))
+
+ (pass-if "3.9"
+ (and (= 4.0 (ceiling 3.9))
+ (inexact? (ceiling 3.9))))
+
+ (pass-if "-3.9"
+ (and (= -3.0 (ceiling -3.9))
+ (inexact? (ceiling -3.9))))
+
+ (pass-if "1.5"
+ (and (= 2.0 (ceiling 1.5))
+ (inexact? (ceiling 1.5))))
+
+ (pass-if "2.5"
+ (and (= 3.0 (ceiling 2.5))
+ (inexact? (ceiling 2.5))))
+
+ (pass-if "3.5"
+ (and (= 4.0 (ceiling 3.5))
+ (inexact? (ceiling 3.5))))
+
+ (pass-if "-1.5"
+ (and (= -1.0 (ceiling -1.5))
+ (inexact? (ceiling -1.5))))
+
+ (pass-if "-2.5"
+ (and (= -2.0 (ceiling -2.5))
+ (inexact? (ceiling -2.5))))
+
+ (pass-if "-3.5"
+ (and (= -3.0 (ceiling -3.5))
+ (inexact? (ceiling -3.5))))))
+
+;;;
;;; truncate
;;;
@@ -3319,7 +3597,131 @@
(pass-if (= 0 (truncate 0.0)))
(pass-if (= 0 (truncate -0.5)))
(pass-if (= -1 (truncate -1.25)))
- (pass-if (= -1 (truncate -1.5))))
+ (pass-if (= -1 (truncate -1.5)))
+
+ (with-test-prefix "inum"
+ (pass-if "0"
+ (and (= 0 (truncate 0))
+ (exact? (truncate 0))))
+
+ (pass-if "1"
+ (and (= 1 (truncate 1))
+ (exact? (truncate 1))))
+
+ (pass-if "-1"
+ (and (= -1 (truncate -1))
+ (exact? (truncate -1)))))
+
+ (with-test-prefix "bignum"
+ (let ((x (1+ most-positive-fixnum)))
+ (pass-if "(1+ most-positive-fixnum)"
+ (and (= x (truncate x))
+ (exact? (truncate x)))))
+
+ (let ((x (1- most-negative-fixnum)))
+ (pass-if "(1- most-negative-fixnum)"
+ (and (= x (truncate x))
+ (exact? (truncate x))))))
+
+ (with-test-prefix "frac"
+ (define (=exact x y)
+ (and (= x y)
+ (exact? y)))
+
+ (pass-if (=exact -2 (truncate -7/3)))
+ (pass-if (=exact -1 (truncate -5/3)))
+ (pass-if (=exact -1 (truncate -4/3)))
+ (pass-if (=exact 0 (truncate -2/3)))
+ (pass-if (=exact 0 (truncate -1/3)))
+ (pass-if (=exact 0 (truncate 1/3)))
+ (pass-if (=exact 0 (truncate 2/3)))
+ (pass-if (=exact 1 (truncate 4/3)))
+ (pass-if (=exact 1 (truncate 5/3)))
+ (pass-if (=exact 2 (truncate 7/3)))
+
+ (pass-if (=exact -2 (truncate -17/6)))
+ (pass-if (=exact -2 (truncate -16/6)))
+ (pass-if (=exact -2 (truncate -15/6)))
+ (pass-if (=exact -2 (truncate -14/6)))
+ (pass-if (=exact -2 (truncate -13/6)))
+ (pass-if (=exact -1 (truncate -11/6)))
+ (pass-if (=exact -1 (truncate -10/6)))
+ (pass-if (=exact -1 (truncate -9/6)))
+ (pass-if (=exact -1 (truncate -8/6)))
+ (pass-if (=exact -1 (truncate -7/6)))
+ (pass-if (=exact 0 (truncate -5/6)))
+ (pass-if (=exact 0 (truncate -4/6)))
+ (pass-if (=exact 0 (truncate -3/6)))
+ (pass-if (=exact 0 (truncate -2/6)))
+ (pass-if (=exact 0 (truncate -1/6)))
+ (pass-if (=exact 0 (truncate 1/6)))
+ (pass-if (=exact 0 (truncate 2/6)))
+ (pass-if (=exact 0 (truncate 3/6)))
+ (pass-if (=exact 0 (truncate 4/6)))
+ (pass-if (=exact 0 (truncate 5/6)))
+ (pass-if (=exact 1 (truncate 7/6)))
+ (pass-if (=exact 1 (truncate 8/6)))
+ (pass-if (=exact 1 (truncate 9/6)))
+ (pass-if (=exact 1 (truncate 10/6)))
+ (pass-if (=exact 1 (truncate 11/6)))
+ (pass-if (=exact 2 (truncate 13/6)))
+ (pass-if (=exact 2 (truncate 14/6)))
+ (pass-if (=exact 2 (truncate 15/6)))
+ (pass-if (=exact 2 (truncate 16/6)))
+ (pass-if (=exact 2 (truncate 17/6))))
+
+ (with-test-prefix "real"
+ (pass-if "0.0"
+ (and (= 0.0 (truncate 0.0))
+ (inexact? (truncate 0.0))))
+
+ (pass-if "1.0"
+ (and (= 1.0 (truncate 1.0))
+ (inexact? (truncate 1.0))))
+
+ (pass-if "-1.0"
+ (and (= -1.0 (truncate -1.0))
+ (inexact? (truncate -1.0))))
+
+ (pass-if "-3.1"
+ (and (= -3.0 (truncate -3.1))
+ (inexact? (truncate -3.1))))
+
+ (pass-if "3.1"
+ (and (= 3.0 (truncate 3.1))
+ (inexact? (truncate 3.1))))
+
+ (pass-if "3.9"
+ (and (= 3.0 (truncate 3.9))
+ (inexact? (truncate 3.9))))
+
+ (pass-if "-3.9"
+ (and (= -3.0 (truncate -3.9))
+ (inexact? (truncate -3.9))))
+
+ (pass-if "1.5"
+ (and (= 1.0 (truncate 1.5))
+ (inexact? (truncate 1.5))))
+
+ (pass-if "2.5"
+ (and (= 2.0 (truncate 2.5))
+ (inexact? (truncate 2.5))))
+
+ (pass-if "3.5"
+ (and (= 3.0 (truncate 3.5))
+ (inexact? (truncate 3.5))))
+
+ (pass-if "-1.5"
+ (and (= -1.0 (truncate -1.5))
+ (inexact? (truncate -1.5))))
+
+ (pass-if "-2.5"
+ (and (= -2.0 (truncate -2.5))
+ (inexact? (truncate -2.5))))
+
+ (pass-if "-3.5"
+ (and (= -3.0 (truncate -3.5))
+ (inexact? (truncate -3.5))))))
;;;
;;; round
@@ -3568,14 +3970,6 @@
(= 1.0 (exact->inexact (/ (1+ big) big))))))
;;;
-;;; floor
-;;;
-
-;;;
-;;; ceiling
-;;;
-
-;;;
;;; expt
;;;