summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el3
-rw-r--r--README.org62
-rw-r--r--core.fnl123
-rw-r--r--core_test.fnl137
-rw-r--r--macros/core.fnl95
-rw-r--r--macros_test.fnl99
-rw-r--r--test.fnl39
7 files changed, 333 insertions, 225 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index e0d3e5a..8ad1001 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,7 +1,8 @@
;;; Directory Local Variables
;;; For more information see (info "(emacs) Directory Variables")
-((fennel-mode . ((eval . (put 'when-some 'fennel-indent-function 1))
+((fennel-mode . ((eval . (put 'test 'fennel-indent-function 'defun))
+ (eval . (put 'when-some 'fennel-indent-function 1))
(eval . (put 'if-some 'fennel-indent-function 1))
(eval . (put 'when-let 'fennel-indent-function 1))
(eval . (put 'if-let 'fennel-indent-function 1))
diff --git a/README.org b/README.org
index 0937797..19c2849 100644
--- a/README.org
+++ b/README.org
@@ -18,7 +18,7 @@ Capable of producing multi-arity functions:
#+begin_src fennel
(fn* square "square number" [x] (^ x 2))
- (square 9) ;; 81
+ (square 9) ;; 81.0
(square 1 2) ;; error
(fn* range
@@ -29,7 +29,7 @@ Capable of producing multi-arity functions:
([lower upper] (range lower upper 1))
([lower upper step]
(let [res []]
- (for [i lower (- upper 1) step]
+ (for [i lower (- upper step) step]
(table.insert res i))
res)))
@@ -41,13 +41,14 @@ Capable of producing multi-arity functions:
;; [0.0 0.2 0.4 0.6 0.8]
;; both variants support up to one arity with & more:
- (fn* list [& xs] xs)
+ (fn* vec [& xs] xs)
- (list 1 2 3)
+ (vec 1 2 3)
;; [1 2 3]
#+end_src
See =core.fnl= for more examples.
+
*** =if-let= and =when-let=
When test expression is not =nil= or =false=, evaluates the first body form with the =name= bound to the result of the expressions.
@@ -103,14 +104,44 @@ However we can do this at compile time.
;; [1 2 3 4 5 6]
(into [] {:a 1 :b 2 :c 3 :d 4})
- ;; [["a" 1] ["b" 2] ["c" 3] ["d" 4]]
+ ;; [["d" 4] ["a" 1] ["b" 2] ["c" 3]]
- (into {} [[:a 1] [:b 2] [:c 3] [:d 4]])
+ (into {} [[:d 4] [:a 1] [:b 2] [:c 3]])
;; {:a 1 :b 2 :c 3 :d 4}
(into {:a 0 :e 5} {:a 1 :b 2 :c 3 :d 4})
;; {:a 1 :b 2 :c 3 :d 4 :e 5}
#+end_src
+
+Because the type check at compile time it will only respect the type when literal representation is used.
+If a variable holding the table, it's type checked at runtime.
+Empty tables default to sequential ones:
+
+#+begin_src fennel
+ (local a [])
+ (into a {:a 1 :b 2})
+ ;; [["b" 2] ["a" 1]]
+
+ (local b {})
+ (into b {:a 1 :b 2})
+ ;; [["b" 2] ["a" 1]]
+#+end_src
+
+However, if target table is not empty, it's type can be deduced:
+
+#+begin_src fennel
+ (local a {:c 3})
+ (into a {:a 1 :b 2})
+ ;; {:a 1 :b 2 :c 3}
+
+ (local b [1])
+ (into b {:a 1 :b 2})
+ ;; [1 ["b" 2] ["a" 1]]
+#+end_src
+
+Note that when converting associative table into sequential table order is determined by the =pairs= function.
+Also note that if variable stores the table has both integer key 1, and other associative keys, the type will be the same as of sequential table.
+
** Functions
Here are some important functions from the library.
Full set can be examined by requiring the module.
@@ -124,14 +155,14 @@ Works mostly like in Clojure, but, since Fennel doesn't have list object, it alw
;; [1 2 3 4 5]
(seq {:a 1 :b 2 :c 3 :d 4})
- ;; [["a" 1] ["b" 2] ["c" 3] ["d" 4]]
+ ;; [["d" 4] ["a" 1] ["b" 2] ["c" 3]]
#+end_src
See [[*=into=][=into=]] on how to transform such sequence back into associative table.
*** =first= and =rest=
=first= returns first value of a table.
-It call =seq= on it, so this takes linear time for any table.
+It call =seq= on it, so this takes linear time for any kind of table.
As a consequence, associative tables are supported:
#+begin_src fennel
@@ -153,6 +184,8 @@ It also calls =seq= on it's argument.
;; [["port" 2344] ["options" {}]]
#+end_src
+These functions are expensive, therefore should be avoided when table type is known beforehand.
+
*** =conj= and =cons=
Append and prepend item to the table.
Unlike Clojure, =conj=, and =cons= modify table passed to these functions.
@@ -186,13 +219,10 @@ As an example, here's a classic map function:
=col= is not modified by the =map= function described above, but the =[]= table in the =else= branch of =is-some= is eventually modified by the stack of calls to =cons=.
However this library provides more efficient versions of map, that support arbitrary amount of tables.
-*** =mapv= and =mapkv=
-Mapping functions.
+*** =mapv=
+Mapping function over table.
In Clojure we have a =seq= abstraction, that allows us to use single =mapv= on both vectors, and hash tables.
-However in Fennel, and Lua there's no efficient way of checking if we got an associative or indexed table.
-For this reason, there are two functions - =mapv=, or which maps over vectors, and =mapkv= which maps over associative tables (=kv= is for key-value).
-Here, =mapv= works the same as =mapv= from Clojure, except it doesn't yield a transducer (yet?) when only function is supplied.
-=mapkv= also works similarly, except it requires for function you pass to accept twice the amount of tables you pass to =mapkv=.
+In this library the =seq= function is implemented in a similar way, so you can expect =mapv= to behave similarly to Clojure:
#+begin_src fennel
(fn cube [x] (* x x x))
@@ -211,8 +241,8 @@ Here, =mapv= works the same as =mapv= from Clojure, except it doesn't yield a tr
;; ["Bob Smith works as secretary at Happy Days co."
;; "Alice Watson works as chief officer at Coffee With You"]
- (mapkv (fn [k v] [k v]) {:host "localhost" :port 1344})
- ;; [["port" 1344] ["host" "localhost"]]
+ (mapv (fn [[k v]] [(string.upper k) v]) {:host "localhost" :port 1344})
+ ;; [["HOST" "localhost"] ["PORT" 1344]]
#+end_src
*** =reduce= and =reduce-kv=
diff --git a/core.fnl b/core.fnl
index eba11d6..7895671 100644
--- a/core.fnl
+++ b/core.fnl
@@ -24,7 +24,7 @@ If `tbl' is sequential table, leaves it unchanged."
(fn rest [itbl]
"Returns table of all elements of indexed table but the first one."
- [(_unpack itbl 2)])
+ [(_unpack (seq itbl) 2)])
(fn* conj
@@ -71,12 +71,13 @@ of applying f to val and the first item in coll, then applying f to
that result and the 2nd item, etc. If coll contains no items, returns
val and f is not called."
([f itbl]
- (match (length itbl)
- 0 (f)
- 1 (. itbl 1)
- 2 (f (. itbl 1) (. itbl 2))
- _ (let [[a b & rest] itbl]
- (reduce f (f a b) rest))))
+ (let [itbl (seq itbl)]
+ (match (length itbl)
+ 0 (f)
+ 1 (. itbl 1)
+ 2 (f (. itbl 1) (. itbl 2))
+ _ (let [[a b & rest] itbl]
+ (reduce f (f a b) rest)))))
([f val [x & xs]]
(if (not (= x nil))
(reduce f (f val x) xs)
@@ -94,82 +95,66 @@ contains no entries, returns `val' and `f' is not called. Note that
reduce-kv is supported on vectors, where the keys will be the
ordinals." [f val kvtbl]
(var res val)
- (each [k v (pairs kvtbl)]
+ (each [_ [k v] (pairs (seq kvtbl))]
(set res (f res k v)))
res)
(fn* mapv
- "Maps function `f' over indexed tables.
-
-Accepts arbitrary amount of tables. Function `f' must take the same
-amount of parameters as the amount of tables passed to `mapv'. Applies
-`f' over first value of each table. Then applies `f' to second value
-of each table. Continues until any of the tables is exhausted. All
-remaining values are ignored. Returns a table of results. "
+ "Maps function `f' over one or more tables.
+
+Accepts arbitrary amount of tables, calls `seq' on each of it.
+Function `f' must take the same amount of parameters as the amount of
+tables passed to `mapv'. Applies `f' over first value of each
+table. Then applies `f' to second value of each table. Continues until
+any of the tables is exhausted. All remaining values are
+ignored. Returns a table of results."
([f itbl]
(local res [])
- (each [_ v (ipairs itbl)]
+ (each [_ v (ipairs (seq itbl))]
(insert res (f v)))
res)
([f t1 t2]
- (local res [])
- (var (i1 v1) (next t1))
- (var (i2 v2) (next t2))
- (while (and i1 i2)
- (insert res (f v1 v2))
- (set (i1 v1) (next t1 i1))
- (set (i2 v2) (next t2 i2)))
- res)
+ (let [res []
+ t1 (seq t1)
+ t2 (seq t2)]
+ (var (i1 v1) (next t1))
+ (var (i2 v2) (next t2))
+ (while (and i1 i2)
+ (insert res (f v1 v2))
+ (set (i1 v1) (next t1 i1))
+ (set (i2 v2) (next t2 i2)))
+ res))
([f t1 t2 t3]
- (local res [])
- (var (i1 v1) (next t1))
- (var (i2 v2) (next t2))
- (var (i3 v3) (next t3))
- (while (and i1 i2 i3)
- (insert res (f v1 v2 v3))
- (set (i1 v1) (next t1 i1))
- (set (i2 v2) (next t2 i2))
- (set (i3 v3) (next t3 i3)))
- res)
+ (let [res []
+ t1 (seq t1)
+ t2 (seq t2)
+ t3 (seq t3)]
+ (var (i1 v1) (next t1))
+ (var (i2 v2) (next t2))
+ (var (i3 v3) (next t3))
+ (while (and i1 i2 i3)
+ (insert res (f v1 v2 v3))
+ (set (i1 v1) (next t1 i1))
+ (set (i2 v2) (next t2 i2))
+ (set (i3 v3) (next t3 i3)))
+ res))
([f t1 t2 t3 & tbls]
(let [step (fn step [tbls]
(when (->> tbls
- (mapv #(if (next $) true false))
+ (mapv #(~= (next $) nil))
(reduce #(and $1 $2)))
- (cons (mapv first tbls) (step (mapv rest tbls)))))
+ (cons (mapv #(first (seq $)) tbls) (step (mapv rest tbls)))))
res []]
(each [_ v (ipairs (step (consj tbls t3 t2 t1)))]
(insert res (f (_unpack v))))
res)))
-
(fn kvseq [kvtbl]
(let [res []]
(each [k v (pairs kvtbl)]
(insert res [k v]))
res))
-
-(fn* mapkv
- "Maps function `f' over one or more associative tables.
-
-`f' should be a function of 2 arguments. If more than one table
-supplied, `f' must take double the table amount of arguments. Returns
-indexed table of results. Order of results depends on the order
-returned by the `pairs' function. If you want consistent results, consider
-sorting tables first."
- ([f kvtbl]
- (let [res []]
- (each [k v (pairs kvtbl)]
- (insert res (f k v)))
- res))
- ([f kvtbl & kvtbls]
- (local itbls [(kvseq kvtbl)])
- (each [_ t (ipairs kvtbls)]
- (insert itbls (kvseq t)))
- (mapv f (_unpack itbls))))
-
-
(fn* eq?
"Deep compare values."
([x] true)
@@ -203,14 +188,23 @@ sorting tables first."
(pred (first itbl)) (every? pred (rest itbl))
false))
-(fn* some
- [pred itbl]
- (if (> (length itbl) 0)
- ))
+;; (fn* some
+;; [pred itbl]
+;; (if (> (length itbl) 0)
+;; ))
+
+(fn* range
+ "return range of of numbers from `lower' to `upper' with optional `step'."
+ ([upper] (range 0 upper 1))
+ ([lower upper] (range lower upper 1))
+ ([lower upper step]
+ (let [res []]
+ (for [i lower (- upper step) step]
+ (table.insert res i))
+ res)))
{: seq
: mapv
- : mapkv
: reduce
: reduce-kv
: conj
@@ -220,4 +214,5 @@ sorting tables first."
: eq?
: identity
: comp
- : every?}
+ : every?
+ : range}
diff --git a/core_test.fnl b/core_test.fnl
index a7e981a..673b007 100644
--- a/core_test.fnl
+++ b/core_test.fnl
@@ -1,51 +1,88 @@
(import-macros {: fn*} :macros.fn)
-(import-macros {: assert-eq : assert-ne : assert*} :test)
-
-(local {: seq
- : mapv
- : mapkv
- : reduce
- : reduce-kv
- : conj
- : cons
- : consj
- : first
- : rest
- : eq?
- : identity
- : comp
- : every?} (require :core))
-
-;; comparing basetypes
-(assert-eq 1 1)
-(assert-ne 1 2)
-(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"))
-
-;; deep comparison
-(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]]])))
-
-(fn* range
- ([upper] (range 0 upper 1))
- ([lower upper] (range lower upper 1))
- ([lower upper step]
- (let [res []]
- (for [i lower (- upper step) step]
- (table.insert res i))
- res)))
-
-(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))
+(import-macros {: into} :macros.core)
+(import-macros {: assert-eq : assert-ne : assert* : test} :test)
+
+(local {: seq : mapv : mapkv : reduce : reduce-kv : conj : cons : consj : first : rest : eq? : identity : comp : every? : range} (require :core))
+
+(test equality-test
+ ;; comparing basetypes
+ (assert-eq 1 1)
+ (assert-ne 1 2)
+ (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"))
+
+ ;; deep comparison
+ (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 (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}]
+ (table.insert b 10)
+ (assert-ne a b))
+
+ (let [a [1 2 3]
+ b [1 2 3]]
+ (tset b :a 10)
+ (assert-ne a b))
+
+ (assert-eq [1 2 3] {1 1 2 2 3 3})
+
+ ;; TODO: decide if this is right or not. Looking from `seq'
+ ;; perspective, it is correct, as `(seq {4 1})' and `(seq [nil nil
+ ;; nil 1])' both yield `{4 1}'. From Lua's point this is not the
+ ;; same thing, for example because the sizes of these tables are
+ ;; different.
+ (assert-eq {4 1} [nil nil nil 1]))
+
+(test mapv-test
+ (assert-eq (mapv #(* $ $) [1 2 3 4]) [1 4 9 16])
+
+ (assert-eq (into {} (mapv (fn [[k v]] [k (* v v)]) {:a 1 :b 2 :c 3}))
+ (into {} [[:a 1] [:b 4] [:c 9]]))
+
+ (assert-eq (into {} (mapv (fn [[k1 v1] [k2 v2]] [k1 (* v1 v2)])
+ {:a 1 :b 2 :c 3}
+ {:a -1 :b 0 :c 2}))
+ {:a -1 :b 0 :c 6})
+ (assert-eq (mapv string.upper ["a" "b" "c"]) ["A" "B" "C"])
+ (assert-eq (mapv #(+ $1 $2 $3 $4) [1 -1] [2 -2] [3 -3] [4 -4]) [(+ 1 2 3 4) (+ -1 -2 -3 -4)])
+ (assert-eq (mapv (fn [f-name s-name company position]
+ (.. f-name " " s-name " works as " position " at " company))
+ ["Bob" "Alice"]
+ ["Smith" "Watson"]
+ ["Happy Days co." "Coffee With You"]
+ ["secretary" "chief officer"])
+ ["Bob Smith works as secretary at Happy Days co."
+ "Alice Watson works as chief officer at Coffee With You"]))
+
+(test reduce-test
+ (fn ++ [a b] (+ a b))
+ (assert-eq (reduce ++ (range 10)) 45)
+ (assert-eq (reduce ++ -3 (range 10)) 42)
+
+
+ (fn mapping [f]
+ (fn [reducing]
+ (fn [result input]
+ (reducing result (f input)))))
+
+ (fn reduce- [f init tbl]
+ (if (and tbl (> (length tbl) 0))
+ (reduce f (f init (first tbl)) (rest tbl))
+ init))
+
+ (assert-eq (reduce ++ (range 10)) (reduce- ++ 0 (range 10))))
diff --git a/macros/core.fnl b/macros/core.fnl
index deb363a..9b01b70 100644
--- a/macros/core.fnl
+++ b/macros/core.fnl
@@ -50,50 +50,61 @@
,(_unpack body))))))
+(fn table-type [tbl]
+ (if (sequence? tbl) :seq
+ (table? tbl) :table
+ :else))
+
;; based on `seq' from `core.fnl'
(fn into [to from]
- (if (sequence? to)
- `(let [to# ,to
- from# ,from
- insert# table.insert
- unpack# (or table.unpack unpack)
- res# []]
- (var assoc# false)
- (each [k# v# (pairs from#)]
- (if (and (not assoc#)
- (not (= (type k#) "number")))
- (set assoc# true))
- (insert# res# [k# v#]))
- (let [res# (if assoc# res# from#)]
- (if (~= (next to#) nil)
- (do (when (~= (next res#) nil)
- (each [_# v# (ipairs res#)]
- (insert# to# v#)))
- to#)
- res#)))
- ;; to support (into {} {}) we first need transform `from' into a
- ;; sequential table. Unfortunately it seems impossible to do
- ;; this with `(into [] ,from)' call, as it results in infinity
- ;; compilation loop. Because of that the body of previous
- ;; branch is repeated here almost entirely, although without
- ;; some extra checks, as these aren't necessary in this case.
- (table? to)
- `(let [to# ,to
- from# (let [from# ,from
- insert# table.insert
- unpack# (or table.unpack unpack)
- res# []]
- (var assoc# false)
- (each [k# v# (pairs from#)]
- (if (and (not assoc#)
- (not (= (type k#) "number")))
- (set assoc# true))
- (insert# res# [k# v#]))
- (if assoc# res# from#))]
- (each [_# [k# v#] (ipairs from#)]
- (tset to# k# v#))
- to#)
- `(error "expected table as the first argument" 2)))
+ (local to-type (table-type to))
+ (local from-type (table-type from))
+ `(let [to# ,to
+ from# ,from
+ insert# table.insert
+ table-type# (fn [tbl#]
+ (let [t# (type tbl#)]
+ (if (= t# :table)
+ (let [(k# _#) (next tbl#)]
+ (if (and (= (type k#) :number) (= k# 1)) :seq
+ (= k# nil) :empty
+ :table))
+ :else)))
+ seq# (fn [tbl#]
+ (var assoc# false)
+ (let [res# []]
+ (each [k# v# (pairs tbl#)]
+ (if (and (not assoc#)
+ (not (= (type k#) :number)))
+ (set assoc# true))
+ (insert# res# [k# v#]))
+ (if assoc# res# tbl#)))
+ to-type# ,to-type
+ to-type# (if (= to-type# :else)
+ (table-type# to#)
+ to-type#)
+ from-type# ,from-type
+ from-type# (if (= from-type# :else)
+ (table-type# from#)
+ from-type#)]
+ (match to-type#
+ :seq (do (each [_# v# (ipairs (seq# from#))]
+ (insert# to# v#)))
+ :table (match from-type#
+ :seq (each [_# [k# v#] (ipairs from#)]
+ (tset to# k# v#))
+ :table (each [k# v# (pairs from#)]
+ (tset to# k# v#))
+ :empty to#
+ :else (error "expected table as second argument"))
+ ;; If we could not deduce type, it means that
+ ;; we've got empty table. We use will default
+ ;; to sequential table, because it will never
+ ;; break when converting into
+ :empty (do (each [_# v# (ipairs (seq# from#))]
+ (insert# to# v#)))
+ :else (error "expected table as first argument"))
+ to#))
{: if-let
: when-let
diff --git a/macros_test.fnl b/macros_test.fnl
index 422f282..349be1b 100644
--- a/macros_test.fnl
+++ b/macros_test.fnl
@@ -1,44 +1,57 @@
(import-macros {: if-let : when-let : if-some : when-some : into} :macros.core)
-(import-macros {: assert-eq : assert-ne : assert*} :test)
-(local {: eq?} (require :core))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;; into ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(assert-eq (into [] []) [])
-(assert-eq (into [1 2 3] []) [1 2 3])
-(assert-eq (into [1 2 3] [4 5 6]) [1 2 3 4 5 6])
-
-(assert-eq (into {} {}) {})
-(assert-eq (into {:a 1} {}) {:a 1})
-(assert-eq (into {:a 1} {:b 2}) {:a 1 :b 2})
-
-(assert-eq (into [] {}) []) ;; different bodies are being used so worth testing
-(assert-eq (into {} []) [])
-
-;; can't transform table with more than one key-value pair, as order
-;; is undeterminitive
-(assert-eq (into [] {:a 1}) [[:a 1]])
-(assert-eq (into [[:b 2]] {:a 1}) [[:b 2] [:a 1]])
-(assert-eq (into [[:c 3]] {}) [[:c 3]])
-
-(assert-eq (into {} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3})
-(assert-eq (into {:d 4} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3 :d 4})
-(assert-eq (into {:a 0 :b 0 :c 0} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3})
-
-;;;;;;;;;;;;;;;;;;;;;;; let variants ;;;;;;;;;;;;;;;;;;;;;;;;
-
-(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-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-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-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)
+(import-macros {: assert-eq : assert-ne : assert* : test} :test)
+(local {: eq?} (require :core)) ;; required for testing
+
+
+(test into-test
+ (assert-eq (into [] []) [])
+ (assert-eq (into [1 2 3] []) [1 2 3])
+ (assert-eq (into [1 2 3] [4 5 6]) [1 2 3 4 5 6])
+
+ (assert-eq (into {} {}) {})
+ (assert-eq (into {:a 1} {}) {:a 1})
+ (assert-eq (into {:a 1} {:b 2}) {:a 1 :b 2})
+
+ ;; different bodies are being used so worth testing
+ (assert-eq (into [] {}) [])
+ (assert-eq (into {} []) [])
+
+ ;; can't transform table with more than one key-value pair, as order
+ ;; is undeterminitive
+ (assert-eq (into [] {:a 1}) [[:a 1]])
+ (assert-eq (into [[:b 2]] {:a 1}) [[:b 2] [:a 1]])
+ (assert-eq (into [[:c 3]] {}) [[:c 3]])
+
+ (assert-eq (into {} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3})
+ (assert-eq (into {:d 4} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3 :d 4})
+ (assert-eq (into {:a 0 :b 0 :c 0} [[:c 3] [:a 1] [:b 2]]) {:a 1 :b 2 :c 3})
+
+ (let [a (fn [] {:a 1})
+ b (fn [] [[:b 2]])]
+ (assert-eq (into (a) (b)) {:a 1 :b 2})
+ (assert-eq (into (b) (a)) [[:b 2] [:a 1]]))
+
+ (let [a {}
+ b []]
+ (assert-eq (into a [1 2 3]) [1 2 3])
+ (assert-eq (into b [1 2 3]) [1 2 3]))
+ (let [a {}
+ b []]
+ (assert-eq (into b {:a 1}) [[:a 1]])))
+
+(test let-variants
+ (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-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-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-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))
diff --git a/test.fnl b/test.fnl
index cb26858..050dd85 100644
--- a/test.fnl
+++ b/test.fnl
@@ -1,24 +1,45 @@
+(import-macros {: fn*} :macros.fn)
+
;; requires `eq?' from core.fnl to be available at runtime
-(fn assert-eq [expr1 expr2 msg]
+(fn* assert-eq
+ ([expr1 expr2]
+ (assert-eq expr1 expr2 'nil))
+ ([expr1 expr2 msg]
`(let [left# ,expr1
right# ,expr2
view# (require :fennelview)]
(assert (eq? left# right#) (or ,msg (.. "equality assertion failed
- Left: " (view# ,expr1) "
- Right: " (view# ,expr2) "\n")))))
+ Left: " (view# left#) "
+ Right: " (view# right#) "\n"))))))
-(fn assert-ne [expr1 expr2 msg]
+(fn* assert-ne
+ ([expr1 expr2]
+ (assert-ne expr1 expr2 'nil))
+ ([expr1 expr2 msg]
`(let [left# ,expr1
right# ,expr2
view# (require :fennelview)]
(assert (not (eq? left# right#)) (or ,msg (.. "unequality assertion failed
- Left: " (view# ,expr1) "
- Right: " (view# ,expr2) "\n")))))
+ Left: " (view# left#) "
+ Right: " (view# right#) "\n"))))))
+
+(fn* assert*
+ ([expr]
+ (assert* expr 'nil))
+ ([expr msg]
+ `(assert ,expr (.. "assertion failed for " (or ,msg ,(tostring expr))))))
-(fn assert* [expr msg]
- `(assert ,expr (.. "assertion failed for " ,(or msg (tostring expr)))))
+(fn* test
+ ;"define test function, print its name and run it."
+ [name docstring & body]
+ `(do (fn ,name []
+ ,(or docstring nil)
+ ((or table.unpack unpack) ,body))
+ (io.stderr:write (.. "running: " ,(tostring name) "\n"))
+ (,name)))
{: assert-eq
: assert-ne
- : assert*}
+ : assert*
+ : test}