diff options
| -rw-r--r-- | core.fnl | 235 | ||||
| -rw-r--r-- | core_test.fnl | 121 | ||||
| -rw-r--r-- | macros/core.fnl | 6 | ||||
| -rw-r--r-- | macros/fn.fnl | 6 | ||||
| -rw-r--r-- | test.fnl | 21 |
5 files changed, 229 insertions, 160 deletions
@@ -1,22 +1,97 @@ (local insert table.insert) -(local _unpack (or table.unpack unpack)) +(local unpack (or table.unpack _G.unpack)) (import-macros {: fn*} :macros.fn) (import-macros {: when-some : if-some : when-let : into} :macros.core) (fn* apply "Apply `f' to the argument list formed by prepending intervening arguments to `args'." - ([f args] (f (_unpack args))) - ([f a args] (f a (_unpack args))) - ([f a b args] (f a b (_unpack args))) - ([f a b c args] (f a b c (_unpack args))) + ([f args] (f (unpack args))) + ([f a args] (f a (unpack args))) + ([f a b args] (f a b (unpack args))) + ([f a b c args] (f a b c (unpack args))) ([f a b c d & args] (let [flat-args []] (for [i 1 (- (length args) 1)] (insert flat-args (. args i))) (each [_ a (ipairs (. args (length args)))] (insert flat-args a)) - (f a b c d (_unpack flat-args))))) + (f a b c d (unpack flat-args))))) + +;; predicate functions + +(fn map? [tbl] + "Check whether `tbl' is an associative table." + (if (= (type tbl) :table) + (let [(k _) (next tbl)] + (and (~= k nil) (or (~= (type k) :number) + (~= k 1)))))) + +(fn seq? [tbl] + "Check whether `tbl' is an sequential table." + (if (= (type tbl) :table) + (let [(k _) (next tbl)] + (and (~= k nil) (= (type k) :number) (= k 1))))) + +(fn nil? [x] + "Test if value is nil." + (= x nil)) + +(fn zero? [x] + "Test if value is zero." + (= x 0)) + +(fn pos? [x] + "Test if `x' is greater than zero." + (> x 0)) + +(fn neg? [x] + "Test if `x' is less than zero." + (< x 0)) + +(fn even? [x] + "Test if value is even." + (= (% x 2) 0)) + +(fn odd? [x] + "Test if value is odd." + (not (even? x))) + +(fn string? [x] + "Test if `x' is a string." + (= (type x) :string)) + +(fn int? [x] + "Test if `x' is a number without floating point data." + (and (= (type x) :number) + (= x (math.floor x)))) + +(fn pos-int? [x] + "Test if `x' is a positive integer." + (and (int? x) + (pos? x))) + +(fn neg-int? [x] + "Test if `x' is a negetive integer." + (and (int? x) + (neg? x))) + +(fn double? [x] + "Test if `x' is a number with floating point data." + (and (= (type x) :number) + (~= x (math.floor x)))) + +(fn empty? [x] + "Check if collection is empty." + (match (type x) + :table (= (next x) nil) + :string (= x "") + _ (error "empty?: unsupported collection"))) + +(fn not-empty [x] + "If `x' is empty, returns `nil', otherwise `x'." + (if (not (empty? x)) + x)) ;; sequence manipulating functions @@ -37,6 +112,7 @@ If `tbl' is sequential table, leaves it unchanged." (if assoc? res tbl)))) (macro -safe-seq [tbl] + "Create sequential table, or empty table if `seq' returned `nil'." `(or (seq ,tbl) [])) (fn first [tbl] @@ -47,15 +123,20 @@ If `tbl' is sequential table, leaves it unchanged." (fn rest [tbl] "Returns table of all elements of indexed table but the first one." (if-some [tbl tbl] - [(_unpack (seq tbl) 2)] + [(unpack (seq tbl) 2)] [])) (fn* conj "Insert `x' as a last element of indexed table `tbl'. Modifies `tbl'" ([] []) ([tbl] tbl) - ([tbl x] (when-some [x x] - (doto tbl (insert x)))) + ([tbl x] + (when-some [x x] + (let [tbl (or tbl [])] + (if (map? tbl) + (tset tbl (. x 1) (. x 2)) + (insert tbl x)) + tbl))) ([tbl x & xs] (if (> (length xs) 0) (let [[y & xs] xs] (apply conj (conj tbl x) y xs)) @@ -65,8 +146,9 @@ If `tbl' is sequential table, leaves it unchanged." "Like conj but joins at the front. Modifies `tbl'." ([] []) ([tbl] tbl) - ([tbl x] (when-some [x x] - (doto tbl (insert 1 x)))) + ([tbl x] + (when-some [x x] + (doto tbl (insert 1 x)))) ([tbl x & xs] (if (> (length xs) 0) (let [[y & xs] xs] (apply consj (consj tbl x) y xs)) @@ -75,7 +157,7 @@ If `tbl' is sequential table, leaves it unchanged." (fn cons [x tbl] "Insert `x' to `tbl' at the front. Modifies `tbl'." (when-some [x x] - (doto (or tbl []) + (doto (-safe-seq tbl) (insert 1 x)))) (fn* concat @@ -194,64 +276,6 @@ ignored. Returns a table of results." (cons f (filter pred r)) (filter pred r))))) - -;; predicate functions - -(fn map? [tbl] - "Check whether `tbl' is an associative table." - (if (= (type tbl) :table) - (let [(k _) (next tbl)] - (and (~= k nil) (or (~= (type k) :number) - (~= k 1)))))) - -(fn seq? [tbl] - "Check whether `tbl' is an sequential table." - (if (= (type tbl) :table) - (let [(k _) (next tbl)] - (and (~= k nil) (= (type k) :number) (= k 1))))) - -(fn nil? [x] - "Test if value is nil." - (= x nil)) - -(fn zero? [x] - "Test if value is zero." - (= x 0)) - -(fn pos? [x] - "Test if `x' is greater than zero." - (> x 0)) - -(fn neg? [x] - "Test if `x' is less than zero." - (< x 0)) - -(fn even? [x] - "Test if value is even." - (= (% x 2) 0)) - -(fn odd? [x] - "Test if value is odd." - (not (even? x))) - -(fn string? [x] - "Test if `x' is a string." - (= (type x) :string)) - -(fn int? [x] - (= x (math.floor x))) - -(fn pos-int? [x] - (and (int? x) - (pos? x))) - -(fn neg-int? [x] - (and (int? x) - (neg? x))) - -(fn double? [x] - (not (int? x))) - (fn -kvseq [tbl] "Transforms any table kind to key-value sequence." (let [res []] @@ -287,7 +311,7 @@ ignored. Returns a table of results." (fn* every? [pred tbl] - (if (= 0 (length tbl)) true + (if (empty? tbl) true (pred (first tbl)) (every? pred (rest tbl)) false)) @@ -326,36 +350,39 @@ oppisite truth value." (when-some [tbl (seq tbl)] (reduce consj [] tbl))) -{: 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? - : eq? - : identity - : comp - : every? - : some - : complement - : constantly - : range - : reverse} +{: 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 + } diff --git a/core_test.fnl b/core_test.fnl index e5fbc22..c75e800 100644 --- a/core_test.fnl +++ b/core_test.fnl @@ -2,40 +2,44 @@ (import-macros {: into} :macros.core) (import-macros {: assert-eq : assert-ne : assert* : test} :test) -(local {: 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? - : eq? - : identity - : comp - : every? - : some - : complement - : constantly - : range - : reverse} - (require :core)) +(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 + } + (require :core)) (test equality ;; comparing basetypes @@ -174,3 +178,52 @@ (assert-eq (concat [1 2 3] [4 5 6]) [1 2 3 4 5 6]) (assert-eq (concat [1 2] [3 4] [5 6]) [1 2 3 4 5 6]) (assert-eq (concat {:a 1} {:b 2}) [[:a 1] [:b 2]])) + +(test reverse + (assert-eq (reverse [1 2 3]) [3 2 1]) + (assert-eq (reverse {:a 1}) [[:a 1]])) + +(test constantly + (let [always-nil (constantly nil)] + (assert-eq (always-nil) nil) + (assert-eq (always-nil 1) nil) + (assert-eq (always-nil 1 2 3 4 "5") nil)) + + (let [always-true (constantly true)] + (assert* (always-true)) + (assert* (always-true false)))) + +(test complement + (assert* ((complement nil?) 10))) + +(test some + (assert* (some pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) + (assert* (not (some pos-int? {:a 1}))) + (assert* (some pos-int? [{:a 1} "1" -1 1]))) + +(test every? + (assert* (not (every? pos-int? [-1 1.1 2.3 -5.5 42 10 -27]))) + (assert* (not (every? pos-int? {:a 1}))) + (assert* (every? pos-int? [1 2 3 4 5]))) + +(test identity + (assert-eq (identity 1) 1) + (assert-eq (identity {:a 1 :b 2}) {:a 1 :b 2}) + (assert-eq (identity [1 2 3]) [1 2 3]) + (assert-eq (identity "abc") "abc")) + +(test empty? + (assert* (empty? [])) + (assert* (empty? {})) + (assert* (empty? "")) + (assert* (not (empty? "1"))) + (assert* (not (empty? [1]))) + (assert* (not (empty? {:a 1})))) + +(test not-empty + (assert-eq (not-empty []) nil) + (assert-eq (not-empty {}) nil) + (assert-eq (not-empty "") nil) + (assert-eq (not-empty "1") "1") + (assert-eq (not-empty [1]) [1]) + (assert-eq (not-empty {:a 1}) {:a 1})) diff --git a/macros/core.fnl b/macros/core.fnl index a53eced..bf4dfe8 100644 --- a/macros/core.fnl +++ b/macros/core.fnl @@ -1,5 +1,5 @@ (import-macros {: fn*} :macros.fn) -(local _unpack (or table.unpack unpack)) +(local unpack (or table.unpack _G.unpack)) (local insert table.insert) (fn check-bindings [bindings] @@ -25,7 +25,7 @@ `(let [tmp# ,test] (if tmp# (let [,form tmp#] - ,(_unpack body)))))) + ,(unpack body)))))) (fn* if-some ([bindings then] @@ -47,7 +47,7 @@ (if (= tmp# nil) nil (let [,form tmp#] - ,(_unpack body)))))) + ,(unpack body)))))) (fn table-type [tbl] diff --git a/macros/fn.fnl b/macros/fn.fnl index cada324..cdd3636 100644 --- a/macros/fn.fnl +++ b/macros/fn.fnl @@ -1,4 +1,4 @@ -(local _unpack (or table.unpack unpack)) +(local unpack (or table.unpack _G.unpack)) (local insert table.insert) (fn string? [x] @@ -28,7 +28,7 @@ * Try adding function parameters as a list of identifiers in brackets." args) (values (length args) - (list 'let [args ['...]] (list 'do (_unpack body))) + (list 'let [args ['...]] (list 'do (unpack body))) (has-amp? args))) (fn arity-dispatcher [len fixed body& name] @@ -73,7 +73,7 @@ ;; Produces arglist and body for single-arity function. ;; For more info check `gen-arity' documentation. (let [[args & body] args - (arity body amp) (gen-arity [args (_unpack body)])] + (arity body amp) (gen-arity [args (unpack body)])] `(let [len# (select :# ...)] ,(arity-dispatcher 'len# @@ -1,10 +1,9 @@ (import-macros {: fn*} :macros.fn) - ;; requires `eq?' from core.fnl to be available at runtime (fn* assert-eq ([expr1 expr2] - (assert-eq expr1 expr2 'nil)) + (assert-eq expr1 expr2 nil)) ([expr1 expr2 msg] `(let [left# ,expr1 right# ,expr2 @@ -15,7 +14,7 @@ (fn* assert-ne ([expr1 expr2] - (assert-ne expr1 expr2 'nil)) + (assert-ne expr1 expr2 nil)) ([expr1 expr2 msg] `(let [left# ,expr1 right# ,expr2 @@ -24,29 +23,19 @@ Left: " (view# left#) " Right: " (view# right#) "\n")))))) -(fn walk-tree [root f custom-iterator] - "Walks a tree (like the AST), invoking f(node, idx, parent) on each node. -When f returns a truthy value, recursively walks the children." - (fn walk [iterfn parent idx node] - (when (f idx node parent) - (each [k v (iterfn node)] - (walk iterfn node k v)))) - (walk (or custom-iterator pairs) nil nil root) - root) - (fn* assert* ([expr] - (assert* expr 'nil)) + (assert* expr nil)) ([expr msg] `(assert ,expr (.. "assertion failed for " (or ,msg ,(tostring expr)))))) (fn* test - ;"define test function, print its name and run it." + "Define test function, print its name and run it." [name docstring & body] (let [test-name (sym (.. (tostring name) "-test"))] `(do (fn ,test-name [] ,(or docstring nil) - ((or table.unpack unpack) ,body)) + ,((or table.unpack _G.unpack) body)) (io.stderr:write (.. "running: " ,(tostring test-name) "\n")) (,test-name)))) |