int Scm_EqualM(ScmObj x, ScmObj y, int mode)
{
switch (mode) {
case SCM_CMP_EQ:
return SCM_EQ(x, y);
case SCM_CMP_EQV:
return Scm_EqvP(x, y);
case SCM_CMP_EQUAL:
return Scm_EqualP(x, y);
}
return FALSE;
}
static int vector_compare(ScmObj x, ScmObj y, int equalp)
{
if (equalp) {
/* Vector equality is handled in Scm_Eq* and will never come
here, but just in case. */
return Scm_EqualP(x, y)? 0 : 1;
}
/* Follow srfi-114 */
ScmWord xlen = SCM_VECTOR_SIZE(x);
ScmWord ylen = SCM_VECTOR_SIZE(y);
if (xlen < ylen) return -1;
if (xlen > ylen) return 1;
for (int i=0; i<xlen; i++) {
int r = Scm_Compare(SCM_VECTOR_ELEMENT(x, i),
SCM_VECTOR_ELEMENT(y, i));
if (r != 0) return r;
}
return 0;
}
int Scm_EqualP(ScmObj x, ScmObj y)
{
ScmClass *cx, *cy;
if (SCM_EQ(x, y)) return TRUE;
if (SCM_PAIRP(x)) {
if (!SCM_PAIRP(y)) return FALSE;
do {
if (!Scm_EqualP(SCM_CAR(x), SCM_CAR(y))) return FALSE;
x = SCM_CDR(x);
y = SCM_CDR(y);
} while (SCM_PAIRP(x)&&SCM_PAIRP(y));
return Scm_EqualP(x, y);
}
if (SCM_STRINGP(x)) {
if (SCM_STRINGP(y)) {
return Scm_StringEqual(SCM_STRING(x), SCM_STRING(y));
}
return FALSE;
}
if (SCM_NUMBERP(x)) {
if (SCM_NUMBERP(y)) {
if ((SCM_EXACTP(x) && SCM_EXACTP(y))
|| (SCM_INEXACTP(x) && SCM_INEXACTP(y))) {
return Scm_NumEq(x, y);
}
}
return FALSE;
}
if (SCM_VECTORP(x)) {
if (SCM_VECTORP(y)) {
int sizx = SCM_VECTOR_SIZE(x);
int sizy = SCM_VECTOR_SIZE(y);
if (sizx == sizy) {
while (sizx--) {
if (!Scm_EqualP(SCM_VECTOR_ELEMENT(x, sizx),
SCM_VECTOR_ELEMENT(y, sizx)))
break;
}
if (sizx < 0) return TRUE;
}
}
return FALSE;
}
/* EXPERIMENTAL: when identifier is compared by equal?,
we use its symbolic name to compare. This allows
comparing macro output with equal?, and also less confusing
when R5RS macro and legacy macro are mixed.
For "proper" comparison of identifiers keeping their semantics,
we need such procedures as free-identifier=? and bound-identifier=?
anyway, so this change of equal? won't have a negative impact, I hope.
NB: this operation come here instead of the beginning of this
procedure, since comparing identifiers are relatively rare so
we don't want to check idnetifier-ness every time.
*/
if (SCM_IDENTIFIERP(x) || SCM_IDENTIFIERP(y)) {
if (SCM_IDENTIFIERP(x)) x = SCM_OBJ(SCM_IDENTIFIER(x)->name);
if (SCM_IDENTIFIERP(y)) y = SCM_OBJ(SCM_IDENTIFIER(y)->name);
return SCM_EQ(x, y);
}
/* End of EXPERIMENTAL code */
if (!SCM_HPTRP(x)) return (x == y);
cx = Scm_ClassOf(x);
cy = Scm_ClassOf(y);
if (cx == cy && cx->compare) {
return (cx->compare(x, y, TRUE) == 0);
}
return FALSE;
}
