feature(core): add math and comparison functions

4 files changed, 189 insertions, 26 deletions

diff --git a/core.fnl b/core.fnl
index 192d9fb..bbd1716 100644
--- a/core.fnl
+++ b/core.fnl
@@ -315,16 +315,7 @@ ignored. Returns a table of results."
       (insert res [k v]))
     res))
 
-(fn* core.eq?
-  "Deep compare values."
-  ([x] true)
-  ([x y]
-   (if (and (= (type x) :table) (= (type y) :table))
-       (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. y k) v)) (kvseq x)))
-            (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. x k) v)) (kvseq y))))
-       (= x y)))
-  ([x y & xs]
-   (reduce #(and $1 $2) (eq? x y) (mapv #(eq? x $) xs))))
+
 
 (fn& core.identity [x] x)
 
@@ -448,4 +439,90 @@ that would apply to that value, or `nil' if none apply and no default."
   (or (. (getmetatable multifn) :multimethods dispatch-val)
       (. (getmetatable multifn) :multimethods :default)))
 
+(fn* core.plus
+  ([] 0)
+  ([a] a)
+  ([a b] (+ a b))
+  ([a b c] (+ a b c))
+  ([a b c d] (+ a b c d))
+  ([a b c d & rest] (apply plus (+ a b c d) rest)))
+
+(fn* core.minus
+  ([] 0)
+  ([a] (- a))
+  ([a b] (- a b))
+  ([a b c] (- a b c))
+  ([a b c d] (- a b c d))
+  ([a b c d & rest] (apply minus (- a b c d) rest)))
+
+(fn* core.mul
+  ([] 1)
+  ([a] a)
+  ([a b] (* a b))
+  ([a b c] (* a b c))
+  ([a b c d] (* a b c d))
+  ([a b c d & rest] (apply mul (* a b c d) rest)))
+
+(fn* core.div
+  ([a] (/ 1 a))
+  ([a b] (/ a b))
+  ([a b c] (/ a b c))
+  ([a b c d] (/ a b c d))
+  ([a b c d & rest] (apply div (/ a b c d) rest)))
+
+(fn* core.le
+  "Returns true if nums are in monotonically non-decreasing order"
+  ([x] true)
+  ([x y] (<= x y))
+  ([x y & more]
+   (if (<= x y)
+       (if (next more 1)
+           (le y (. more 1) (unpack more 2))
+           (<= y (. more 1)))
+       false)))
+
+(fn* core.lt
+  "Returns true if nums are in monotonically decreasing order"
+  ([x] true)
+  ([x y] (< x y))
+  ([x y & more]
+   (if (< x y)
+       (if (next more 1)
+           (lt y (. more 1) (unpack more 2))
+           (< y (. more 1)))
+       false)))
+
+(fn* core.ge
+  "Returns true if nums are in monotonically non-increasing order"
+  ([x] true)
+  ([x y] (>= x y))
+  ([x y & more]
+   (if (>= x y)
+       (if (next more 1)
+           (ge y (. more 1) (unpack more 2))
+           (>= y (. more 1)))
+       false)))
+
+(fn* core.gt
+  "Returns true if nums are in monotonically increasing order"
+  ([x] true)
+  ([x y] (> x y))
+  ([x y & more]
+   (if (> x y)
+       (if (next more 1)
+           (gt y (. more 1) (unpack more 2))
+           (> y (. more 1)))
+       false)))
+
+(fn* core.eq
+  "Deep compare values."
+  ([x] true)
+  ([x y]
+   (if (and (= (type x) :table) (= (type y) :table))
+       (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq (. y k) v)) (kvseq x)))
+            (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq (. x k) v)) (kvseq y))))
+       (= x y)))
+  ([x y & xs]
+   (reduce #(and $1 $2) (eq x y) (mapv #(eq x $) xs))))
+
 core
diff --git a/core_test.fnl b/core_test.fnl
index 55710d1..7922e34 100644
--- a/core_test.fnl
+++ b/core_test.fnl
@@ -34,7 +34,7 @@
   : true?
   : empty?
   : not-empty
-  : eq?
+  : eq
   : identity
   : comp
   : every?
@@ -52,31 +52,39 @@
   : get-method
   : methods
   : remove-method
-  : remove-all-methods}
+  : remove-all-methods
+  : plus
+  : minus
+  : mul
+  : div
+  : le
+  : ge
+  : lt
+  : gt}
  (require :core))
 
 (deftest equality
-  (testing eq?
-    (assert* (not (pcall eq?)))
+  (testing eq
+    (assert* (not (pcall eq)))
     ;; comparing basetypes
     (assert-eq 1 1)
     (assert-ne 1 2)
-    (assert* (eq? 1 1 1 1 1))
+    (assert* (eq 1 1 1 1 1))
     (assert-eq 1.0 1.0)
-    (assert* (eq? 1.0 1.0 1.0))
-    (assert* (eq? 1.0 1.0 1.0))
-    (assert* (eq? "1" "1" "1" "1" "1"))
+    (assert* (eq 1.0 1.0 1.0))
+    (assert* (eq 1.0 1.0 1.0))
+    (assert* (eq "1" "1" "1" "1" "1"))
 
     ;; deep comparison
-    (assert* (eq? []))
+    (assert* (eq []))
     (assert-eq [] [])
     (assert-eq [] {})
     (assert-eq [1 2] [1 2])
     (assert-ne [1] [1 2])
     (assert-ne [1 2] [1])
-    (assert* (eq? [1 [2]] [1 [2]] [1 [2]]))
-    (assert* (eq? [1 [2]] [1 [2]] [1 [2]]))
-    (assert* (not (eq? [1 [2]] [1 [2]] [1 [2 [3]]])))
+    (assert* (eq [1 [2]] [1 [2]] [1 [2]]))
+    (assert* (eq [1 [2]] [1 [2]] [1 [2]]))
+    (assert* (not (eq [1 [2]] [1 [2]] [1 [2 [3]]])))
 
     (let [a {:a 1 :b 2}
           b {:a 1 :b 2}]
@@ -501,3 +509,81 @@
     (assert-eq (methods f) {})
     (assert* (not (pcall remove-all-methods)))
     (assert* (not (pcall remove-all-methods f f)))))
+
+(deftest math-functions
+  (testing plus
+    (assert-eq (plus) 0)
+    (assert-eq (plus 1) 1)
+    (assert-eq (plus -1) -1)
+    (assert-eq (plus 1 2) 3)
+    (assert-eq (plus 1 2 3) 6)
+    (assert-eq (plus 1 2 3 4) 10)
+    (assert-eq (plus 1 2 3 4 5) 15))
+
+  (testing minus
+    (assert-eq (minus) 0)
+    (assert-eq (minus 1) -1)
+    (assert-eq (minus -1) 1)
+    (assert-eq (minus 1 2) -1)
+    (assert-eq (minus 1 2 3) -4)
+    (assert-eq (minus 1 2 3 4) -8)
+    (assert-eq (minus 1 2 3 4 5) -13))
+
+  (testing mul
+    (assert-eq (mul) 1)
+    (assert-eq (mul 1) 1)
+    (assert-eq (mul -1) -1)
+    (assert-eq (mul 1 2) 2)
+    (assert-eq (mul 1 2 3) 6)
+    (assert-eq (mul 1 2 3 4) 24)
+    (assert-eq (mul 1 2 3 4 5) 120))
+
+  (testing div
+    (assert* (not (pcall div)))
+    (assert-eq (div 1) 1)
+    (assert-eq (div -1) -1)
+    (assert-eq (div 1 2) (/ 1 2))
+    (assert-eq (div 1 2 3) (/ 1 2 3))
+    (assert-eq (div 1 2 3 4) (/ 1 2 3 4))
+    (assert-eq (div 1 2 3 4 5) (/ 1 2 3 4 5))))
+
+(deftest comparison-functions
+  (testing le
+    (assert* (not (pcall le)))
+    (assert* (le 1))
+    (assert* (le 1 2))
+    (assert* (le 1 2 2))
+    (assert* (le 1 2 3 4))
+    (assert* (not (le 2 1)))
+    (assert* (not (le 2 1 3)))
+    (assert* (not (le 1 2 4 3))))
+
+  (testing lt
+    (assert* (not (pcall lt)))
+    (assert* (lt 1))
+    (assert* (lt 1 2))
+    (assert* (lt 1 2 3))
+    (assert* (lt 1 2 3 4))
+    (assert* (not (lt 2 1)))
+    (assert* (not (lt 2 1 3)))
+    (assert* (not (lt 1 2 4 4))))
+
+  (testing ge
+    (assert* (not (pcall ge)))
+    (assert* (ge 2))
+    (assert* (ge 2 1))
+    (assert* (ge 3 3 2))
+    (assert* (ge 4 3 2 -1))
+    (assert* (not (ge 1 2)))
+    (assert* (not (ge 2 1 3)))
+    (assert* (not (ge 1 2 4 4))))
+
+  (testing gt
+    (assert* (not (pcall ge)))
+    (assert* (gt 2))
+    (assert* (gt 2 1))
+    (assert* (gt 3 2 1))
+    (assert* (gt 4 3 2 -1))
+    (assert* (not (gt 1 2)))
+    (assert* (not (gt 2 1 3)))
+    (assert* (not (gt 1 2 4 4)))))
diff --git a/macros_test.fnl b/macros_test.fnl
index f8c72fa..8da9e7f 100644
--- a/macros_test.fnl
+++ b/macros_test.fnl
@@ -1,6 +1,6 @@
 (import-macros {: if-let : when-let : if-some : when-some : into : defmethod : defmulti} :macros.core)
 (import-macros {: assert-eq : assert-ne : assert* : testing : deftest} :test)
-(local {: eq? : identity} (require :core)) ;; required for testing
+(local {: eq : identity} (require :core)) ;; required for testing
 
 (deftest into
   (testing into
diff --git a/test.fnl b/test.fnl
index 0e797bd..e41a393 100644
--- a/test.fnl
+++ b/test.fnl
@@ -1,5 +1,5 @@
 (import-macros {: fn*} :macros.fn)
-;; requires `eq?' from core.fnl to be available at runtime
+;; requires `eq' from core.fnl to be available at runtime
 
 (fn* assert-eq
   ([expr1 expr2]
@@ -8,7 +8,7 @@
   `(let [left# ,expr1
          right# ,expr2
          view# (require :fennelview)]
-     (assert (eq? left# right#) (or ,msg (.. "equality assertion failed
+     (assert (eq left# right#) (or ,msg (.. "equality assertion failed
   Left: " (view# left#) "
   Right: " (view# right#) "\n"))))))
 
@@ -19,7 +19,7 @@
   `(let [left# ,expr1
          right# ,expr2
          view# (require :fennelview)]
-     (assert (not (eq? left# right#)) (or ,msg (.. "unequality assertion failed
+     (assert (not (eq left# right#)) (or ,msg (.. "unequality assertion failed
   Left: " (view# left#) "
   Right: " (view# right#) "\n"))))))