int Scm_Compare(ScmObj x, ScmObj y)
{
/* Shortcut for typical case */
if (SCM_NUMBERP(x) && SCM_NUMBERP(y))
return Scm_NumCmp(x, y);
if (SCM_STRINGP(x) && SCM_STRINGP(y))
return Scm_StringCmp(SCM_STRING(x), SCM_STRING(y));
if (SCM_CHARP(x) && SCM_CHARP(y))
return SCM_CHAR_VALUE(x) == SCM_CHAR_VALUE(y)? 0 :
SCM_CHAR_VALUE(x) < SCM_CHAR_VALUE(y)? -1 : 1;
ScmClass *cx = Scm_ClassOf(x);
ScmClass *cy = Scm_ClassOf(y);
if (Scm_SubtypeP(cx, cy)) {
if (cy->compare) return cy->compare(x, y, FALSE);
} else {
if (cx->compare) return cx->compare(x, y, FALSE);
}
Scm_Error("can't compare %S and %S", x, y);
return 0; /* dummy */
}
int Scm_Compare(ScmObj x, ScmObj y)
{
/* Shortcut for typical case */
if (SCM_NUMBERP(x) && SCM_NUMBERP(y)) {
if (SCM_COMPNUMP(x) || SCM_COMPNUMP(y)) {
/* Scm_NumCmp can't compare complex numbers---it doesn't make
mathematical sense. But Scm_Compare is used just to order
items, it doesn't need to carry meaning. So here it goes.
We follow srfi-114 spec. */
/* TODO: If we ever introduce exact compnums, we should use
exact number first to compare, for Scm_GetDouble may lose
precision. */
/* TODO: Handle NaN. */
double xr = Scm_RealPart(x);
double yr = Scm_RealPart(y);
if (xr < yr) return -1;
if (xr > yr) return 1;
double xi = Scm_ImagPart(x);
double yi = Scm_ImagPart(y);
if (xi < yi) return -1;
if (xi > yi) return 1;
return 0;
} else {
return Scm_NumCmp(x, y);
}
}
if (SCM_STRINGP(x) && SCM_STRINGP(y))
return Scm_StringCmp(SCM_STRING(x), SCM_STRING(y));
if (SCM_CHARP(x) && SCM_CHARP(y))
return SCM_CHAR_VALUE(x) == SCM_CHAR_VALUE(y)? 0 :
SCM_CHAR_VALUE(x) < SCM_CHAR_VALUE(y)? -1 : 1;
/* Set cx, cy here, for we may jump to distinct_types later. */
ScmClass *cx = Scm_ClassOf(x);
ScmClass *cy = Scm_ClassOf(y);
/* srfi-114 default comparator behaviors*/
/* () is the smallest of all */
if (SCM_NULLP(x)) return (SCM_NULLP(y)? 0 : -1);
if (SCM_NULLP(y)) return (SCM_NULLP(x)? 0 : 1);
if (SCM_PAIRP(x)) {
if (SCM_PAIRP(y)) {
ScmObj px = x;
ScmObj py = y;
while (SCM_PAIRP(px) && SCM_PAIRP(py)) {
int r = Scm_Compare(SCM_CAR(px), SCM_CAR(py));
if (r != 0) return r;
px = SCM_CDR(px);
py = SCM_CDR(py);
}
return Scm_Compare(px, py);
}
goto distinct_types;
}
if (SCM_FALSEP(x)) {
if (SCM_FALSEP(y)) return 0;
if (SCM_TRUEP(y)) return -1;
goto distinct_types;
}
if (SCM_TRUEP(x)) {
if (SCM_FALSEP(y)) return 1;
if (SCM_TRUEP(y)) return 0;
goto distinct_types;
}
if (Scm_SubtypeP(cx, cy)) {
if (cy->compare) return cy->compare(x, y, FALSE);
} else if (Scm_SubtypeP(cy, cx)) {
if (cx->compare) return cx->compare(x, y, FALSE);
}
if (cx == cy) {
/* x and y are of the same type, and they can't be ordered. */
Scm_Error("can't compare %S and %S", x, y);
}
distinct_types:
/* x and y are of distinct types. Follow the srfi-114 rule:
() < pairs < booleans < chars < strings < symbols < numbers
< vectors < bytevectors < others
Note that we already eliminated NULL.
*/
#define ELIMINATE(pred) \
do { \
if pred(x) return -1; \
if pred(y) return 1; \
} while (0)
ELIMINATE(SCM_PAIRP);
ELIMINATE(SCM_BOOLP);
ELIMINATE(SCM_CHARP);
ELIMINATE(SCM_STRINGP);
ELIMINATE(SCM_SYMBOLP);
ELIMINATE(SCM_NUMBERP);
ELIMINATE(SCM_VECTORP);
/* To conform srfi-114, we must order u8vector first. For the
consistency, we use this order:
u8 < s8 < u16 < s16 < u32 < s32 < u64 < s64 < f16 < f32 < f64
Unfortunately this doesn't match the order of ScmUVectorType,
so we need some tweak.
*/
if (SCM_UVECTORP(x)) {
if (SCM_UVECTORP(y)) {
int tx = Scm_UVectorType(Scm_ClassOf(x));
int ty = Scm_UVectorType(Scm_ClassOf(y));
if (tx/2 < ty/2) return -1;
if (tx/2 > ty/2) return 1;
if (tx < SCM_UVECTOR_F16) {
/* x and y are either sNvector and uNvector with the same N.
The odd one is uNvector.
*/
return (tx%2)? -1:1;
} else {
return (tx<ty)? -1:1;
}
}
return -1; /* y is other, so x comes first. */
} else if (SCM_UVECTORP(y)) {
return 1; /* x is other, so y comes first. */
}
/* Now we have two objects of different types, both are not the
types defined the order in srfi-114.
To achieve better stability, we first compare the name of the
classes and the names of their defining modules; if they are still
the same, we fall back to compare addresses.
Note: Addresses and defining modules may be changed when
the class is redefined.
*/
ScmObj nx = cx->name;
ScmObj ny = cy->name;
int nr = Scm_Compare(nx, ny);
if (nr != 0) return nr;
ScmObj mx = cx->modules;
ScmObj my = cy->modules;
while (SCM_PAIRP(mx) && SCM_PAIRP(my)) {
SCM_ASSERT(SCM_MODULEP(SCM_CAR(mx)) && SCM_MODULEP(SCM_CAR(my)));
int r = Scm_Compare(SCM_MODULE(SCM_CAR(mx))->name,
SCM_MODULE(SCM_CAR(my))->name);
if (r != 0) return r;
mx = SCM_CDR(mx);
my = SCM_CDR(my);
}
if (SCM_PAIRP(mx)) return -1;
if (SCM_PAIRP(my)) return 1;
if (cx < cy) return -1;
else return 1;
}