66 |
} |
} |
67 |
#undef FUNC_NAME |
#undef FUNC_NAME |
68 |
|
|
69 |
|
/* We compare doubles in a special way for 'eqv?' to be able to |
70 |
|
distinguish plus and minus zero and to identify NaNs. |
71 |
|
*/ |
72 |
|
|
73 |
|
static int |
74 |
|
real_eqv (double x, double y) |
75 |
|
{ |
76 |
|
return !memcmp (&x, &y, sizeof(double)); |
77 |
|
} |
78 |
|
|
79 |
SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, |
SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr, |
80 |
(SCM x, SCM y), |
(SCM x, SCM y), |
99 |
{ |
{ |
100 |
if (SCM_SLOPPY_REALP (x)) |
if (SCM_SLOPPY_REALP (x)) |
101 |
return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y) |
return SCM_BOOL (SCM_SLOPPY_COMPLEXP (y) |
102 |
&& SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y) |
&& real_eqv (SCM_REAL_VALUE (x), |
103 |
|
SCM_COMPLEX_REAL (y)) |
104 |
&& 0.0 == SCM_COMPLEX_IMAG (y)); |
&& 0.0 == SCM_COMPLEX_IMAG (y)); |
105 |
else |
else |
106 |
return SCM_BOOL (SCM_SLOPPY_REALP (y) |
return SCM_BOOL (SCM_SLOPPY_REALP (y) |
107 |
&& SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y) |
&& real_eqv (SCM_COMPLEX_REAL (x), |
108 |
|
SCM_REAL_VALUE (y)) |
109 |
&& SCM_COMPLEX_IMAG (x) == 0.0); |
&& SCM_COMPLEX_IMAG (x) == 0.0); |
110 |
} |
} |
111 |
return SCM_BOOL_F; |
return SCM_BOOL_F; |
115 |
if (SCM_BIGP (x)) { |
if (SCM_BIGP (x)) { |
116 |
return SCM_BOOL (0 == scm_bigcomp (x, y)); |
return SCM_BOOL (0 == scm_bigcomp (x, y)); |
117 |
} else if (SCM_SLOPPY_REALP (x)) { |
} else if (SCM_SLOPPY_REALP (x)) { |
118 |
return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); |
return SCM_BOOL (real_eqv (SCM_REAL_VALUE (x), SCM_REAL_VALUE (y))); |
119 |
} else { /* complex */ |
} else { /* complex */ |
120 |
return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) |
return SCM_BOOL (real_eqv (SCM_COMPLEX_REAL (x), |
121 |
&& SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)); |
SCM_COMPLEX_REAL (y)) |
122 |
|
&& real_eqv (SCM_COMPLEX_IMAG (x), |
123 |
|
SCM_COMPLEX_IMAG (y))); |
124 |
} |
} |
125 |
} |
} |
126 |
return SCM_BOOL_F; |
return SCM_BOOL_F; |