diff options
| -rw-r--r-- | core.fnl | 89 | ||||
| -rw-r--r-- | core_test.fnl | 178 | ||||
| -rw-r--r-- | macros/core.fnl | 16 | ||||
| -rw-r--r-- | macros_test.fnl | 11 |
4 files changed, 190 insertions, 104 deletions
@@ -142,7 +142,7 @@ If `tbl' is sequential table, leaves it unchanged." (let [[y & xs] xs] (apply conj (conj tbl x) y xs)) (conj tbl x)))) -(fn* consj +(fn* -consj "Like conj but joins at the front. Modifies `tbl'." ([] []) ([tbl] tbl) @@ -151,8 +151,8 @@ If `tbl' is sequential table, leaves it unchanged." (doto tbl (insert 1 x)))) ([tbl x & xs] (if (> (length xs) 0) - (let [[y & xs] xs] (apply consj (consj tbl x) y xs)) - (consj tbl x)))) + (let [[y & xs] xs] (apply -consj (-consj tbl x) y xs)) + (-consj tbl x)))) (fn cons [x tbl] "Insert `x' to `tbl' at the front. Modifies `tbl'." @@ -264,7 +264,7 @@ ignored. Returns a table of results." (reduce #(and $1 $2))) (cons (mapv #(first (-safe-seq $)) tbls) (step (mapv rest tbls))))) res []] - (each [_ v (ipairs (step (consj tbls t3 t2 t1)))] + (each [_ v (ipairs (step (-consj tbls t3 t2 t1)))] (when-some [tmp (apply f v)] (insert res tmp))) res))) @@ -307,7 +307,7 @@ ignored. Returns a table of results." ([x y z] (f (g x y z))) ([x y z & args] (apply f g x y z args)))) ([f g & fs] - (apply reduce comp (conj [f g] fs)))) + (reduce comp (-consj fs g f)))) (fn* every? [pred tbl] @@ -348,41 +348,46 @@ oppisite truth value." (fn reverse [tbl] (when-some [tbl (seq tbl)] - (reduce consj [] tbl))) - -{: apply ;; not tested - : seq ;; tested - : first ;; not tested - : rest ;; not tested - : conj ;; not tested - : cons ;; not tested - : concat ;; tested - : reduce ;; tested - : reduce-kv ;; tested - : mapv ;; tested - : filter ;; tested - : map? ;; tested - : seq? ;; tested - : nil? ;; tested - : zero? ;; tested - : pos? ;; tested - : neg? ;; tested - : even? ;; tested - : odd? ;; tested - : int? ;; tested - : pos-int? ;; tested - : neg-int? ;; tested - : double? ;; tested - : string? ;; tested - : empty? ;; not tested - : not-empty ;; not tested - : eq? ;; tested - : identity ;; not tested - : comp ;; not tested - : every? ;; not tested - : some ;; not tested - : complement ;; not tested - : constantly ;; not tested - : range ;; tested - : reverse ;; not tested + (reduce -consj [] tbl))) + +(fn inc [x] (+ x 1)) +(fn dec [x] (- x 1)) + +{: apply + : seq + : first + : rest + : conj + : cons + : concat + : reduce + : reduce-kv + : mapv + : filter + : map? + : seq? + : nil? + : zero? + : pos? + : neg? + : even? + : odd? + : int? + : pos-int? + : neg-int? + : double? + : string? + : empty? + : not-empty + : eq? + : identity + : comp + : every? + : some + : complement + : constantly + : range + : reverse + : inc + : dec } diff --git a/core_test.fnl b/core_test.fnl index c75e800..6c3ba6c 100644 --- a/core_test.fnl +++ b/core_test.fnl @@ -3,45 +3,47 @@ (import-macros {: assert-eq : assert-ne : assert* : test} :test) (local - {: apply ;; not tested - : seq ;; tested - : first ;; not tested - : rest ;; not tested - : conj ;; not tested - : cons ;; not tested - : concat ;; tested - : reduce ;; tested - : reduce-kv ;; tested - : mapv ;; tested - : filter ;; tested - : map? ;; tested - : seq? ;; tested - : nil? ;; tested - : zero? ;; tested - : pos? ;; tested - : neg? ;; tested - : even? ;; tested - : odd? ;; tested - : int? ;; tested - : pos-int? ;; tested - : neg-int? ;; tested - : double? ;; tested - : string? ;; tested - : empty? ;; tested - : not-empty ;; tested - : eq? ;; tested - : identity ;; tested - : comp ;; not tested - : every? ;; tested - : some ;; tested - : complement ;; tested - : constantly ;; tested - : range ;; tested - : reverse ;; tested + {: apply + : seq + : first + : rest + : conj + : cons + : concat + : reduce + : reduce-kv + : mapv + : filter + : map? + : seq? + : nil? + : zero? + : pos? + : neg? + : even? + : odd? + : int? + : pos-int? + : neg-int? + : double? + : string? + : empty? + : not-empty + : eq? + : identity + : comp + : every? + : some + : complement + : constantly + : range + : reverse + : inc + : dec } (require :core)) -(test equality +(test eq? ;; comparing basetypes (assert-eq 1 1) (assert-ne 1 2) @@ -61,10 +63,6 @@ (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 (range 10) [0 1 2 3 4 5 6 7 8 9]) - (assert-eq (range -5 5) [-5 -4 -3 -2 -1 0 1 2 3 4]) - (assert-eq [0 0.2 0.4 0.6 0.8] [0 0.2 0.4 0.6 0.8]) - (assert-eq (range 0 1 0.2) (range 0 1 0.2)) (let [a {:a 1 :b 2} b {:a 1 :b 2}] @@ -85,6 +83,12 @@ ;; different. (assert-eq {4 1} [nil nil nil 1])) +(test range + (assert-eq (range 10) [0 1 2 3 4 5 6 7 8 9]) + (assert-eq (range -5 5) [-5 -4 -3 -2 -1 0 1 2 3 4]) + (assert-eq [0 0.2 0.4 0.6 0.8] [0 0.2 0.4 0.6 0.8]) + (assert-eq (range 0 1 0.2) (range 0 1 0.2))) + (test seq (assert-eq (seq []) nil) (assert-eq (seq {}) nil) @@ -141,30 +145,67 @@ (assert-eq (reduce plus (range 10)) (reduce- plus 0 (range 10)))) -(test predicate +;; test predicates: + +(test zero? + (assert* (zero? 0)) + (assert* (zero? -0)) + (assert* (not (zero? 1)))) + +(test int? (assert* (int? 1)) - (assert* (not (int? 1.1))) + (assert* (not (int? 1.1)))) + +(test pos? (assert* (pos? 1)) - (assert* (and (not (pos? 0)) (not (pos? -1)))) + (assert* (and (not (pos? 0)) (not (pos? -1))))) + +(test neg? (assert* (neg? -1)) - (assert* (and (not (neg? 0)) (not (neg? 1)))) + (assert* (and (not (neg? 0)) (not (neg? 1))))) + +(test pos-int? (assert* (pos-int? 42)) - (assert* (not (pos-int? 4.2))) + (assert* (not (pos-int? 4.2)))) + +(test neg-int? (assert* (neg-int? -42)) - (assert* (not (neg-int? -4.2))) - (assert* (string? :s)) + (assert* (not (neg-int? -4.2)))) + +(test string? + (assert* (string? :s))) + +(test double? (assert* (double? 3.3)) - (assert* (not (double? 3.0))) + (assert* (not (double? 3.0)))) + +(test map? (assert* (map? {:a 1})) - (assert* (not (map? {}))) + (assert* (not (map? {})))) + +(test seq? (assert* (not (seq? []))) (assert* (seq? [{:a 1}])) (assert* (not (seq? {}))) - (assert* (not (seq? {:a 1}))) + (assert* (not (seq? {:a 1})))) + +(test nil? (assert* (nil?)) (assert* (nil? nil)) (assert* (not (nil? 1)))) +(test odd? + (assert* (odd? 3)) + (assert* (odd? -3)) + (assert* (not (odd? 2))) + (assert* (not (odd? -2)))) + +(test even? + (assert* (even? 2)) + (assert* (even? -2)) + (assert* (not (even? 23))) + (assert* (not (even? -23)))) + (test filter (assert-eq (filter even? (range 10)) [0 2 4 6 8]) (assert-eq (filter odd? (range 10)) [1 3 5 7 9]) @@ -227,3 +268,40 @@ (assert-eq (not-empty "1") "1") (assert-eq (not-empty [1]) [1]) (assert-eq (not-empty {:a 1}) {:a 1})) + +(test apply + (fn* add + ([x] x) + ([x y] (+ x y)) + ([x y & zs] + (add (+ x y) ((or _G.unpack table.unpack) zs)))) + (assert-eq (apply add [1 2 3 4]) 10) + (assert-eq (apply add -1 [1 2 3 4]) 9) + (assert-eq (apply add -2 -1 [1 2 3 4]) 7) + (assert-eq (apply add -3 -2 -1 [1 2 3 4]) 4) + (assert-eq (apply add -4 -3 -2 -1 [1 2 3 4]) 0)) + +(test conj + (assert-eq (conj [] 1 2 3) [1 2 3]) + (assert-eq (conj [0] 1 2 3) [0 1 2 3]) + (assert-eq (conj {:a 1} [:b 2]) {:a 1 :b 2})) + +(test cons + (assert-eq (cons 1 []) [1]) + (assert-eq (cons 1 [0]) [1 0])) + +(test first + (assert-eq (first [1 2 3]) 1) + (assert-eq (first {:a 1}) [:a 1])) + +(test rest + (assert-eq (rest [1 2 3]) [2 3]) + (assert-eq (rest {:a 1}) [])) + +(test reduce-kv + (assert-eq (reduce-kv #(+ $1 $3) 0 {:a 1 :b 2 :c 3}) 6)) + +(test comp + (fn square [x] (* x x)) + (assert-eq ((comp square inc) 6) 49) + (assert-eq ((comp #(- $ 7) square inc inc inc inc inc inc inc) 0) 42)) diff --git a/macros/core.fnl b/macros/core.fnl index bf4dfe8..ed147ed 100644 --- a/macros/core.fnl +++ b/macros/core.fnl @@ -2,7 +2,7 @@ (local unpack (or table.unpack _G.unpack)) (local insert table.insert) -(fn check-bindings [bindings] +(fn -check-bindings [bindings] (and (assert-compile (sequence? bindings) "expected binding table" []) (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings))) @@ -10,7 +10,7 @@ ([bindings then] (if-let bindings then nil)) ([bindings then else] - (check-bindings bindings) + (-check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if tmp# @@ -20,7 +20,7 @@ (fn* when-let [bindings & body] - (check-bindings bindings) + (-check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if tmp# @@ -31,7 +31,7 @@ ([bindings then] (if-some bindings then nil)) ([bindings then else] - (check-bindings bindings) + (-check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if (= tmp# nil) @@ -41,7 +41,7 @@ (fn* when-some [bindings & body] - (check-bindings bindings) + (-check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] (if (= tmp# nil) @@ -50,15 +50,15 @@ ,(unpack body)))))) -(fn table-type [tbl] +(fn -table-type [tbl] (if (sequence? tbl) :seq (table? tbl) :table :else)) ;; based on `seq' from `core.fnl' (fn into [to from] - (local to-type (table-type to)) - (local from-type (table-type from)) + (local to-type (-table-type to)) + (local from-type (-table-type from)) `(let [to# ,to from# ,from insert# table.insert diff --git a/macros_test.fnl b/macros_test.fnl index 7d3818a..aebde2e 100644 --- a/macros_test.fnl +++ b/macros_test.fnl @@ -39,19 +39,22 @@ b []] (assert-eq (into b {:a 1}) [[:a 1]]))) -(test let-variants +(test when-let (assert-eq (when-let [a 4] a) 4) (assert* (not (when-let [a false] a)) "(not (when-let [a false] a))") - (assert* (not (when-let [a nil] a)) "(not (when-let [a nil] a))") + (assert* (not (when-let [a nil] a)) "(not (when-let [a nil] a))")) +(test when-some (assert-eq (when-some [a [1 2 3]] a) [1 2 3]) (assert-eq (when-some [a false] a) false) - (assert* (not (when-some [a nil] a)) "(when-some [a nil] a)") + (assert* (not (when-some [a nil] a)) "(when-some [a nil] a)")) +(test if-let (assert-eq (if-let [a 4] a 10) 4) (assert-eq (if-let [a false] a 10) 10) - (assert-eq (if-let [a nil] a 10) 10) + (assert-eq (if-let [a nil] a 10) 10)) +(test if-some (assert-eq (if-some [a [1 2 3]] a :nothing) [1 2 3]) (assert-eq (if-some [a false] a :nothing) false) (assert-eq (if-some [a nil] a :nothing) :nothing)) |