mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Trigonometric functions return exact numbers in some cases
* libguile/numbers.c (scm_sin, scm_cos, scm_tan, scm_asin, scm_acos, scm_atan, scm_sinh, scm_cosh, scm_tanh, scm_sys_asinh, scm_sys_acosh, scm_sys_atanh): Return an exact result in some cases. * test-suite/tests/numbers.test: Add test cases. * NEWS: Add NEWS entry
This commit is contained in:
Mark H Weaver
Andy Wingo
parent
2e2743113a
commit
8deddc948d
3 changed files with 142 additions and 15 deletions
7
NEWS
7
NEWS
|
|
@ -193,6 +193,13 @@ was at least 1 or inexact, e.g. (rationalize 4 1) should return 3 per
|
|||
R5RS and R6RS, but previously it returned 4. It also now handles
|
||||
cases involving infinities and NaNs properly, per R6RS.
|
||||
|
||||
*** Trigonometric functions now return exact numbers in some cases
|
||||
|
||||
scm_sin `sin', scm_cos `cos', scm_tan `tan', scm_asin `asin', scm_acos
|
||||
`acos', scm_atan `atan', scm_sinh `sinh', scm_cosh `cosh', scm_tanh
|
||||
`tanh', scm_sys_asinh `asinh', scm_sys_acosh `acosh', and
|
||||
scm_sys_atanh `atanh' now return exact results in some cases.
|
||||
|
||||
*** New procedure: `finite?'
|
||||
|
||||
Add scm_finite_p `finite?' from R6RS to guile core, which returns #t
|
||||
|
|
|
|||
|
|
@ -6801,7 +6801,9 @@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0,
|
|||
"Compute the sine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_sin
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* sin(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (sin (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y;
|
||||
|
|
@ -6820,7 +6822,9 @@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", 1, 0, 0,
|
|||
"Compute the cosine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_cos
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return SCM_INUM1; /* cos(exact0) = exact1 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (cos (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y;
|
||||
|
|
@ -6839,7 +6843,9 @@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", 1, 0, 0,
|
|||
"Compute the tangent of @var{z}.")
|
||||
#define FUNC_NAME s_scm_tan
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* tan(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (tan (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y, w;
|
||||
|
|
@ -6862,7 +6868,9 @@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh", 1, 0, 0,
|
|||
"Compute the hyperbolic sine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_sinh
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* sinh(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (sinh (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y;
|
||||
|
|
@ -6881,7 +6889,9 @@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh", 1, 0, 0,
|
|||
"Compute the hyperbolic cosine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_cosh
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return SCM_INUM1; /* cosh(exact0) = exact1 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (cosh (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y;
|
||||
|
|
@ -6900,7 +6910,9 @@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh", 1, 0, 0,
|
|||
"Compute the hyperbolic tangent of @var{z}.")
|
||||
#define FUNC_NAME s_scm_tanh
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* tanh(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (tanh (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{ double x, y, w;
|
||||
|
|
@ -6923,7 +6935,9 @@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin", 1, 0, 0,
|
|||
"Compute the arc sine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_asin
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* asin(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
{
|
||||
double w = scm_to_double (z);
|
||||
if (w >= -1.0 && w <= 1.0)
|
||||
|
|
@ -6949,7 +6963,9 @@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos", 1, 0, 0,
|
|||
"Compute the arc cosine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_acos
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1)))
|
||||
return SCM_INUM0; /* acos(exact1) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
{
|
||||
double w = scm_to_double (z);
|
||||
if (w >= -1.0 && w <= 1.0)
|
||||
|
|
@ -6981,7 +6997,9 @@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan", 1, 1, 0,
|
|||
{
|
||||
if (SCM_UNBNDP (y))
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* atan(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (atan (scm_to_double (z)));
|
||||
else if (SCM_COMPLEXP (z))
|
||||
{
|
||||
|
|
@ -7012,7 +7030,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0,
|
|||
"Compute the inverse hyperbolic sine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_sys_asinh
|
||||
{
|
||||
if (scm_is_real (z))
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* asinh(exact0) = exact0 */
|
||||
else if (scm_is_real (z))
|
||||
return scm_from_double (asinh (scm_to_double (z)));
|
||||
else if (scm_is_number (z))
|
||||
return scm_log (scm_sum (z,
|
||||
|
|
@ -7028,7 +7048,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0,
|
|||
"Compute the inverse hyperbolic cosine of @var{z}.")
|
||||
#define FUNC_NAME s_scm_sys_acosh
|
||||
{
|
||||
if (scm_is_real (z) && scm_to_double (z) >= 1.0)
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM1)))
|
||||
return SCM_INUM0; /* acosh(exact1) = exact0 */
|
||||
else if (scm_is_real (z) && scm_to_double (z) >= 1.0)
|
||||
return scm_from_double (acosh (scm_to_double (z)));
|
||||
else if (scm_is_number (z))
|
||||
return scm_log (scm_sum (z,
|
||||
|
|
@ -7044,7 +7066,9 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
|
|||
"Compute the inverse hyperbolic tangent of @var{z}.")
|
||||
#define FUNC_NAME s_scm_sys_atanh
|
||||
{
|
||||
if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0)
|
||||
if (SCM_UNLIKELY (scm_is_eq (z, SCM_INUM0)))
|
||||
return z; /* atanh(exact0) = exact0 */
|
||||
else if (scm_is_real (z) && scm_to_double (z) >= -1.0 && scm_to_double (z) <= 1.0)
|
||||
return scm_from_double (atanh (scm_to_double (z)));
|
||||
else if (scm_is_number (z))
|
||||
return scm_divide (scm_log (scm_divide (scm_sum (SCM_INUM1, z),
|
||||
|
|
|
|||
|
|
@ -3421,26 +3421,122 @@
|
|||
(pass-if (eqv? 0.0 (expt 2.0 -inf.0))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; sin
|
||||
;;;
|
||||
|
||||
(with-test-prefix "sin"
|
||||
(pass-if (eqv? 0 (sin 0)))
|
||||
(pass-if (eqv? 0.0 (sin 0.0)))
|
||||
(pass-if (eqv-loosely? 1.0 (sin 1.57)))
|
||||
(pass-if (eqv-loosely? +1.175i (sin +i)))
|
||||
(pass-if (real-nan? (sin +nan.0)))
|
||||
(pass-if (real-nan? (sin +inf.0)))
|
||||
(pass-if (real-nan? (sin -inf.0))))
|
||||
|
||||
;;;
|
||||
;;; cos
|
||||
;;;
|
||||
|
||||
(with-test-prefix "cos"
|
||||
(pass-if (eqv? 1 (cos 0)))
|
||||
(pass-if (eqv? 1.0 (cos 0.0)))
|
||||
(pass-if (eqv-loosely? 0.0 (cos 1.57)))
|
||||
(pass-if (eqv-loosely? 1.543 (cos +i)))
|
||||
(pass-if (real-nan? (cos +nan.0)))
|
||||
(pass-if (real-nan? (cos +inf.0)))
|
||||
(pass-if (real-nan? (cos -inf.0))))
|
||||
|
||||
;;;
|
||||
;;; tan
|
||||
;;;
|
||||
|
||||
(with-test-prefix "tan"
|
||||
(pass-if (eqv? 0 (tan 0)))
|
||||
(pass-if (eqv? 0.0 (tan 0.0)))
|
||||
(pass-if (eqv-loosely? 1.0 (tan 0.785)))
|
||||
(pass-if (eqv-loosely? +0.76i (tan +i)))
|
||||
(pass-if (real-nan? (tan +nan.0)))
|
||||
(pass-if (real-nan? (tan +inf.0)))
|
||||
(pass-if (real-nan? (tan -inf.0))))
|
||||
|
||||
;;;
|
||||
;;; asin
|
||||
;;;
|
||||
|
||||
(with-test-prefix "asin"
|
||||
(pass-if (complex-nan? (asin +nan.0)))
|
||||
(pass-if (eqv? 0 (asin 0)))
|
||||
(pass-if (eqv? 0.0 (asin 0.0))))
|
||||
|
||||
;;;
|
||||
;;; acos
|
||||
;;;
|
||||
|
||||
(with-test-prefix "acos"
|
||||
(pass-if (complex-nan? (acos +nan.0)))
|
||||
(pass-if (eqv? 0 (acos 1)))
|
||||
(pass-if (eqv? 0.0 (acos 1.0))))
|
||||
|
||||
;;;
|
||||
;;; atan
|
||||
;;;
|
||||
;;; FIXME: add tests for two-argument atan
|
||||
;;;
|
||||
(with-test-prefix "atan"
|
||||
(pass-if (real-nan? (atan +nan.0)))
|
||||
(pass-if (eqv? 0 (atan 0)))
|
||||
(pass-if (eqv? 0.0 (atan 0.0)))
|
||||
(pass-if (eqv-loosely? 1.57 (atan +inf.0)))
|
||||
(pass-if (eqv-loosely? -1.57 (atan -inf.0))))
|
||||
|
||||
;;;
|
||||
;;; sinh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "sinh"
|
||||
(pass-if (= 0 (sinh 0)))
|
||||
(pass-if (= 0.0 (sinh 0.0))))
|
||||
|
||||
;;;
|
||||
;;; cosh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "cosh"
|
||||
(pass-if (= 1 (cosh 0)))
|
||||
(pass-if (= 1.0 (cosh 0.0))))
|
||||
|
||||
;;;
|
||||
;;; tanh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "tanh"
|
||||
(pass-if (= 0 (tanh 0)))
|
||||
(pass-if (= 0.0 (tanh 0.0))))
|
||||
|
||||
;;;
|
||||
;;; asinh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "asinh"
|
||||
(pass-if (= 0 (asinh 0))))
|
||||
(pass-if (= 0 (asinh 0)))
|
||||
(pass-if (= 0.0 (asinh 0.0))))
|
||||
|
||||
;;;
|
||||
;;; acosh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "acosh"
|
||||
(pass-if (= 0 (acosh 1))))
|
||||
(pass-if (= 0 (acosh 1)))
|
||||
(pass-if (= 0.0 (acosh 1.0))))
|
||||
|
||||
;;;
|
||||
;;; atanh
|
||||
;;;
|
||||
|
||||
(with-test-prefix "atanh"
|
||||
(pass-if (= 0 (atanh 0))))
|
||||
(pass-if (= 0 (atanh 0)))
|
||||
(pass-if (= 0.0 (atanh 0.0))))
|
||||
|
||||
;;;
|
||||
;;; make-rectangular
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue