Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 03:36:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

sexp_object_compare should sort different numeric types together.

Browse source 
Fixes issue #271.
This commit is contained in:
Alex Shinn 2015-06-20 22:40:04 +09:00
parent 4ab97dd9bd
commit 0ceb3726c1
2 changed files with 42 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
lib/srfi/95/qsort.c
View file

@ -66,15 +66,27 @@ static int sexp_isymbol_compare (sexp ctx, sexp a, sexp b) {
} }
#endif #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) { static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
int res; int res;
if (a == b) if (a == b)
return 0; return 0;
if (sexp_pointerp(a)) { if (sexp_pointerp(a)) {
if (sexp_pointerp(b)) { if (sexp_pointerp(b)) {
if (sexp_pointer_tag(a) != sexp_pointer_tag(b)) { if (sexp_pointer_tag(a) == sexp_pointer_tag(b)) {
res = sexp_pointer_tag(a) - sexp_pointer_tag(b);
} else {
switch (sexp_pointer_tag(a)) { switch (sexp_pointer_tag(a)) {
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
case SEXP_FLONUM: case SEXP_FLONUM:
@ -114,9 +126,18 @@ static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
res = 0; res = 0;
break; 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 #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), res = strcmp(sexp_lsymbol_data(a),
sexp_string_data(sexp_write_to_string(ctx, b))); sexp_string_data(sexp_write_to_string(ctx, b)));
#endif #endif
@ -124,6 +145,11 @@ static int sexp_object_compare (sexp ctx, sexp a, sexp b) {
res = 1; res = 1;
} }
} else if (sexp_pointerp(b)) { } 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_USE_HUFF_SYMS
if (sexp_isymbolp(a) && sexp_lsymbolp(b)) if (sexp_isymbolp(a) && sexp_lsymbolp(b))
res = strcmp(sexp_string_data(sexp_write_to_string(ctx, a)), res = strcmp(sexp_string_data(sexp_write_to_string(ctx, a)),

12
lib/srfi/95/test.sld
View file

@ -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) (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))) (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)))) (test-end))))