mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

(scm_min, scm_max): Correction to big/real and real/big,

Browse source 
return inexact as required by r5rs.
This commit is contained in:
Kevin Ryde 2004-03-24 21:53:31 +00:00
parent 62360b8975
commit 2a06f79117
1 changed files with 22 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

50
libguile/numbers.c
View file

@ -3382,6 +3382,12 @@ scm_negative_p (SCM x)
} }
/* scm_min and scm_max return an inexact when either argument is inexact, as
required by r5rs. On that basis, for exact/inexact combinations the
exact is converted to inexact to compare and possibly return. This is
unlike scm_less_p above which takes some trouble to preserve all bits in
its test, such trouble is not required for min and max. */
SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max); SCM_GPROC1 (s_max, "max", scm_tc7_asubr, scm_max, g_max);
/* "Return the maximum of all parameter values." /* "Return the maximum of all parameter values."
*/ */
@ -3442,13 +3448,12 @@ scm_max (SCM x, SCM y)
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {
double yy = SCM_REAL_VALUE (y); /* if y==NaN then xx>yy is false, so we return the NaN y */
int cmp; double xx, yy;
if (xisnan (yy)) big_real:
return y; xx = scm_i_big2dbl (x);
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy); yy = SCM_REAL_VALUE (y);
scm_remember_upto_here_1 (x); return (xx > yy ? scm_make_real (xx) : y);
return (cmp > 0) ? x : y;
} }
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
{ {
@ -3471,13 +3476,8 @@ scm_max (SCM x, SCM y)
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
double xx = SCM_REAL_VALUE (x); SCM t = x; x = y; y = t;
int cmp; goto big_real;
if (xisnan (xx))
return x;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx);
scm_remember_upto_here_1 (y);
return (cmp < 0) ? x : y;
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {
@ -3591,13 +3591,12 @@ scm_min (SCM x, SCM y)
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {
double yy = SCM_REAL_VALUE (y); /* if y==NaN then xx<yy is false, so we return the NaN y */
int cmp; double xx, yy;
if (xisnan (yy)) big_real:
return y; xx = scm_i_big2dbl (x);
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy); yy = SCM_REAL_VALUE (y);
scm_remember_upto_here_1 (x); return (xx < yy ? scm_make_real (xx) : y);
return (cmp > 0) ? y : x;
} }
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
{ {
@ -3620,13 +3619,8 @@ scm_min (SCM x, SCM y)
} }
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
{ {
double xx = SCM_REAL_VALUE (x); SCM t = x; x = y; y = t;
int cmp; goto big_real;
if (xisnan (xx))
return x;
cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx);
scm_remember_upto_here_1 (y);
return (cmp < 0) ? y : x;
} }
else if (SCM_REALP (y)) else if (SCM_REALP (y))
{ {