feature: refactoring

5 files changed, 229 insertions, 160 deletions

diff --git a/core.fnl b/core.fnl
index bf7c7b4..2013926 100644
--- a/core.fnl
+++ b/core.fnl
@@ -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#
diff --git a/test.fnl b/test.fnl
index a07eff9..da25c26 100644
--- a/test.fnl
+++ b/test.fnl
@@ -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))))