From 0ceb3726c1ba0c70849b971e2d9052b0cad8e1c8 Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Sat, 20 Jun 2015 22:40:04 +0900
Subject: [PATCH] sexp_object_compare should sort different numeric types
 together. Fixes issue #271.

---
 lib/srfi/95/qsort.c  | 34 ++++++++++++++++++++++++++++++----
 lib/srfi/95/test.sld | 12 ++++++++++++
 2 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/lib/srfi/95/qsort.c b/lib/srfi/95/qsort.c
index b3fd7b32..830b6736 100644
--- a/lib/srfi/95/qsort.c
+++ b/lib/srfi/95/qsort.c
@@ -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)),
diff --git a/lib/srfi/95/test.sld b/lib/srfi/95/test.sld
index 30e1fa23..1481e0ac 100644
--- a/lib/srfi/95/test.sld
+++ b/lib/srfi/95/test.sld
@@ -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))))