Example #1
0
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 */
}
Example #2
0
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;
}