From 81d301a42b4906c592ada9775c6c5348eb95f4f9 Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Thu, 4 Jun 2020 12:23:54 -0400
Subject: [PATCH 1/8] Initial commit of base functionality for compare

---
 src/boot/boot.janet | 60 +++++++++++++++++++++++++++++++++++++++++++++
 test/suite0.janet   | 47 +++++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+)

diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index fc077435..70b9e08f 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -667,6 +667,66 @@
   [xs]
   (get xs (- (length xs) 1)))
 
+## Polymorphic comparisons
+
+(defn compare-primitive
+  "Compare x and y using primitive operators.
+   Returns -1,0,1 for x < y, x = y, x > y respectively.
+   Present mostly for constructing 'compare' methods in prototypes."
+  [x y]
+  (cond
+    (= x y) 0
+    (< x y) -1
+    (> x y) 1))
+
+(defn compare
+  "Polymorphic compare.  Returns -1,0,1 for x < y, x = y, x > y respectively.
+   Differs from the primitive comparators in that it first checks to
+   see whether either x or y implement a 'compare' method which can
+   compare x and y.  If so it uses that compare method.  If not, it
+   delegates to the primitive comparators."
+  [x y]
+  (or
+    (when-let [f (get x :compare)] (f x y))
+    (when-let [f (get y :compare)
+               fyx (f y x)] (- fyx))
+    (compare-primitive x y)))
+
+(defn compare-reduce- [op & xs]
+  (var r true)
+  (loop [i :range [0 (- (length xs) 1)]
+         c (compare (xs i) (xs (+ i 1)))
+         ok (op c 0)
+         :when (not ok)]
+    (set r false)
+    (break))
+  r)
+
+(defn compare=
+  "Equivalent of '=' but using compare function instead of primitive comparator"
+  [& xs]
+  (compare-reduce := xs))
+
+(defn compare<
+  "Equivalent of '<' but using compare function instead of primitive comparator"
+  [& xs]
+  (compare-reduce :< xs))
+
+(defn compare<=
+  "Equivalent of '<=' but using compare function instead of primitive comparator"
+  [& xs]
+  (compare-reduce :<= xs))
+
+(defn compare>
+  "Equivalent of '>' but using compare function instead of primitive comparator"
+  [& xs]
+  (compare-reduce :> xs))
+
+(defn compare>=
+  "Equivalent of '>=' but using compare function instead of primitive comparator"
+  [& xs]
+  (compare-reduce :>= xs))
+
 ###
 ###
 ### Indexed Combinators
diff --git a/test/suite0.janet b/test/suite0.janet
index 606e2fb5..1cbc7ba7 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -334,5 +334,52 @@
 (assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
 (assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
 
+## Polymorphic comparison -- Issue #272
+
+# confirm delegation to primitive comparators:
+(assert (= 0 (compare 1 1)) "compare integers (1)")
+(assert (< 0 (compare 1 2)) "compare integers (2)")
+(assert (> 0 (compare "foo" "bar")) "compare strings (1)")
+
+(assert (compare< 1 2 3 4 5 6) "compare less than integers")
+(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
+(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
+(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
+(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
+(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
+(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
+(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
+(assert (compare< 1.0 nil false true
+           (fiber/new (fn [] 1))
+           "hi"
+           (quote hello)
+           :hello
+           (array 1 2 3)
+           (tuple 1 2 3)
+           (table "a" "b" "c" "d")
+           (struct 1 2 3 4)
+           (buffer "hi")
+           (fn [x] (+ x x))
+           print) "compare type ordering")
+
+# test polymorphic
+(def mynum
+  @{:type :mynum :v 0 :compare
+    (fn [self other]
+      (case (type other)
+      :number (compare-primitive (self :v) other))
+      :table (when (= (get self :type) :mynum)
+               (compare-primitive (self :v) (other :v))))})
+
+(let [n3 (table/setproto @{:v 3} mynum)]
+  (assert (= 0 (compare 3 n3)) "compare num to object (1)")
+  (assert (< 0 (compare n3 4)) "compare object to num (2)")
+  (assert (> 0 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
+  (assert (compare< 2 n3 4) "compare< poly")
+  (assert (compare> 4 n3 2) "compare> poly")
+  (assert (compare<= 2 3 n3 4) "compare<= poly")
+  (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
+  (assert (deep= (sorted [4 5 n3 2] compare<) @[2 n3 4 5])))
+
 (end-suite)
 

From 7658ea83352177da4186d18f477b2254e9ab343f Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Thu, 4 Jun 2020 12:46:58 -0400
Subject: [PATCH 2/8] primitive tests working.  issues remain with polymorphic.

---
 src/boot/boot.janet | 14 +++++++-------
 test/suite0.janet   | 15 +++++++++------
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index 70b9e08f..91f2d533 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -695,8 +695,8 @@
 (defn compare-reduce- [op & xs]
   (var r true)
   (loop [i :range [0 (- (length xs) 1)]
-         c (compare (xs i) (xs (+ i 1)))
-         ok (op c 0)
+         :let [c (compare (xs i) (xs (+ i 1)))
+               ok (op c 0)]
          :when (not ok)]
     (set r false)
     (break))
@@ -705,27 +705,27 @@
 (defn compare=
   "Equivalent of '=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce := xs))
+  (compare-reduce- := xs))
 
 (defn compare<
   "Equivalent of '<' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce :< xs))
+  (compare-reduce- :< xs))
 
 (defn compare<=
   "Equivalent of '<=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce :<= xs))
+  (compare-reduce- :<= xs))
 
 (defn compare>
   "Equivalent of '>' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce :> xs))
+  (compare-reduce- :> xs))
 
 (defn compare>=
   "Equivalent of '>=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce :>= xs))
+  (compare-reduce- :>= xs))
 
 ###
 ###
diff --git a/test/suite0.janet b/test/suite0.janet
index 1cbc7ba7..20b13465 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -337,9 +337,12 @@
 ## Polymorphic comparison -- Issue #272
 
 # confirm delegation to primitive comparators:
+(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
+(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
+(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
 (assert (= 0 (compare 1 1)) "compare integers (1)")
-(assert (< 0 (compare 1 2)) "compare integers (2)")
-(assert (> 0 (compare "foo" "bar")) "compare strings (1)")
+(assert (= -1 (compare 1 2)) "compare integers (2)")
+(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
 
 (assert (compare< 1 2 3 4 5 6) "compare less than integers")
 (assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
@@ -368,18 +371,18 @@
     (fn [self other]
       (case (type other)
       :number (compare-primitive (self :v) other))
-      :table (when (= (get self :type) :mynum)
+      :table (when (= (get other :type) :mynum)
                (compare-primitive (self :v) (other :v))))})
 
 (let [n3 (table/setproto @{:v 3} mynum)]
   (assert (= 0 (compare 3 n3)) "compare num to object (1)")
-  (assert (< 0 (compare n3 4)) "compare object to num (2)")
-  (assert (> 0 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
+  (assert (= -1 (compare n3 4)) "compare object to num (2)")
+  (assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
   (assert (compare< 2 n3 4) "compare< poly")
   (assert (compare> 4 n3 2) "compare> poly")
   (assert (compare<= 2 3 n3 4) "compare<= poly")
   (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
-  (assert (deep= (sorted [4 5 n3 2] compare<) @[2 n3 4 5])))
+  (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
 
 (end-suite)
 

From 411c5da6d3eb2d197f24380432b2e4edbf744cdc Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Thu, 4 Jun 2020 13:49:09 -0400
Subject: [PATCH 3/8] compare functions now work for built ins and 'objects'

---
 src/boot/boot.janet | 12 ++++++------
 test/suite0.janet   |  7 +++++--
 2 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index 91f2d533..7cda9497 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -692,7 +692,7 @@
                fyx (f y x)] (- fyx))
     (compare-primitive x y)))
 
-(defn compare-reduce- [op & xs]
+(defn compare-reduce- [op xs]
   (var r true)
   (loop [i :range [0 (- (length xs) 1)]
          :let [c (compare (xs i) (xs (+ i 1)))
@@ -705,27 +705,27 @@
 (defn compare=
   "Equivalent of '=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce- := xs))
+  (compare-reduce- = xs))
 
 (defn compare<
   "Equivalent of '<' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce- :< xs))
+  (compare-reduce- < xs))
 
 (defn compare<=
   "Equivalent of '<=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce- :<= xs))
+  (compare-reduce- <= xs))
 
 (defn compare>
   "Equivalent of '>' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce- :> xs))
+  (compare-reduce- > xs))
 
 (defn compare>=
   "Equivalent of '>=' but using compare function instead of primitive comparator"
   [& xs]
-  (compare-reduce- :>= xs))
+  (compare-reduce- >= xs))
 
 ###
 ###
diff --git a/test/suite0.janet b/test/suite0.janet
index 20b13465..67fe8a87 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -345,9 +345,11 @@
 (assert (= 1 (compare "foo" "bar")) "compare strings (1)")
 
 (assert (compare< 1 2 3 4 5 6) "compare less than integers")
+(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
 (assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
 (assert (compare> 6 5 4 3 2 1) "compare greater than integers")
 (assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
+(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
 (assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
 (assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
 (assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
@@ -370,9 +372,9 @@
   @{:type :mynum :v 0 :compare
     (fn [self other]
       (case (type other)
-      :number (compare-primitive (self :v) other))
+      :number (compare-primitive (self :v) other)
       :table (when (= (get other :type) :mynum)
-               (compare-primitive (self :v) (other :v))))})
+               (compare-primitive (self :v) (other :v)))))})
 
 (let [n3 (table/setproto @{:v 3} mynum)]
   (assert (= 0 (compare 3 n3)) "compare num to object (1)")
@@ -384,5 +386,6 @@
   (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
   (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
 
+
 (end-suite)
 

From 01837f2bb6d4a5480b1f73d6393e9cb7c2d829b4 Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Thu, 4 Jun 2020 15:27:36 -0400
Subject: [PATCH 4/8] All tests pass.

---
 src/core/inttypes.c | 93 ++++++++++++++++++++++++++++++++++++++++++---
 test/suite0.janet   | 32 +++++++++++++++-
 2 files changed, 117 insertions(+), 8 deletions(-)

diff --git a/src/core/inttypes.c b/src/core/inttypes.c
index 4afd6ba0..4b72f07d 100644
--- a/src/core/inttypes.c
+++ b/src/core/inttypes.c
@@ -197,6 +197,80 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
     return janet_wrap_u64(janet_unwrap_u64(argv[0]));
 }
 
+static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    if (janet_is_int(argv[0]) != JANET_INT_S64)
+        janet_panic("compare method requires int/s64 as first argument");
+    int64_t x = janet_unwrap_s64(argv[0]);
+    switch (janet_type(argv[1])) {
+        default:
+            break;
+        case JANET_NUMBER : {
+            double y = round(janet_unwrap_number(argv[1]));
+            double dx = round((double) x);  //double trouble?
+            return janet_wrap_number(dx < y ? -1 : (dx > y ? 1 : 0));
+        }
+        case JANET_ABSTRACT: {
+            void *abst = janet_unwrap_abstract(argv[1]);
+            if (janet_abstract_type(abst) == &janet_s64_type) {
+                int64_t y = *(int64_t *)abst;
+                return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
+            } else if (janet_abstract_type(abst) == &janet_u64_type) {
+                // comparing signed to unsigned -- be careful!
+                uint64_t y = *(uint64_t *)abst;
+                if (x < 0) {
+                    return janet_wrap_number(-1);
+                } else if (y > INT64_MAX) {
+                    return janet_wrap_number(-1);
+                } else {
+                    int64_t y2 = (int64_t) y;
+                    return janet_wrap_number((x < y2) ? -1 : (x > y2 ? 1 : 0));
+                }
+            }
+            break;
+        }
+    }
+    return janet_wrap_nil();
+}
+
+static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 2);
+    if (janet_is_int(argv[0]) != JANET_INT_U64)  // is this needed?
+        janet_panic("compare method requires int/u64 as first argument");
+    uint64_t x = janet_unwrap_u64(argv[0]);
+    switch (janet_type(argv[1])) {
+        default:
+            break;
+        case JANET_NUMBER : {
+            double y = round(janet_unwrap_number(argv[1]));
+            if (y < 0)  // unsigned int x has to be greater
+                return janet_wrap_number(1);
+            double dx = round((double) x);  //double trouble?
+            return janet_wrap_number(dx < y ? -1 : (dx > y ? 1 : 0));
+        }
+        case JANET_ABSTRACT: {
+            void *abst = janet_unwrap_abstract(argv[1]);
+            if (janet_abstract_type(abst) == &janet_u64_type) {
+                uint64_t y = *(uint64_t *)abst;
+                return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
+            } else if (janet_abstract_type(abst) == &janet_s64_type) {
+                // comparing unsigned to signed -- be careful!
+                int64_t y = *(int64_t *)abst;
+                if (y < 0) {
+                    return janet_wrap_number(1);
+                } else if (x > INT64_MAX) {
+                    return janet_wrap_number(1);
+                } else {
+                    int64_t x2 = (int64_t) x;
+                    return janet_wrap_number((x2 < y) ? -1 : (x2 > y ? 1 : 0));
+                }
+            }
+            break;
+        }
+    }
+    return janet_wrap_nil();
+}
+
 #define OPMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_arity(argc, 2, -1); \
@@ -266,13 +340,14 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     return janet_wrap_abstract(box); \
 } \
 
+/*
 #define COMPMETHOD(T, type, name, oper) \
 static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     janet_fixarity(argc, 2); \
     T v1 = janet_unwrap_##type(argv[0]); \
     T v2 = janet_unwrap_##type(argv[1]); \
     return janet_wrap_boolean(v1 oper v2); \
-}
+} */
 
 static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, -1);
@@ -316,12 +391,14 @@ OPMETHOD(int64_t, s64, or, |)
 OPMETHOD(int64_t, s64, xor, ^)
 OPMETHOD(int64_t, s64, lshift, <<)
 OPMETHOD(int64_t, s64, rshift, >>)
+    /*
 COMPMETHOD(int64_t, s64, lt, <)
 COMPMETHOD(int64_t, s64, gt, >)
 COMPMETHOD(int64_t, s64, le, <=)
 COMPMETHOD(int64_t, s64, ge, >=)
 COMPMETHOD(int64_t, s64, eq, ==)
 COMPMETHOD(int64_t, s64, ne, !=)
+*/
 
 OPMETHOD(uint64_t, u64, add, +)
 OPMETHOD(uint64_t, u64, sub, -)
@@ -336,18 +413,20 @@ OPMETHOD(uint64_t, u64, or, |)
 OPMETHOD(uint64_t, u64, xor, ^)
 OPMETHOD(uint64_t, u64, lshift, <<)
 OPMETHOD(uint64_t, u64, rshift, >>)
+    /*
 COMPMETHOD(uint64_t, u64, lt, <)
 COMPMETHOD(uint64_t, u64, gt, >)
 COMPMETHOD(uint64_t, u64, le, <=)
 COMPMETHOD(uint64_t, u64, ge, >=)
 COMPMETHOD(uint64_t, u64, eq, ==)
-COMPMETHOD(uint64_t, u64, ne, !=)
+COMPMETHOD(uint64_t, u64, ne, !=) */
 
 #undef OPMETHOD
 #undef DIVMETHOD
 #undef DIVMETHOD_SIGNED
 #undef COMPMETHOD
 
+
 static JanetMethod it_s64_methods[] = {
     {"+", cfun_it_s64_add},
     {"r+", cfun_it_s64_add},
@@ -361,12 +440,12 @@ static JanetMethod it_s64_methods[] = {
     {"rmod", cfun_it_s64_modi},
     {"%", cfun_it_s64_rem},
     {"r%", cfun_it_s64_remi},
-    {"<", cfun_it_s64_lt},
+/*    {"<", cfun_it_s64_lt},
     {">", cfun_it_s64_gt},
     {"<=", cfun_it_s64_le},
     {">=", cfun_it_s64_ge},
     {"=", cfun_it_s64_eq},
-    {"!=", cfun_it_s64_ne},
+    {"!=", cfun_it_s64_ne},*/
     {"&", cfun_it_s64_and},
     {"r&", cfun_it_s64_and},
     {"|", cfun_it_s64_or},
@@ -375,6 +454,7 @@ static JanetMethod it_s64_methods[] = {
     {"r^", cfun_it_s64_xor},
     {"<<", cfun_it_s64_lshift},
     {">>", cfun_it_s64_rshift},
+    {"compare", cfun_it_s64_compare},
 
     {NULL, NULL}
 };
@@ -392,12 +472,12 @@ static JanetMethod it_u64_methods[] = {
     {"rmod", cfun_it_u64_modi},
     {"%", cfun_it_u64_mod},
     {"r%", cfun_it_u64_modi},
-    {"<", cfun_it_u64_lt},
+/*    {"<", cfun_it_u64_lt},
     {">", cfun_it_u64_gt},
     {"<=", cfun_it_u64_le},
     {">=", cfun_it_u64_ge},
     {"=", cfun_it_u64_eq},
-    {"!=", cfun_it_u64_ne},
+    {"!=", cfun_it_u64_ne}, */
     {"&", cfun_it_u64_and},
     {"r&", cfun_it_u64_and},
     {"|", cfun_it_u64_or},
@@ -406,6 +486,7 @@ static JanetMethod it_u64_methods[] = {
     {"r^", cfun_it_u64_xor},
     {"<<", cfun_it_u64_lshift},
     {">>", cfun_it_u64_rshift},
+    {"compare", cfun_it_u64_compare},
 
     {NULL, NULL}
 };
diff --git a/test/suite0.janet b/test/suite0.janet
index 67fe8a87..db2ba21e 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -336,7 +336,7 @@
 
 ## Polymorphic comparison -- Issue #272
 
-# confirm delegation to primitive comparators:
+# confirm polymorphic comparison delegation to primitive comparators:
 (assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
 (assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
 (assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
@@ -367,7 +367,7 @@
            (fn [x] (+ x x))
            print) "compare type ordering")
 
-# test polymorphic
+# test polymorphic compare with 'objects' (table/setproto)
 (def mynum
   @{:type :mynum :v 0 :compare
     (fn [self other]
@@ -386,6 +386,34 @@
   (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
   (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
 
+# test polymorphic compare with int/u64 and int/s64
+(def MAX_INT_64_STRING "9223372036854775807")
+(def MAX_UINT_64_STRING "18446744073709551615")
+(def MAX_INT_IN_DBL_STRING "9007199254740992")
+(assert (= 0 (compare (int/u64 3) 3)) "compare number to int/u64")
+(assert (= -1 (compare (int/u64 3) 4)) "compare number to int/u64 less")
+(assert (= 0 (compare 3 (int/u64 3))) "compare number to int/u64")
+(assert (= 1 (compare 4 (int/u64 3))) "compare number to int/u64 greater")
+(assert (= 0 (compare (int/u64 3) (int/u64 3))) "compare int/u64 to int/u64")
+(assert (= 1 (compare (int/u64 4) (int/u64 3))) "compare int/u64 to int/u64 greater")
+(assert (= 0 (compare (int/s64 3) 3)) "compare number to int/s64")
+(assert (= -1 (compare (int/s64 3) 4)) "compare number to int/s64 less")
+(assert (= 0 (compare 3 (int/s64 3))) "compare number to int/s64")
+(assert (= 1 (compare 4 (int/s64 3))) "compare number to int/s64 greater")
+(assert (= 0 (compare (int/s64 3) (int/s64 3))) "compare int/s64 to int/s64")
+(assert (= 1 (compare (int/s64 4) (int/s64 3))) "compare int/s64 to int/s64 greater")
+(assert (= 0 (compare (int/u64 3) (int/s64 3))) "compare int/u64 to int/s64 (1)")
+(assert (= -1 (compare (int/u64 3) (int/s64 4))) "compare int/u64 to int/s64 (2)")
+(assert (= 1 (compare (int/u64 1) (int/s64 -1))) "compare int/u64 to int/s64 (3)")
+(assert (= 1 (compare (int/s64 4) (int/u64 3))) "compare int/s64 to int/u64")
+(assert (= -1 (compare (int/s64 -1) (int/u64 0))) "compare int/s64 to int/u64 negative")
+(assert (= -1 (compare (int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING))) "compare big ints")
+(assert (= 0 (compare (int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (1)")
+(assert (= 0 (compare (int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (2)")
+(assert (= 1 (compare (+ 2 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
+# Beware: This is a horrible effect of comparing doubles to integers 
+# int/64(MAX+1) should compare greater than the double, (but doesn't due to precision)
+(assert (= 0 (compare (+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
 
 (end-suite)
 

From 3e423722c6571d8c2bc495005e60cf308058d5f3 Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Thu, 4 Jun 2020 18:27:48 -0400
Subject: [PATCH 5/8] Actually got the comparisons working for s64 (still need
 to fix u64)

---
 src/core/inttypes.c | 21 ++++++++++++++++++---
 test/suite0.janet   |  7 ++-----
 2 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/src/core/inttypes.c b/src/core/inttypes.c
index 4b72f07d..713ada4d 100644
--- a/src/core/inttypes.c
+++ b/src/core/inttypes.c
@@ -197,6 +197,10 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
     return janet_wrap_u64(janet_unwrap_u64(argv[0]));
 }
 
+static int64_t compare_double(double x, double y) {
+    return (x < y) ? -1 : ((x > y) ? 1 : 0);
+}
+
 static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
     if (janet_is_int(argv[0]) != JANET_INT_S64)
@@ -206,9 +210,20 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
         default:
             break;
         case JANET_NUMBER : {
-            double y = round(janet_unwrap_number(argv[1]));
-            double dx = round((double) x);  //double trouble?
-            return janet_wrap_number(dx < y ? -1 : (dx > y ? 1 : 0));
+            double y = janet_unwrap_number(argv[1]);
+            if (isnan(y)) {
+                return janet_wrap_number(0); // per python compare function
+            } else if ((y > ((double) -MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
+                double dx = (double) x;
+                return janet_wrap_number(compare_double(dx, y));
+            } else if (y > ((double) INT64_MAX)) {
+                return janet_wrap_number(1);
+            } else if (y < ((double) INT64_MIN)) {
+                return janet_wrap_number(-1);
+            } else {
+                int64_t yi = (int64_t) y;
+                return janet_wrap_number((x < yi) ? -1 : ((x > yi) ? 1 : 0));
+            }
         }
         case JANET_ABSTRACT: {
             void *abst = janet_unwrap_abstract(argv[1]);
diff --git a/test/suite0.janet b/test/suite0.janet
index db2ba21e..bbb97a24 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -389,7 +389,7 @@
 # test polymorphic compare with int/u64 and int/s64
 (def MAX_INT_64_STRING "9223372036854775807")
 (def MAX_UINT_64_STRING "18446744073709551615")
-(def MAX_INT_IN_DBL_STRING "9007199254740992")
+(def MAX_INT_IN_DBL_STRING "9007199254740991")
 (assert (= 0 (compare (int/u64 3) 3)) "compare number to int/u64")
 (assert (= -1 (compare (int/u64 3) 4)) "compare number to int/u64 less")
 (assert (= 0 (compare 3 (int/u64 3))) "compare number to int/u64")
@@ -410,10 +410,7 @@
 (assert (= -1 (compare (int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING))) "compare big ints")
 (assert (= 0 (compare (int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (1)")
 (assert (= 0 (compare (int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (2)")
-(assert (= 1 (compare (+ 2 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
-# Beware: This is a horrible effect of comparing doubles to integers 
-# int/64(MAX+1) should compare greater than the double, (but doesn't due to precision)
-(assert (= 0 (compare (+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
+(assert (= 1 (compare (+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
 
 (end-suite)
 

From a4178d4b3c694daa94d55e3c650b240eba8baaf0 Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Fri, 5 Jun 2020 10:51:35 -0400
Subject: [PATCH 6/8] All tests pass for compare.

---
 src/core/inttypes.c | 63 ++++++++++++++++++++++++++++++++-------------
 test/suite0.janet   | 50 ++++++++++++++++++++---------------
 2 files changed, 74 insertions(+), 39 deletions(-)

diff --git a/src/core/inttypes.c b/src/core/inttypes.c
index 713ada4d..06aec34b 100644
--- a/src/core/inttypes.c
+++ b/src/core/inttypes.c
@@ -197,10 +197,52 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
     return janet_wrap_u64(janet_unwrap_u64(argv[0]));
 }
 
-static int64_t compare_double(double x, double y) {
+// Code to support polymorphic comparison.
+//
+// int/u64 and int/s64 support a "compare" method that allows
+// comparison to each other, and to Janet numbers, using the
+// "compare" "compare<" ... functions.
+//
+// In the following code explicit casts are sometimes used to help
+// make it clear when int/float conversions are happening.
+//
+static int64_t compare_double_double(double x, double y) {
     return (x < y) ? -1 : ((x > y) ? 1 : 0);
 }
 
+static int64_t compare_int64_double(int64_t x, double y) {
+    if (isnan(y)) {
+        return 0; // clojure and python do this
+    } else if ((y > ((double) -MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
+        double dx = (double) x;
+        return compare_double_double(dx, y);
+    } else if (y > ((double) INT64_MAX)) {
+        return -1;
+    } else if (y < ((double) INT64_MIN)) {
+        return 1;
+    } else {
+        int64_t yi = (int64_t) y;
+        return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
+    }
+}
+
+static int64_t compare_uint64_double(uint64_t x, double y) {
+    if (isnan(y)) {
+        return 0; // clojure and python do this
+    } else if (y < 0) {
+        return 1;
+    } else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
+        double dx = (double) x;
+        return compare_double_double(dx, y);
+    } else if (y > ((double) UINT64_MAX)) {
+        return -1;
+    } else {
+        uint64_t yi = (uint64_t) y;
+        return (x < yi) ? -1 : ((x > yi) ? 1 : 0);
+    }
+}
+
+
 static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
     janet_fixarity(argc, 2);
     if (janet_is_int(argv[0]) != JANET_INT_S64)
@@ -211,19 +253,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
             break;
         case JANET_NUMBER : {
             double y = janet_unwrap_number(argv[1]);
-            if (isnan(y)) {
-                return janet_wrap_number(0); // per python compare function
-            } else if ((y > ((double) -MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
-                double dx = (double) x;
-                return janet_wrap_number(compare_double(dx, y));
-            } else if (y > ((double) INT64_MAX)) {
-                return janet_wrap_number(1);
-            } else if (y < ((double) INT64_MIN)) {
-                return janet_wrap_number(-1);
-            } else {
-                int64_t yi = (int64_t) y;
-                return janet_wrap_number((x < yi) ? -1 : ((x > yi) ? 1 : 0));
-            }
+            return janet_wrap_number(compare_int64_double(x, y));
         }
         case JANET_ABSTRACT: {
             void *abst = janet_unwrap_abstract(argv[1]);
@@ -258,10 +288,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
             break;
         case JANET_NUMBER : {
             double y = round(janet_unwrap_number(argv[1]));
-            if (y < 0)  // unsigned int x has to be greater
-                return janet_wrap_number(1);
-            double dx = round((double) x);  //double trouble?
-            return janet_wrap_number(dx < y ? -1 : (dx > y ? 1 : 0));
+            return janet_wrap_number(compare_uint64_double(x, y));
         }
         case JANET_ABSTRACT: {
             void *abst = janet_unwrap_abstract(argv[1]);
diff --git a/test/suite0.janet b/test/suite0.janet
index bbb97a24..26525fd8 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -390,27 +390,35 @@
 (def MAX_INT_64_STRING "9223372036854775807")
 (def MAX_UINT_64_STRING "18446744073709551615")
 (def MAX_INT_IN_DBL_STRING "9007199254740991")
-(assert (= 0 (compare (int/u64 3) 3)) "compare number to int/u64")
-(assert (= -1 (compare (int/u64 3) 4)) "compare number to int/u64 less")
-(assert (= 0 (compare 3 (int/u64 3))) "compare number to int/u64")
-(assert (= 1 (compare 4 (int/u64 3))) "compare number to int/u64 greater")
-(assert (= 0 (compare (int/u64 3) (int/u64 3))) "compare int/u64 to int/u64")
-(assert (= 1 (compare (int/u64 4) (int/u64 3))) "compare int/u64 to int/u64 greater")
-(assert (= 0 (compare (int/s64 3) 3)) "compare number to int/s64")
-(assert (= -1 (compare (int/s64 3) 4)) "compare number to int/s64 less")
-(assert (= 0 (compare 3 (int/s64 3))) "compare number to int/s64")
-(assert (= 1 (compare 4 (int/s64 3))) "compare number to int/s64 greater")
-(assert (= 0 (compare (int/s64 3) (int/s64 3))) "compare int/s64 to int/s64")
-(assert (= 1 (compare (int/s64 4) (int/s64 3))) "compare int/s64 to int/s64 greater")
-(assert (= 0 (compare (int/u64 3) (int/s64 3))) "compare int/u64 to int/s64 (1)")
-(assert (= -1 (compare (int/u64 3) (int/s64 4))) "compare int/u64 to int/s64 (2)")
-(assert (= 1 (compare (int/u64 1) (int/s64 -1))) "compare int/u64 to int/s64 (3)")
-(assert (= 1 (compare (int/s64 4) (int/u64 3))) "compare int/s64 to int/u64")
-(assert (= -1 (compare (int/s64 -1) (int/u64 0))) "compare int/s64 to int/u64 negative")
-(assert (= -1 (compare (int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING))) "compare big ints")
-(assert (= 0 (compare (int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (1)")
-(assert (= 0 (compare (int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (2)")
-(assert (= 1 (compare (+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING))) "compare max int in double (3)")
+
+(let [
+      MAX_INT_64_STRING "9223372036854775807"
+      MAX_UINT_64_STRING "18446744073709551615"
+      MAX_INT_IN_DBL_STRING "9007199254740991"
+      NAN (math/log -1)
+      INF (/ 1 0)
+      MINUS_INF (/ -1 0)
+
+      compare-poly-tests
+      [
+       [(int/s64 3) (int/u64 3) 0]
+       [(int/s64 -3) (int/u64 3) -1]
+       [(int/s64 3) (int/u64 2) 1] 
+       [(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
+       [(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
+       [3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
+       [3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
+       [(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
+       [(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
+       [(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
+       [(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
+       [(int/s64 0) INF -1] [(int/u64 0) INF -1]
+       [MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1] 
+       [(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
+       ]]
+  (each [x y c] compare-poly-tests
+    (assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
+  )
 
 (end-suite)
 

From 76c34363774348eb5736eed3edf8146b2c39fd7b Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Fri, 5 Jun 2020 11:07:48 -0400
Subject: [PATCH 7/8] Remove vestigial comparison methods from int types

---
 src/core/inttypes.c | 37 -------------------------------------
 1 file changed, 37 deletions(-)

diff --git a/src/core/inttypes.c b/src/core/inttypes.c
index 06aec34b..28ed0a6f 100644
--- a/src/core/inttypes.c
+++ b/src/core/inttypes.c
@@ -382,15 +382,6 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
     return janet_wrap_abstract(box); \
 } \
 
-/*
-#define COMPMETHOD(T, type, name, oper) \
-static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
-    janet_fixarity(argc, 2); \
-    T v1 = janet_unwrap_##type(argv[0]); \
-    T v2 = janet_unwrap_##type(argv[1]); \
-    return janet_wrap_boolean(v1 oper v2); \
-} */
-
 static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, -1);
     int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
@@ -433,15 +424,6 @@ OPMETHOD(int64_t, s64, or, |)
 OPMETHOD(int64_t, s64, xor, ^)
 OPMETHOD(int64_t, s64, lshift, <<)
 OPMETHOD(int64_t, s64, rshift, >>)
-    /*
-COMPMETHOD(int64_t, s64, lt, <)
-COMPMETHOD(int64_t, s64, gt, >)
-COMPMETHOD(int64_t, s64, le, <=)
-COMPMETHOD(int64_t, s64, ge, >=)
-COMPMETHOD(int64_t, s64, eq, ==)
-COMPMETHOD(int64_t, s64, ne, !=)
-*/
-
 OPMETHOD(uint64_t, u64, add, +)
 OPMETHOD(uint64_t, u64, sub, -)
 OPMETHODINVERT(uint64_t, u64, subi, -)
@@ -455,13 +437,6 @@ OPMETHOD(uint64_t, u64, or, |)
 OPMETHOD(uint64_t, u64, xor, ^)
 OPMETHOD(uint64_t, u64, lshift, <<)
 OPMETHOD(uint64_t, u64, rshift, >>)
-    /*
-COMPMETHOD(uint64_t, u64, lt, <)
-COMPMETHOD(uint64_t, u64, gt, >)
-COMPMETHOD(uint64_t, u64, le, <=)
-COMPMETHOD(uint64_t, u64, ge, >=)
-COMPMETHOD(uint64_t, u64, eq, ==)
-COMPMETHOD(uint64_t, u64, ne, !=) */
 
 #undef OPMETHOD
 #undef DIVMETHOD
@@ -482,12 +457,6 @@ static JanetMethod it_s64_methods[] = {
     {"rmod", cfun_it_s64_modi},
     {"%", cfun_it_s64_rem},
     {"r%", cfun_it_s64_remi},
-/*    {"<", cfun_it_s64_lt},
-    {">", cfun_it_s64_gt},
-    {"<=", cfun_it_s64_le},
-    {">=", cfun_it_s64_ge},
-    {"=", cfun_it_s64_eq},
-    {"!=", cfun_it_s64_ne},*/
     {"&", cfun_it_s64_and},
     {"r&", cfun_it_s64_and},
     {"|", cfun_it_s64_or},
@@ -514,12 +483,6 @@ static JanetMethod it_u64_methods[] = {
     {"rmod", cfun_it_u64_modi},
     {"%", cfun_it_u64_mod},
     {"r%", cfun_it_u64_modi},
-/*    {"<", cfun_it_u64_lt},
-    {">", cfun_it_u64_gt},
-    {"<=", cfun_it_u64_le},
-    {">=", cfun_it_u64_ge},
-    {"=", cfun_it_u64_eq},
-    {"!=", cfun_it_u64_ne}, */
     {"&", cfun_it_u64_and},
     {"r&", cfun_it_u64_and},
     {"|", cfun_it_u64_or},

From 9824a34d761bab817ab38c49bbba99c2c5ae3b96 Mon Sep 17 00:00:00 2001
From: Mike Beller <bellermike@gmail.com>
Date: Sat, 6 Jun 2020 08:55:20 -0400
Subject: [PATCH 8/8] Remove dead code.

---
 src/core/inttypes.c | 2 +-
 test/suite0.janet   | 5 -----
 2 files changed, 1 insertion(+), 6 deletions(-)

diff --git a/src/core/inttypes.c b/src/core/inttypes.c
index 28ed0a6f..9a74ae69 100644
--- a/src/core/inttypes.c
+++ b/src/core/inttypes.c
@@ -287,7 +287,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
         default:
             break;
         case JANET_NUMBER : {
-            double y = round(janet_unwrap_number(argv[1]));
+            double y = janet_unwrap_number(argv[1]);
             return janet_wrap_number(compare_uint64_double(x, y));
         }
         case JANET_ABSTRACT: {
diff --git a/test/suite0.janet b/test/suite0.janet
index 26525fd8..f5fa2a8b 100644
--- a/test/suite0.janet
+++ b/test/suite0.janet
@@ -386,11 +386,6 @@
   (assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
   (assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
 
-# test polymorphic compare with int/u64 and int/s64
-(def MAX_INT_64_STRING "9223372036854775807")
-(def MAX_UINT_64_STRING "18446744073709551615")
-(def MAX_INT_IN_DBL_STRING "9007199254740991")
-
 (let [
       MAX_INT_64_STRING "9223372036854775807"
       MAX_UINT_64_STRING "18446744073709551615"