Add shadow functions for comparison operators

This commit is contained in:
Tianon Gravi 2015-03-11 22:11:22 -06:00
parent 4938163ec4
commit ff1c4ccdb3
2 changed files with 69 additions and 1 deletions

View File

@ -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* ['+ '- '* '/ '< '<= '= '!= '>= '>])

View File

@ -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])))))