diff options
-rw-r--r-- | libguile/numbers.c | 87 | ||||
-rw-r--r-- | test-suite/tests/numbers.test | 412 |
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 ;;; |