int spn_value_compare(const SpnValue *lhs, const SpnValue *rhs)
{
if (isnum(lhs) && isnum(rhs)) {
return numeric_compare(lhs, rhs);
}
/* else assume comparable objects */
return spn_object_cmp(objvalue(lhs), objvalue(rhs));
}
// strange comparisons are resolved arbitrarily but consistently.
// ordering: number < cprim < function < vector < cvalue < symbol < cons
static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
{
value_t d;
compare_top:
if (a == b) return fixnum(0);
if (bound <= 0)
return NIL;
int taga = tag(a);
int tagb = cmptag(b);
int c;
switch (taga) {
case TAG_NUM :
case TAG_NUM1:
if (isfixnum(b)) {
return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
}
if (iscprim(b)) {
if (cp_class((cprim_t*)ptr(b)) == wchartype)
return fixnum(1);
return fixnum(numeric_compare(a, b, eq, 1, NULL));
}
return fixnum(-1);
case TAG_SYM:
if (eq) return fixnum(1);
if (tagb < TAG_SYM) return fixnum(1);
if (tagb > TAG_SYM) return fixnum(-1);
return fixnum(strcmp(symbol_name(a), symbol_name(b)));
case TAG_VECTOR:
if (isvector(b))
return bounded_vector_compare(a, b, bound, eq);
break;
case TAG_CPRIM:
if (cp_class((cprim_t*)ptr(a)) == wchartype) {
if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype)
return fixnum(-1);
}
else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) {
return fixnum(1);
}
c = numeric_compare(a, b, eq, 1, NULL);
if (c != 2)
return fixnum(c);
break;
case TAG_CVALUE:
if (iscvalue(b)) {
if (cv_isPOD((cvalue_t*)ptr(a)) && cv_isPOD((cvalue_t*)ptr(b)))
return cvalue_compare(a, b);
return fixnum(1);
}
break;
case TAG_FUNCTION:
if (tagb == TAG_FUNCTION) {
if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) {
function_t *fa = (function_t*)ptr(a);
function_t *fb = (function_t*)ptr(b);
d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
d = bounded_compare(fa->vals, fb->vals, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
d = bounded_compare(fa->env, fb->env, bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
return fixnum(0);
}
return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1);
}
break;
case TAG_CONS:
if (tagb < TAG_CONS) return fixnum(1);
d = bounded_compare(car_(a), car_(b), bound-1, eq);
if (d==NIL || numval(d) != 0) return d;
a = cdr_(a); b = cdr_(b);
bound--;
goto compare_top;
}
return (taga < tagb) ? fixnum(-1) : fixnum(1);
}
int
numeric_compare_dvc (numeric_t x, numeric_t y)
{
int rc = numeric_compare (x,y);
return (rc < 0 ? DVC_LESS : rc == 0 ? DVC_MATCH : DVC_GREATER);
}
