diff --git a/include/chibi/bignum.h b/include/chibi/bignum.h index 34e6467c..1ae57703 100644 --- a/include/chibi/bignum.h +++ b/include/chibi/bignum.h @@ -50,6 +50,7 @@ SEXP_API sexp sexp_ratio_round (sexp ctx, sexp a); SEXP_API sexp sexp_ratio_trunc (sexp ctx, sexp a); SEXP_API sexp sexp_ratio_floor (sexp ctx, sexp a); SEXP_API sexp sexp_ratio_ceiling (sexp ctx, sexp a); +SEXP_API sexp sexp_ratio_compare (sexp ctx, sexp a, sexp b); #endif #if SEXP_USE_COMPLEX SEXP_API sexp sexp_make_complex (sexp ctx, sexp real, sexp image); diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c index 477ad614..5883e08f 100644 --- a/lib/srfi/95/qsort.c +++ b/lib/srfi/95/qsort.c @@ -70,13 +70,25 @@ static int sexp_object_compare (sexp ctx, sexp a, sexp b) { switch (sexp_pointer_tag(a)) { #if SEXP_USE_FLONUMS case SEXP_FLONUM: - res = sexp_flonum_value(a) - sexp_flonum_value(b); + res = sexp_flonum_value(a) > sexp_flonum_value(b) ? 1 : + sexp_flonum_value(a) < sexp_flonum_value(b) ? -1 : 0; break; #endif #if SEXP_USE_BIGNUMS case SEXP_BIGNUM: res = sexp_bignum_compare(a, b); break; +#endif +#if SEXP_USE_RATIOS + case SEXP_RATIO: + res = sexp_ratio_compare(ctx, a, b); + break; +#endif +#if SEXP_USE_COMPLEX + case SEXP_COMPLEX: + res = sexp_object_compare(ctx, sexp_complex_real(a), sexp_complex_real(b)); + if (res==0) res = sexp_object_compare(ctx, sexp_complex_imag(a), sexp_complex_imag(b)); + break; #endif case SEXP_STRING: res = strcmp(sexp_string_data(a), sexp_string_data(b)); @@ -121,6 +133,7 @@ static sexp sexp_object_compare_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, } /* fast path when using general object-cmp comparator with no key */ +/* TODO: include another fast path when the key is a fixed offset */ static void sexp_qsort (sexp ctx, sexp *vec, sexp_sint_t lo, sexp_sint_t hi) { sexp_sint_t mid, i, j, diff; sexp tmp, tmp2; diff --git a/tests/sort-tests.scm b/tests/sort-tests.scm index 581096e9..728a987f 100644 --- a/tests/sort-tests.scm +++ b/tests/sort-tests.scm @@ -45,4 +45,52 @@ (sort '("elephant" "CaT" "DOG" "ape" "GoAt" "Fox" "HAWK" "Bear") string-ci