Fixing SRFI-95 sort for inexacts differing only in the fractional part

(reported by Alan Watson).
Also adding support for complex and ratios.

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);

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;

tests/sort-tests.scm

@@ -45,4 +45,52 @@
   (sort '("elephant" "CaT" "DOG" "ape" "GoAt" "Fox" "HAWK" "Bear")
           string-ci<?))
 
+(test "sort numeric inexact vector <" '#(1.1 2.2 3.3 4.4 5.5 6.6 7.7 8.8 9.9)
+  (sort '#(7.7 5.5 2.2 8.8 1.1 6.6 4.4 9.9 3.3) <))
+(test "sort numeric signed inexact vector <"
+    '#(-9.9 -7.7 -5.5 -3.3 -1.1 2.2 4.4 6.6 8.8)
+  (sort '#(-7.7 -5.5 2.2 8.8 -1.1 6.6 4.4 -9.9 -3.3) <))
+(test "sort numeric same whole number inexact vector"
+    '#(-5.2155
+       -4.3817
+       -4.3055
+       -4.0415
+       -3.5883
+       -3.5714
+       -3.4059
+       -2.7829
+       -2.6406
+       -2.4985
+       -2.4607
+       -1.2487
+       -0.537800000000001
+       -0.481999999999999
+       -0.469100000000001
+       -0.0932999999999993
+       0.0066999999999986)
+  (sort '#(-5.2155
+           -3.5714
+           -4.3817
+           -3.5883
+           -4.3055
+           -2.4985
+           -4.0415
+           -3.4059
+           -0.0932999999999993
+           -0.537800000000001
+           -2.6406
+           -0.481999999999999
+           -2.7829
+           -2.4607
+           -1.2487
+           -0.469100000000001
+           0.0066999999999986)
+        <))
+
+(test "sort ratios" '(1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5)
+  (sort '(1/2 1/3 1/4 1/5 2/3 3/4 2/5 3/5 4/5)))
+
+(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-end)