mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

(scm_num_eq_p): For real==frac, complex==frac, frac==real

Browse source 
and frac==complex, make an exact comparison rather than converting
with fraction2double.
This commit is contained in:
Kevin Ryde 2004-02-18 00:21:11 +00:00
parent eb7e1603ad
commit d8b95e27ab
1 changed files with 43 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/numbers.c
View file

@ -2945,6 +2945,7 @@ SCM_GPROC1 (s_eq_p, "=", scm_tc7_rpsubr, scm_num_eq_p, g_eq_p);
SCM SCM
scm_num_eq_p (SCM x, SCM y) scm_num_eq_p (SCM x, SCM y)
{ {
again:
if (SCM_INUMP (x)) if (SCM_INUMP (x))
{ {
long xx = SCM_INUM (x); long xx = SCM_INUM (x);
@ -3019,7 +3020,15 @@ scm_num_eq_p (SCM x, SCM y)
return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y))
&& (0.0 == SCM_COMPLEX_IMAG (y))); && (0.0 == SCM_COMPLEX_IMAG (y)));
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
return SCM_BOOL (SCM_REAL_VALUE (x) == scm_i_fraction2double (y)); {
double xx = SCM_REAL_VALUE (x);
if (xisnan (xx))
return SCM_BOOL_F;
if (xisinf (xx))
return SCM_BOOL (xx < 0.0);
x = scm_inexact_to_exact (x); /* with x as frac or int */
goto again;
}
else else
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
} }
@ -3046,8 +3055,18 @@ scm_num_eq_p (SCM x, SCM y)
return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y))
&& (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)));
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
return SCM_BOOL ((SCM_COMPLEX_REAL (x) == scm_i_fraction2double (y)) {
&& (SCM_COMPLEX_IMAG (x) == 0.0)); double xx;
if (SCM_COMPLEX_IMAG (x) != 0.0)
return SCM_BOOL_F;
xx = SCM_COMPLEX_REAL (x);
if (xisnan (xx))
return SCM_BOOL_F;
if (xisinf (xx))
return SCM_BOOL (xx < 0.0);
x = scm_inexact_to_exact (x); /* with x as frac or int */
goto again;
}
else else
SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p); SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
} }
@ -3058,10 +3077,28 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_BIGP (y)) else if (SCM_BIGP (y))
return SCM_BOOL_F; return SCM_BOOL_F;
else if (SCM_REALP (y)) else if (SCM_REALP (y))
return SCM_BOOL (scm_i_fraction2double (x) == SCM_REAL_VALUE (y)); {
double yy = SCM_REAL_VALUE (y);
if (xisnan (yy))
return SCM_BOOL_F;
if (xisinf (yy))
return SCM_BOOL (0.0 < yy);
y = scm_inexact_to_exact (y); /* with y as frac or int */
goto again;
}
else if (SCM_COMPLEXP (y)) else if (SCM_COMPLEXP (y))
return SCM_BOOL ((scm_i_fraction2double (x) == SCM_COMPLEX_REAL (y)) {
&& (0.0 == SCM_COMPLEX_IMAG (y))); double yy;
if (SCM_COMPLEX_IMAG (y) != 0.0)
return SCM_BOOL_F;
yy = SCM_COMPLEX_REAL (y);
if (xisnan (yy))
return SCM_BOOL_F;
if (xisinf (yy))
return SCM_BOOL (0.0 < yy);
y = scm_inexact_to_exact (y); /* with y as frac or int */
goto again;
}
else if (SCM_FRACTIONP (y)) else if (SCM_FRACTIONP (y))
return scm_i_fraction_equalp (x, y); return scm_i_fraction_equalp (x, y);
else else