mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Mark H Weaver
Andy Wingo
parent
8f9da3406b
commit
8b56bcec44
2 changed files with 432 additions and 67 deletions
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3306,6 +3306,284 @@
|
|||
(pass-if "(/ 25+125i 4+3i)"
|
||||
(= (/ 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
|
||||
|
|
@ -3567,14 +3969,6 @@
|
|||
(let ((big (ash 1 4096)))
|
||||
(= 1.0 (exact->inexact (/ (1+ big) big))))))
|
||||
|
||||
;;;
|
||||
;;; floor
|
||||
;;;
|
||||
|
||||
;;;
|
||||
;;; ceiling
|
||||
;;;
|
||||
|
||||
;;;
|
||||
;;; expt
|
||||
;;;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue