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

(real_eqv): New.

Browse source 
(scm_eqv_p): Use it when comparing reals and complexes.
This commit is contained in:
Marius Vollmer 2002-05-08 20:11:27 +00:00
parent fc19457701
commit 96d00047de
1 changed files with 18 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/eq.c
View file

@ -66,6 +66,15 @@ SCM_DEFINE1 (scm_eq_p, "eq?", scm_tc7_rpsubr,
}
#undef FUNC_NAME
/* We compare doubles in a special way for 'eqv?' to be able to
distinguish plus and minus zero and to identify NaNs.
*/
static int
real_eqv (double x, double y)
{
return !memcmp (&x, &y, sizeof(double));
}
SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
(SCM x, SCM y),
@ -90,11 +99,13 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
{
if (SCM_SLOPPY_REALP (x))
return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y)
&& SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)
&& real_eqv (SCM_REAL_VALUE (x),
SCM_COMPLEX_REAL (y))
&& 0.0 == SCM_COMPLEX_IMAG (y));
else
return SCM_BOOL (SCM_SLOPPY_REALP (y)
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)
&& real_eqv (SCM_COMPLEX_REAL (x),
SCM_REAL_VALUE (y))
&& SCM_COMPLEX_IMAG (x) == 0.0);
}
return SCM_BOOL_F;
@ -104,10 +115,12 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
if (SCM_BIGP (x)) {
return SCM_BOOL (0 == scm_bigcomp (x, y));
} else if (SCM_SLOPPY_REALP (x)) {
return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y));
return SCM_BOOL (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y)));
} else { /* complex */
return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)
&& SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y));
return SCM_BOOL (real_eqv (SCM_COMPLEX_REAL (x),
SCM_COMPLEX_REAL (y))
&& real_eqv (SCM_COMPLEX_IMAG (x),
SCM_COMPLEX_IMAG (y)));
}
}
return SCM_BOOL_F;