Add shadow functions for comparison operators

hy/core/shadow.hy

@@ -61,4 +61,33 @@
         (reduce operator.truediv args)))))
 
 
-(setv *exports* ['+ '- '* '/])
+(defn comp-op [op args]
+  "Helper for shadow comparison operators"
+  (if (< (len args) 2)
+    (raise (TypeError "Need at least 2 arguments to compare"))
+    (reduce operator.and_
+            (list-comp (op x y)
+                       [(, x y) (zip args (slice args 1))]))))
+(defn < [&rest args]
+  "Shadow < operator for when we need to import / map it against something"
+  (comp-op operator.lt args))
+(defn <= [&rest args]
+  "Shadow <= operator for when we need to import / map it against something"
+  (comp-op operator.le args))
+(defn = [&rest args]
+  "Shadow = operator for when we need to import / map it against something"
+  (comp-op operator.eq args))
+(defn != [&rest args]
+  "Shadow != operator for when we need to import / map it against something"
+  (comp-op operator.ne args))
+(defn >= [&rest args]
+  "Shadow >= operator for when we need to import / map it against something"
+  (comp-op operator.ge args))
+(defn > [&rest args]
+  "Shadow > operator for when we need to import / map it against something"
+  (comp-op operator.gt args))
+
+; TODO figure out a way to shadow "is", "is_not", "and", "or"
+
+
+(setv *exports* ['+ '- '* '/ '< '<= '= '!= '>= '>])

tests/native_tests/shadow.hy

@@ -50,3 +50,42 @@
     (assert (= (x 8 2) 4))
     (assert (= (x 8 2 2) 2))
     (assert (= (x 8 2 2 2) 1))))
+
+
+(defn test-shadow-compare []
+  "NATIVE: test shadow compare"
+  (for [x [< <= = != >= >]]
+     (assert (try
+              (x)
+              (catch [TypeError] True)
+              (else (throw AssertionError))))
+     (assert (try
+              (x 1)
+              (catch [TypeError] True)
+              (else (throw AssertionError)))))
+  (for [(, x y) [[< >=]
+                 [<= >]
+                 [= !=]]]
+    (for [args [[1 2]
+                [2 1]
+                [1 1]
+                [2 2]]]
+      (assert (= (apply x args) (not (apply y args))))))
+  (let [[s-lt <]
+        [s-gt >]
+        [s-le <=]
+        [s-ge >=]
+        [s-eq =]
+        [s-ne !=]]
+    (assert (apply s-lt [1 2 3]))
+    (assert (not (apply s-lt [3 2 1])))
+    (assert (apply s-gt [3 2 1]))
+    (assert (not (apply s-gt [1 2 3])))
+    (assert (apply s-le [1 1 2 2 3 3]))
+    (assert (not (apply s-le [1 1 2 2 1 1])))
+    (assert (apply s-ge [3 3 2 2 1 1]))
+    (assert (not (apply s-ge [3 3 2 2 3 3])))
+    (assert (apply s-eq [1 1 1 1 1]))
+    (assert (not (apply s-eq [1 1 2 1 1])))
+    (assert (apply s-ne [1 2 3 4 5]))
+    (assert (not (apply s-ne [1 1 2 3 4])))))