mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-03 11:16:36 +02:00
sexp_object_compare should sort different numeric types together.
Fixes issue #271.
This commit is contained in:
parent
4ab97dd9bd
commit
0ceb3726c1
2 changed files with 42 additions and 4 deletions
|
@ -66,15 +66,27 @@ static int sexp_isymbol_compare (sexp ctx, sexp a, sexp b) {
|
|||
}
|
||||
#endif
|
||||
|
||||
#if SEXP_USE_RATIOS
|
||||
#define sexp_non_immediate_ordered_numberp(x) \
|
||||
(sexp_flonump(x) || sexp_bignump(x) || sexp_ratiop(x))
|
||||
#elif SEXP_USE_BIGNUMS && SEXP_USE_FLONUMS
|
||||
#define sexp_non_immediate_ordered_numberp(x) \
|
||||
(sexp_flonump(x) || sexp_bignump(x))
|
||||
#elif SEXP_USE_BIGNUMS
|
||||
#define sexp_non_immediate_ordered_numberp(x) (sexp_bignump(x))
|
||||
#elif SEXP_USE_FLONUMS
|
||||
#define sexp_non_immediate_ordered_numberp(x) (sexp_flonump(x))
|
||||
#else
|
||||
#define sexp_non_immediate_ordered_numberp(x) 0
|
||||
#endif
|
||||
|
||||
static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
|
||||
int res;
|
||||
if (a == b)
|
||||
return 0;
|
||||
if (sexp_pointerp(a)) {
|
||||
if (sexp_pointerp(b)) {
|
||||
if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) {
|
||||
res = sexp_pointer_tag(a) - sexp_pointer_tag(b);
|
||||
} else {
|
||||
if (sexp_pointer_tag(a) == sexp_pointer_tag(b)) {
|
||||
switch (sexp_pointer_tag(a)) {
|
||||
#if SEXP_USE_FLONUMS
|
||||
case SEXP_FLONUM:
|
||||
|
@ -114,9 +126,18 @@ static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
|
|||
res = 0;
|
||||
break;
|
||||
}
|
||||
} else if (sexp_non_immediate_ordered_numberp(a) &&
|
||||
sexp_non_immediate_ordered_numberp(b)) {
|
||||
res = sexp_unbox_fixnum(sexp_compare(ctx, a, b));
|
||||
} else {
|
||||
res = sexp_pointer_tag(a) - sexp_pointer_tag(b);
|
||||
}
|
||||
#if SEXP_USE_BIGNUMS || SEXP_USE_FLONUMS
|
||||
} else if (sexp_fixnump(b) && sexp_non_immediate_ordered_numberp(a)) {
|
||||
res = sexp_unbox_fixnum(sexp_compare(ctx, a, b));
|
||||
#endif
|
||||
#if SEXP_USE_HUFF_SYMS
|
||||
} else if (sexp_lsymbolp(a) && sexp_isymbolp(b)) {
|
||||
} else if (sexp_isymbolp(b) && sexp_lsymbolp(a)) {
|
||||
res = strcmp(sexp_lsymbol_data(a),
|
||||
sexp_string_data(sexp_write_to_string(ctx, b)));
|
||||
#endif
|
||||
|
@ -124,6 +145,11 @@ static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
|
|||
res = 1;
|
||||
}
|
||||
} else if (sexp_pointerp(b)) {
|
||||
#if SEXP_USE_BIGNUMS || SEXP_USE_FLONUMS
|
||||
if (sexp_fixnump(a) && sexp_non_immediate_ordered_numberp(b))
|
||||
res = sexp_unbox_fixnum(sexp_compare(ctx, a, b));
|
||||
else
|
||||
#endif
|
||||
#if SEXP_USE_HUFF_SYMS
|
||||
if (sexp_isymbolp(a) && sexp_lsymbolp(b))
|
||||
res = strcmp(sexp_string_data(sexp_write_to_string(ctx, a)),
|
||||
|
|
|
@ -113,4 +113,16 @@
|
|||
(test "sort complex" '(1+1i 1+2i 1+3i 2+2i 3+3i 4+4i 5+5i 6+6i 7+7i 8+8i 9+9i)
|
||||
(sort '(7+7i 1+2i 5+5i 2+2i 8+8i 1+1i 6+6i 4+4i 9+9i 1+3i 3+3i)))
|
||||
|
||||
(test "sort mixed exactness" '(1 1.5 2 3)
|
||||
(sort '(1 2 3 1.5) <))
|
||||
|
||||
(test "sort integer and rational" '(1 2 5/2 3)
|
||||
(sort '(1 2 3 5/2) <))
|
||||
|
||||
(test "sort various mixed" '(3 3.14 355/113 22/7 4)
|
||||
(sort '(355/113 4 22/7 3 3.14)))
|
||||
|
||||
(test "sort complex" '(3 3.14 355/113 22/7 3.14+0.0i 3.14+3.14i)
|
||||
(sort '(3.14+3.14i 355/113 3 22/7 3.14+0.0i 3.14)))
|
||||
|
||||
(test-end))))
|
||||
|
|
Loading…
Add table
Reference in a new issue