diff options
| -rw-r--r-- | Makefile | 15 | ||||
| -rw-r--r-- | cljlib-macros.fnl | 143 | ||||
| -rw-r--r-- | cljlib.fnl | 702 | ||||
| -rw-r--r-- | doc/cljlib-macros.md | 2 | ||||
| -rw-r--r-- | doc/cljlib.md | 159 | ||||
| -rw-r--r-- | tests/core.fnl | 229 | ||||
| -rw-r--r-- | tests/macros.fnl | 16 | ||||
| -rw-r--r-- | tests/test.fnl | 6 |
8 files changed, 888 insertions, 384 deletions
@@ -5,9 +5,9 @@ LUASOURCES = $(FNLSOURCES:.fnl=.lua) FNLTESTS = tests/fn.fnl tests/macros.fnl tests/core.fnl LUATESTS = $(FNLTESTS:.fnl=.lua) -.PHONY: all clean distclean help test luacov luacov-console +.PHONY: build clean distclean help test luacov luacov-console fenneldoc -all: $(LUASOURCES) +build: $(LUASOURCES) ${LUASOURCES}: $(FNLSOURCES) @@ -15,16 +15,16 @@ ${LUASOURCES}: $(FNLSOURCES) $(FENNEL) --lua $(LUA) --compile $< > $@ clean: - find . -type f -name '*.lua' | xargs rm -f + rm -f $(LUASOURCES) $(LUATESTS) distclean: clean rm -f luacov* test: $(FNLTESTS) - @$(foreach test, $?, $(FENNEL) --lua $(LUA) --metadata $(test);) + @true$(foreach test, $?, && $(FENNEL) --lua $(LUA) --metadata $(test)) -luacov: all $(LUATESTS) - @$(foreach test, $(LUATESTS), $(LUA) -lluarocks.loader -lluacov $(test);) +luacov: build $(LUATESTS) + @true$(foreach test, $(LUATESTS), && $(LUA) -lluarocks.loader -lluacov $(test)) luacov luacov-console: luacov @@ -32,6 +32,9 @@ luacov-console: luacov luacov-console . @$(foreach test, $(LUATESTS), mv $(test).tmp $(test);) +fenneldoc: + fenneldoc cljlib.fnl cljlib-macros.fnl tests/test.fnl + help: @echo "make -- run tests and create lua library" >&2 @echo "make test -- run tests" >&2 diff --git a/cljlib-macros.fnl b/cljlib-macros.fnl index 1f7552c..d3b8479 100644 --- a/cljlib-macros.fnl +++ b/cljlib-macros.fnl @@ -94,11 +94,11 @@ ;; Strings are transformed into a sequence of letters. `(fn [col#] (let [type# (type col#) - res# (setmetatable {} {:cljlib/table-type :seq}) + res# (setmetatable {} {:cljlib/type :seq}) insert# table.insert] (if (= type# :table) (do (var assoc?# false) - (let [assoc-res# (setmetatable {} {:cljlib/table-type :seq})] + (let [assoc-res# (setmetatable {} {:cljlib/type :seq})] (each [k# v# (pairs col#)] (if (and (not assoc?#) (not (= (type k#) :number))) @@ -119,7 +119,7 @@ (let [t# (type tbl#)] (if (= t# :table) (let [meta# (getmetatable tbl#) - table-type# (and meta# (. meta# :cljlib/table-type))] + table-type# (and meta# (. meta# :cljlib/type))] (if table-type# table-type# (let [(k# _#) (next tbl#)] (if (and (= (type k#) :number) (= k# 1)) :seq @@ -315,7 +315,8 @@ returns the value without additional metadata. (table.insert bodies (list '>= len (- more-len 1))) (table.insert bodies body))) (if (not (and (grows-by-one-or-equal? lengths) - (contains? lengths 0))) + (contains? lengths 0) + body&)) (table.insert bodies (list 'error (.. "wrong argument amount" (if name (.. " for " name) "")) 2))) @@ -639,25 +640,25 @@ at runtime: insert# table.insert] (each [_# v# (ipairs (or ,from []))] (insert# to# v#)) - (setmetatable to# {:cljlib/table-type :seq})) + (setmetatable to# {:cljlib/type :seq})) (= to-type :seq) `(let [to# (or ,to []) seq# ,(seq-fn) insert# table.insert] (each [_# v# (ipairs (seq# (or ,from [])))] (insert# to# v#)) - (setmetatable to# {:cljlib/table-type :seq})) + (setmetatable to# {:cljlib/type :seq})) (and (= to-type :table) (= from-type :seq)) `(let [to# (or ,to [])] (each [_# [k# v#] (ipairs (or ,from []))] (tset to# k# v#)) - (setmetatable to# {:cljlib/table-type :table})) + (setmetatable to# {:cljlib/type :table})) (and (= to-type :table) (= from-type :table)) `(let [to# (or ,to []) from# (or ,from [])] (each [k# v# (pairs from#)] (tset to# k# v#)) - (setmetatable to# {:cljlib/table-type :table})) + (setmetatable to# {:cljlib/type :table})) (= to-type :table) `(let [to# (or ,to []) from# (or ,from [])] @@ -667,7 +668,7 @@ at runtime: :table (each [k# v# (pairs from#)] (tset to# k# v#)) :else (error "expected table as second argument" 2)) - (setmetatable to# {:cljlib/table-type :table})) + (setmetatable to# {:cljlib/type :table})) ;; runtime branch `(let [to# ,to from# ,from @@ -677,28 +678,28 @@ at runtime: to-type# (table-type# to#) to# (or to# []) ;; secure nil res# (match to-type# - :seq (do (each [_# v# (ipairs (seq# from#))] - (insert# to# v#)) - to#) + ;; Sequence or empty table + (seq1# ? (or (= seq1# :seq) (= seq1# :empty))) + (do (each [_# v# (ipairs (seq# from#))] + (insert# to# v#)) + to#) + ;; associative table :table (match (table-type# from#) - :seq (do (each [_# [k# v#] (ipairs (or from# []))] - (tset to# k# v#)) - to#) - :string (do (each [_# v# (ipairs (seq# from#))] - (insert# to# v#)) - to#) + (seq2# ? (or (= seq2# :seq) (= seq2# :string))) + (do (each [_# [k# v#] (ipairs (or from# []))] + (tset to# k# v#)) + to#) :table (do (each [k# v# (pairs (or from# []))] (tset to# k# v#)) to#) :empty to# :else (error "expected table as second argument" 2)) - ;; 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#)) - to#) + ;; set both ordered set and hash set + (Set# ? (or (= Set# :cljlib/ordered-set) (= Set# :cljlib/hash-set))) + (do (each [_# v# (ipairs (seq# from#))] + (tset to# v# v#)) + to#) + ;; sometimes it is handy to pass nil too :nil (match (table-type# from#) :nil nil :empty to# @@ -711,10 +712,13 @@ at runtime: :else (error "expected table as second argument" 2)) :else (error "expected table as first argument" 2))] (if res# - (setmetatable res# {:cljlib/table-type (match to-type# - :seq :seq - :empty :seq - :table :table)})))))) + (let [m# (or (getmetatable res#) {})] + (set m#.cljlib/type (match to-type# + :seq :seq + :empty :seq + :table :table + t# t#)) + (setmetatable res# m#))))))) ;; empty @@ -740,20 +744,20 @@ and return result of the same type: ``` See [`into`](#into) for more info on how conversion is done." (match (table-type x) - :seq `(setmetatable {} {:cljlib/table-type :seq}) - :table `(setmetatable {} {:cljlib/table-type :table}) - _ `(setmetatable {} {:cljlib/table-type (,(table-type-fn) ,x)}))) + :seq `(setmetatable {} {:cljlib/type :seq}) + :table `(setmetatable {} {:cljlib/type :table}) + _ `(let [x# ,x] + (match (,(table-type-fn) x#) + :cljlib/ordered-set (: x# :cljlib/empty) + :cljlib/hash-set (: x# :cljlib/empty) + t# (setmetatable {} {:cljlib/type t#}))))) ;; multimethods (fn seq->table [seq] (let [tbl {}] - (var v nil) - (var (i k) (next seq)) - (while i - (set (i v) (next seq i)) - (tset tbl k v) - (set (i k) (next seq i))) + (for [i 1 (length seq) 2] + (tset tbl (. seq i) (. seq (+ i 1)))) tbl)) (fn defmulti [...] @@ -766,35 +770,35 @@ See [`into`](#into) for more info on how conversion is done." (assert (= (% (length options) 2) 0) "wrong argument amount for defmulti") (let [options (seq->table options)] (if (in-scope? name) - nil + `nil `(local ,name - (let [multimethods# {}] - (setmetatable - ,(with-meta {} {:fnl/docstring docstring}) - {:__call - (fn [_# ...] - ,docstring - (let [dispatch-value# (,dispatch-fn ...) - (res# view#) (pcall require :fennelview) - tostr# (if res# view# tostring)] - ((or (. multimethods# dispatch-value#) - (. multimethods# (or (. ,options :default) :default)) - (error (.. "No method in multimethod '" - ,(tostring name) - "' for dispatch value: " - (tostr# dispatch-value#)) - 2)) ...))) - :__name "multifn" - :multimethods (setmetatable multimethods# - {:__index - (fn [tbl# key#] - (let [eq# ,(eq-fn)] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#))})}))))))) + (setmetatable + ,(with-meta {} {:fnl/docstring docstring}) + {:__index + (fn [tbl# key#] + (let [eq# ,(eq-fn)] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)) + :__call + (fn [t# ...] + ,docstring + (let [dispatch-value# (,dispatch-fn ...) + (res# view#) (pcall require :fennelview) + tostr# (if res# view# tostring)] + ((or (. t# dispatch-value#) + (. t# (or (. ,options :default) :default)) + (error (.. "No method in multimethod '" + ,(tostring name) + "' for dispatch value: " + (tostr# dispatch-value#)) + 2)) ...))) + :__name (.. "multifn " ,(tostring name)) + :__fennelview tostring + :cljlib/type :multifn})))))) (attach-meta defmulti {:fnl/arglist [:name :docstring? :dispatch-fn :attr-map?] :fnl/docstring "Create multifunction with @@ -810,12 +814,7 @@ By default, multifunction has no multimethods, see (fn defmethod [multifn dispatch-val ...] (when (= (select :# ...) 0) (error "wrong argument amount for defmethod")) - `(let [multifn# ,multifn] - (tset (. (getmetatable multifn#) :multimethods) - ,dispatch-val - (do (fn* f# ,...) - f#)) - multifn#)) + `(doto ,multifn (tset ,dispatch-val (do (fn* f# ,...) f#)))) (attach-meta defmethod {:fnl/arglist [:multifn :dispatch-val :fnspec] :fnl/docstring "Attach new method to multi-function dispatch value. accepts the `multi-fn` @@ -39,22 +39,10 @@ functions](https://clojure.org/guides/learn/functions#_multi_arity_functions)."} (local insert table.insert) (local unpack (or table.unpack _G.unpack)) - (require-macros :cljlib-macros) -(fn* core.vector - "Constructs sequential table out of it's arguments. - -Sets additional metadata for function [`vector?`](#vector?) to work. -# Examples - -``` fennel -(local v (vector 1 2 3 4)) -(assert (eq v [1 2 3 4])) -```" - [& args] - (setmetatable args {:cljlib/table-type :seq})) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn* core.apply "Apply `f` to the argument list formed by prepending intervening @@ -84,12 +72,96 @@ Applying `print` to different arguments: (insert flat-args a)) (f a b c d (unpack flat-args))))) +(fn* core.add + "Sum arbitrary amount of numbers." + ([] 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 add (+ a b c d) rest))) + +(fn* core.sub + "Subtract arbitrary amount of numbers." + ([] 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 sub (- a b c d) rest))) + +(fn* core.mul + "Multiply arbitrary amount of numbers." + ([] 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 + "Divide arbitrary amount of numbers." + ([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.inc "Increase number by one" [x] (+ x 1)) +(fn* core.dec "Decrease number by one" [x] (- x 1)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; Tests and predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (fn fast-table-type [tbl] (let [m (getmetatable tbl)] - (if-let [t (and m (. m :cljlib/table-type))] + (if-let [t (and m (. m :cljlib/type))] t))) -;; predicate functions (fn* core.map? "Check whether `tbl` is an associative table. @@ -175,6 +247,21 @@ Empty tables created with [`vector`](#vector) will pass the test: (let [(k _) (next tbl)] (and (not= k nil) (= k 1)))))) +(fn* core.multifn? + "Test if `mf` is an instance of `multifn`. + +`multifn` is a special kind of table, created with `defmulti` macros +from `cljlib-macros.fnl`." + [mf] + (= (. (or (getmetatable mf) {}) :cljlib/type) :multifn)) + +(fn* core.set? + "" + [s] + (match (. (or (getmetatable s) {}) :cljlib/type) + :cljlib/ordered-set :cljlib/ordered-set + :cljlib/hash-set :cljlib/hash-set + _ false)) (fn* core.nil? "Test if value is nil." @@ -266,7 +353,22 @@ Number is rounded with `math.floor` and compared with original number." (if (not (empty? x)) x)) -;; sequence manipulating functions + +;;;;;;;;;;;;;;;;;;;;;; Sequence manipuletion functions ;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn* core.vector + "Constructs sequential table out of it's arguments. + +Sets additional metadata for function [`vector?`](#vector?) to work. + +# Examples + +``` fennel +(local v (vector 1 2 3 4)) +(assert (eq v [1 2 3 4])) +```" + [& args] + (setmetatable args {:cljlib/type :seq})) (fn* core.seq "Create sequential table. @@ -408,11 +510,24 @@ See [`hash-map`](#hash-map) for creating empty associative tables." (let [tbl (or tbl (empty []))] (if (map? tbl) (tset tbl (. x 1) (. x 2)) + (set? tbl) + (tset tbl x x) (insert tbl x)))) tbl) ([tbl x & xs] (apply conj (conj tbl x) xs))) +(fn* core.disj + "Remove key `k` from set `s`." + ([s] (if (set? s) s + (error "expected either hash-set or ordered-set as first argument" 2))) + ([s k] + (if (set? s) + (doto s (tset k nil)) + (error "expected either hash-set or ordered-set as first argument" 2))) + ([s k & ks] + (apply disj (disj s k) ks))) + (fn consj [...] "Like conj but joins at the front. Modifies `tbl`." (let [[tbl x & xs] [...]] @@ -657,6 +772,87 @@ Basic `zipmap` implementation: (filter pred r))) (empty []))) +(fn* core.every? + "Test if every item in `tbl` satisfies the `pred`." + [pred tbl] + (if (empty? tbl) true + (pred (. tbl 1)) (every? pred [(unpack tbl 2)]) + false)) + +(fn* core.some + "Test if any item in `tbl` satisfies the `pred`." + [pred tbl] + (when-let [tbl (seq tbl)] + (or (pred (. tbl 1)) (some pred [(unpack tbl 2)])))) + +(fn* core.not-any? + "Test if no item in `tbl` satisfy the `pred`." + [pred tbl] + (some #(not (pred $)) tbl)) + +(fn* core.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 (empty [])] + (for [i lower (- upper step) step] + (insert res i)) + res))) + +(fn* core.reverse + "Returns table with same items as in `tbl` but in reverse order." + [tbl] + (when-some [tbl (seq tbl)] + (reduce consj (empty []) tbl))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Equality ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(var eq nil) + +(fn deep-index [tbl key] + "This function uses the pre-declared `eq`, which we set later on, +because `eq` requires this function internally. Several other +functions also reuse this indexing method, such as sets." + (var res nil) + (each [k v (pairs tbl)] + (when (eq k key) + (set res v) + (lua :break))) + res) + +(set eq (fn* + ([x] true) + ([x y] + (if (= x y) + true + (and (= (type x) :table) (= (type y) :table)) + (let [oldmeta (getmetatable y)] + ;; In case if we'll get something like + ;; (eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}}) + ;; we have to do even deeper search + (setmetatable y {:__index deep-index}) + (var [res count-a count-b] [true 0 0]) + (each [k v (pairs x)] + (set res (eq v (. y k))) + (set count-a (+ count-a 1)) + (when (not res) (lua :break))) + (when res + (each [_ _ (pairs y)] + (set count-b (+ count-b 1))) + (set res (= count-a count-b))) + (setmetatable y oldmeta) + res) + false)) + ([x y & xs] + (reduce #(and $1 $2) (eq x y) (mapv #(eq x $) xs))))) + +(set core.eq (with-meta eq {:fnl/docstring "Deep compare values."})) + + +;;;;;;;;;;;;;;;;;;;;;; Function manipulation functions ;;;;;;;;;;;;;;;;;;;;;;;;; + (fn* core.identity "Returns its argument." [x] x) (fn* core.comp @@ -673,24 +869,6 @@ Basic `zipmap` implementation: ([f g & fs] (reduce comp (consj fs g f)))) -(fn* core.every? - "Test if every item in `tbl` satisfies the `pred`." - [pred tbl] - (if (empty? tbl) true - (pred (. tbl 1)) (every? pred [(unpack tbl 2)]) - false)) - -(fn* core.some - "Test if any item in `tbl` satisfies the `pred`." - [pred tbl] - (when-let [tbl (seq tbl)] - (or (pred (. tbl 1)) (some pred [(unpack tbl 2)])))) - -(set core.not-any? - (with-meta (comp #(not $) some) - {:fnl/docstring "Test if no item in `tbl` satisfy the `pred`." - :fnl/arglist ["pred" "tbl"]})) - (fn* core.complement "Takes a function `f` and returns the function that takes the same amount of arguments as `f`, has the same effect, and returns the @@ -707,31 +885,35 @@ oppisite truth value." [x] (fn [...] x)) -(fn* core.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 (empty [])] - (for [i lower (- upper step) step] - (insert res i)) - res))) +(fn* core.memoize + "Returns a memoized version of a referentially transparent function. +The memoized version of the function keeps a cache of the mapping from +arguments to results and, when calls with the same arguments are +repeated often, has higher performance at the expense of higher memory +use." + [f] + (let [memo (setmetatable {} {:__index + (fn [tbl key] + (each [k v (pairs tbl)] + (when (eq k key) + (lua "return v"))))})] + (fn [...] + (let [args [...]] + (if-some [res (. memo args)] + res + (let [res (f ...)] + (tset memo args res) + res)))))) -(fn* core.reverse - "Returns table with same items as in `tbl` but in reverse order." - [tbl] - (when-some [tbl (seq tbl)] - (reduce consj (empty []) tbl))) -(fn* core.inc "Increase number by one" [x] (+ x 1)) -(fn* core.dec "Decrease number by one" [x] (- x 1)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hash map extras ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (fn* core.assoc "Associate key `k` with value `v` in `tbl`." ([tbl k v] (setmetatable (doto tbl (tset k v)) - {:cljlib/table-type :table})) + {:cljlib/type :table})) ([tbl k v & kvs] (assert (= (% (length kvs) 2) 0) (.. "no value supplied for key " (. kvs (length kvs)))) @@ -742,7 +924,7 @@ oppisite truth value." (set (i v) (next kvs i)) (tset tbl k v) (set (i k) (next kvs i))) - (setmetatable tbl {:cljlib/table-type :table}))) + (setmetatable tbl {:cljlib/type :table}))) (fn* core.hash-map "Create associative table from keys and values" @@ -773,257 +955,257 @@ found in the table." (set res not-found))) res)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Multimethods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (fn* core.remove-method "Remove method from `multifn` for given `dispatch-val`." [multifn dispatch-val] - (tset (. (getmetatable multifn) :multimethods) dispatch-val nil) + (if (multifn? multifn) + (tset multifn dispatch-val nil) + (error (.. (tostring multifn) " is not a multifn") 2)) multifn) (fn* core.remove-all-methods "Removes all of the methods of multimethod" [multifn] - (let [mtable (. (getmetatable multifn) :multimethods)] - (each [k _ (pairs mtable)] - (tset mtable k nil)) - multifn)) + (if (multifn? multifn) + (each [k _ (pairs multifn)] + (tset multifn k nil)) + (error (.. (tostring multifn) " is not a multifn") 2)) + multifn) (fn* core.methods "Given a multimethod, returns a map of dispatch values -> dispatch fns" [multifn] - (. (getmetatable multifn) :multimethods)) + (if (multifn? multifn) + (let [m {}] + (each [k v (pairs multifn)] + (tset m k v)) + m) + (error (.. (tostring multifn) " is not a multifn") 2))) (fn* core.get-method "Given a multimethod and a dispatch value, returns the dispatch `fn` that would apply to that value, or `nil` if none apply and no default." [multifn dispatch-val] - (or (. (getmetatable multifn) :multimethods dispatch-val) - (. (getmetatable multifn) :multimethods :default))) + (if (multifn? multifn) + (or (. multifn dispatch-val) + (. multifn :default)) + (error (.. (tostring multifn) " is not a multifn") 2))) -(fn* core.add - "Sum arbitrary amount of numbers." - ([] 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 add (+ a b c d) rest))) -(fn* core.sub - "Subtract arbitrary amount of numbers." - ([] 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 sub (- a b c d) rest))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Sets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(fn* core.mul - "Multiply arbitrary amount of numbers." - ([] 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 viewset [Set] + "Workaround for a bug https://todo.sr.ht/~technomancy/fennel/26" + (let [items []] + (each [_ v (pairs Set)] + (insert items ((require :fennelview) v))) + (.. "#{" (table.concat items " ") "}"))) + +(fn set-newindex [Set] + "`__newindex` metamethod for set data structure." + (fn [t k v] + (if (= nil v) + (let [k (. Set k)] + (each [key index (pairs Set)] + (if (= index k) (tset Set key nil) + (> index k) (tset Set key (- index 1))))) + (if (not (. Set v)) + (tset Set v (+ 1 (length t))))))) + +(fn set-length [Set] + "`__len` metamethod for set data structure." + (fn [] + (var len 0) + (each [_ _ (pairs Set)] + (set len (+ 1 len))) + len)) + +(fn set-eq [s1 s2] + "`__eq` metamethod for set data structure." + (var [size res] [0 true]) + (each [i k (pairs s1)] + (set size (+ size 1)) + (if res (set res (. s2 k)) + (lua :break))) + (and res (= size (length s2)))) + +(fn ordered-set-ipairs [Set] + "Returns stateless `ipairs` iterator for ordered sets." + (fn [] + (fn set-next [t i] + (fn loop [t k] + (local (k v) (next t k)) + (if v (if (= v (+ 1 i)) + (values v k) + (loop t k)))) + (loop t)) + (values set-next Set 0))) + +(fn hash-set-ipairs [Set] + "Returns stateful `ipairs` iterator for hashed sets." + (fn [] + (var i 0) + (fn iter [t _] + (var (k v) (next t)) + (for [j 1 i] + (set (k v) (next t k))) + (if k (do (set i (+ i 1)) + (values i k)))) + (values iter Set nil))) + +(fn init-set [Set ...] + "Initializes `Set` with values specified with vararg." + (var i 1) + (each [_ val (ipairs [...])] + (when (not (. Set val)) + (tset Set val i) + (set i (+ 1 i))))) + +;; Sets are bootstrapped upon previous functions. -(fn* core.div - "Divide arbitrary amount of numbers." - ([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.ordered-set + "Create ordered set. -(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))) +Set is a collection of unique elements, which sore purpose is only to +tell you if something is in the set or not. -(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))) +`ordered-set` is follows the argument insertion order, unlike sorted +sets, which apply some sorting algorithm internally. New items added +at the end of the set. Ordered set supports removal of items via +`tset` and [`disj`](#disj). To add element to the ordered set use +`tset` or [`conj`](#conj). Both operations modify the set. -(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))) +**Note**: Hash set prints as `#{a b c}`, but this construct is not +supported by the Fennel reader, so you can't create sets with this +syntax. Use `hash-set` function instead. -(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))) +Below are some examples of how to create and manipulate sets. -(fn* core.eq - "Deep compare values." - ([x] true) - ([x y] - (if (and (= (type x) :table) (= (type y) :table)) - (let [x (or (. (or (getmetatable x) {}) :cljlib/inner) x) - y (or (. (or (getmetatable y) {}) :cljlib/inner) y) - oldmeta (getmetatable y)] - ;; In case if we'll get something like - ;; (eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}}) - ;; we have to do even deeper search - (setmetatable y {:__index (fn [tbl key] - (var res nil) - (each [k v (pairs tbl)] - (when (eq k key) - (set res v) - (lua :break))) - res)}) - (var [res count-a count-b] [true 0 0]) - (each [k v (pairs x)] - (set res (eq v (. y k))) - (set count-a (+ count-a 1)) - (when (not res) (lua :break))) - (when res - (each [_ _ (pairs y)] - (set count-b (+ count-b 1))) - (set res (= count-a count-b))) - (setmetatable y oldmeta) - res) - (= x y))) - ([x y & xs] - (reduce #(and $1 $2) (eq x y) (mapv #(eq x $) xs)))) +## Create ordered set: +Ordered sets are created by passing any amount of elements desired to +be in the set: -(fn* core.memoize - "Returns a memoized version of a referentially transparent function. -The memoized version of the function keeps a cache of the mapping from -arguments to results and, when calls with the same arguments are -repeated often, has higher performance at the expense of higher memory -use." - [f] - (let [memo (setmetatable {} {:__index - (fn [tbl key] - (each [k v (pairs tbl)] - (when (eq k key) - (lua "return v"))))})] - (fn [...] - (let [args [...]] - (if-some [res (. memo args)] - res - (let [res (f ...)] - (tset memo args res) - res)))))) +``` fennel +>> (ordered-set) +#{} +>> (ordered-set :a :c :b) +#{\"a\" \"c\" \"b\"} +``` +Duplicate items are not added: -(fn viewset [Set] - "Workaround for a bug https://todo.sr.ht/~technomancy/fennel/26" - (let [items [] - (res view) (pcall require :fennelview)] - (each [_ v (pairs Set)] - (insert items ((if res view tostring) v))) - (.. "[" (table.concat items " ") "]"))) +``` fennel +>> (ordered-set) +#{} +>> (ordered-set :a :c :a :a :a :a :c :b) +#{\"a\" \"c\" \"b\"} +``` -(fn* core.ordered-set - "Create ordered set." +## Check if set contains desired value: +Sets are functions of their keys, so simply calling a set with a +desired key will either return the key, or `nil`: + +``` fennel +>> (local oset (ordered-set [:a :b :c] [:c :d :e] :e :f)) +>> (oset [:a :b :c]) +[:a :b :c] +>> (. oset :e) +:e +>> (oset [:a :b :f]) +nil +``` + +## Add items to existing set: +To add element to the set use [`conj`](#conj) or `tset` + +``` fennel +>> (local oset (ordered-set :a :b :c)) +>> (conj oset :d :e) +>> oset +#{\"a\" \"b\" \"c\" \"d\" \"e\"} +``` + +### Remove items from the set: +To add element to the set use [`disj`](#disj) or `tset` + +``` fennel +>> (local oset (ordered-set :a :b :c)) +>> (disj oset :b) +>> oset +#{\"a\" \"c\"} +>> (tset oset :a nil) +>> oset +#{\"c\"} +``` + +## Equality semantics +Both `ordered-set` and [`hash-set`](#hash-set) implement `__eq` metamethod, +and are compared for having the same keys without particular order and +same size: + +``` fennel +>> (= (ordered-set :a :b) (ordered-set :b :a)) +true +>> (= (ordered-set :a :b) (ordered-set :b :a :c)) +false +>> (= (ordered-set :a :b) (hash-set :a :b)) +true +```" [& xs] - ;; set has to be able to contain deeply nested tables so we need a - ;; special index for it, that compares values deeply. - (let [Set (setmetatable {} {:__index (fn [tbl key] - (var res nil) - (each [k v (pairs tbl)] - (when (eq k key) - (set res v) - (lua :break))) - res)})] - (var i 1) - (each [_ val (ipairs xs)] - (when (not (. Set val)) - (tset Set val i) - (set i (+ 1 i)))) - (fn set-ipairs [] - "Returns stateless `ipairs` iterator for ordered set." - (fn iter [t i] - (fn loop [t k] - (local (k v) (next t k)) - (if v (if (= v (+ 1 i)) - (values v k) - (loop t k)))) - (loop t)) - (values iter Set 0)) - (setmetatable [] - {:cljlib/inner Set + (let [Set (setmetatable {} {:__index deep-index}) + set-ipairs (ordered-set-ipairs Set)] + (apply init-set Set xs) + (setmetatable {} + {:cljlib/type :cljlib/ordered-set :cljlib/next #(next Set $2) - :cljlib/table-type :ordered-set - :__len (fn [] - (var len 0) - (each [_ _ (pairs Set)] - (set len (+ 1 len))) - len) - :__index (fn [_ k] (if (. Set k) k)) - :__newindex (fn [t k] - (if (not (. Set k)) - (tset Set k (+ (length t) 1)))) + :__eq set-eq + :__call #(if (. Set $2) $2) + :__len (set-length Set) + :__index #(match $2 + :cljlib/empty #(ordered-set) + _ (if (. Set $2) $2)) + :__newindex (set-newindex Set) :__ipairs set-ipairs :__pairs set-ipairs :__name "ordered set" :__fennelview viewset}))) (fn* core.hash-set - "Create hashed set." + "Create hash set. + +Set is a collection of unique elements, which sore purpose is only to +tell you if something is in the set or not. + +Hash set differs from ordered set in that the keys are do not have any +particular order. New items are added at the arbitrary position by +using [`conj`](#con) or `tset` functions, and items can be removed +with [`disj`](#disj) or `tset` functions. Rest semantics are the same +as for [`ordered-set`](#ordered-set) + +**Note**: Hash set prints as `#{a b c}`, but this construct is not +supported by the Fennel reader, so you can't create sets with this +syntax. Use `hash-set` function instead." [& xs] - ;; same trick as for ordered set - (let [Set (setmetatable {} {:__index (fn [tbl key] - (var res nil) - (each [k v (pairs tbl)] - (when (eq k key) - (set res v) - (lua :break))) - res)})] - (each [_ k (ipairs xs)] - (when (not (. Set k)) - (tset Set k true))) - (fn set-ipairs [] - "Returns stateful `ipairs` iterator for hashed set." - (var i 0) - (fn iter [t _] - (var (k v) (next t)) - (for [j 1 i] - (set (k v) (next t k))) - (if k (do (set i (+ i 1)) - (values i k)))) - (values iter Set nil)) - (setmetatable [] - {:cljlib/inner Set + (let [Set (setmetatable {} {:__index deep-index}) + set-ipairs (hash-set-ipairs Set)] + (apply init-set Set xs) + (setmetatable {} + {:cljlib/type :cljlib/hash-set :cljlib/next #(next Set $2) - :cljlib/table-type :hashed-set - :__len (fn [] - (var len 0) - (each [_ _ (pairs Set)] - (set len (+ 1 len))) - len) - :__index (fn [_ k] (if (. Set k) k)) - :__newindex (fn [_ k v] (tset Set k (if (not (nil? v)) true))) + :__eq set-eq + :__call #(if (. Set $2) $2) + :__len (set-length Set) + :__index #(match $2 + :cljlib/empty #(hash-set) + _ (if (. Set $2) $2)) + :__newindex (set-newindex Set) :__ipairs set-ipairs :__pairs set-ipairs :__name "hashed set" - :__fennelview #(.. "#" (viewset $))}))) + :__fennelview viewset}))) core diff --git a/doc/cljlib-macros.md b/doc/cljlib-macros.md index 5916521..041469b 100644 --- a/doc/cljlib-macros.md +++ b/doc/cljlib-macros.md @@ -1,4 +1,4 @@ -# Cljlib-macros.fnl (0.1.0) +# Cljlib-macros.fnl (0.3.0) Macros for Cljlib that implement various facilities from Clojure. **Table of contents** diff --git a/doc/cljlib.md b/doc/cljlib.md index 1bf82ac..9ff6804 100644 --- a/doc/cljlib.md +++ b/doc/cljlib.md @@ -1,4 +1,4 @@ -# Cljlib.fnl (0.1.0) +# Cljlib.fnl (0.3.0) Fennel-cljlib - functions from Clojure's core.clj implemented on top of Fennel. @@ -49,6 +49,7 @@ functions](https://clojure.org/guides/learn/functions#_multi_arity_functions). - [`cons`](#cons) - [`constantly`](#constantly) - [`dec`](#dec) +- [`disj`](#disj) - [`div`](#div) - [`double?`](#double?) - [`empty?`](#empty?) @@ -64,6 +65,7 @@ functions](https://clojure.org/guides/learn/functions#_multi_arity_functions). - [`get-method`](#get-method) - [`gt`](#gt) - [`hash-map`](#hash-map) +- [`hash-set`](#hash-set) - [`identity`](#identity) - [`inc`](#inc) - [`int?`](#int?) @@ -76,12 +78,14 @@ functions](https://clojure.org/guides/learn/functions#_multi_arity_functions). - [`memoize`](#memoize) - [`methods`](#methods) - [`mul`](#mul) +- [`multifn?`](#multifn?) - [`neg-int?`](#neg-int?) - [`neg?`](#neg?) - [`nil?`](#nil?) - [`not-any?`](#not-any?) - [`not-empty`](#not-empty) - [`odd?`](#odd?) +- [`ordered-set`](#ordered-set) - [`pos-int?`](#pos-int?) - [`pos?`](#pos?) - [`range`](#range) @@ -93,6 +97,7 @@ functions](https://clojure.org/guides/learn/functions#_multi_arity_functions). - [`rest`](#rest) - [`reverse`](#reverse) - [`seq`](#seq) +- [`set?`](#set?) - [`some`](#some) - [`string?`](#string?) - [`sub`](#sub) @@ -283,6 +288,18 @@ Function signature: Decrease number by one +## `disj` +Function signature: + +``` +(disj + ([s]) + ([s k]) + ([s k & ks])) +``` + +Remove key `k` from set `s`. + ## `div` Function signature: @@ -443,6 +460,28 @@ Function signature: Create associative table from keys and values +## `hash-set` +Function signature: + +``` +(hash-set [& xs]) +``` + +Create hash set. + +Set is a collection of unique elements, which sore purpose is only to +tell you if something is in the set or not. + +Hash set differs from ordered set in that the keys are do not have any +particular order. New items are added at the arbitrary position by +using [`conj`](#con) or `tset` functions, and items can be removed +with [`disj`](#disj) or `tset` functions. Rest semantics are the same +as for [`ordered-set`](#ordered-set) + +**Note**: Hash set prints as `#{a b c}`, but this construct is not +supported by the Fennel reader, so you can't create sets with this +syntax. Use `hash-set` function instead. + ## `identity` Function signature: @@ -637,6 +676,18 @@ Function signature: Multiply arbitrary amount of numbers. +## `multifn?` +Function signature: + +``` +(multifn? [mf]) +``` + +Test if `mf` is an instance of `multifn`. + +`multifn` is a special kind of table, created with `defmulti` macros +from `cljlib-macros.fnl`. + ## `neg-int?` Function signature: @@ -669,7 +720,7 @@ Test if value is nil. Function signature: ``` -(not-any? pred tbl) +(not-any? [pred tbl]) ``` Test if no item in `tbl` satisfy the `pred`. @@ -692,6 +743,101 @@ Function signature: Test if value is odd. +## `ordered-set` +Function signature: + +``` +(ordered-set [& xs]) +``` + +Create ordered set. + +Set is a collection of unique elements, which sore purpose is only to +tell you if something is in the set or not. + +`ordered-set` is follows the argument insertion order, unlike sorted +sets, which apply some sorting algorithm internally. New items added +at the end of the set. Ordered set supports removal of items via +`tset` and [`disj`](#disj). To add element to the ordered set use +`tset` or [`conj`](#conj). Both operations modify the set. + +**Note**: Hash set prints as `#{a b c}`, but this construct is not +supported by the Fennel reader, so you can't create sets with this +syntax. Use `hash-set` function instead. + +Below are some examples of how to create and manipulate sets. + +#### Create ordered set: +Ordered sets are created by passing any amount of elements desired to +be in the set: + +``` fennel +>> (ordered-set) +###{} +>> (ordered-set :a :c :b) +###{"a" "c" "b"} +``` + +Duplicate items are not added: + +``` fennel +>> (ordered-set) +###{} +>> (ordered-set :a :c :a :a :a :a :c :b) +###{"a" "c" "b"} +``` + +#### Check if set contains desired value: +Sets are functions of their keys, so simply calling a set with a +desired key will either return the key, or `nil`: + +``` fennel +>> (local oset (ordered-set [:a :b :c] [:c :d :e] :e :f)) +>> (oset [:a :b :c]) +[:a :b :c] +>> (. oset :e) +:e +>> (oset [:a :b :f]) +nil +``` + +#### Add items to existing set: +To add element to the set use [`conj`](#conj) or `tset` + +``` fennel +>> (local oset (ordered-set :a :b :c)) +>> (conj oset :d :e) +>> oset +###{"a" "b" "c" "d" "e"} +``` + +##### Remove items from the set: +To add element to the set use [`disj`](#disj) or `tset` + +``` fennel +>> (local oset (ordered-set :a :b :c)) +>> (disj oset :b) +>> oset +###{"a" "c"} +>> (tset oset :a nil) +>> oset +###{"c"} +``` + +#### Equality semantics +Both `ordered-set` and [`hash-set`](#hash-set) implement `__eq` metamethod, +and are compared for having the same keys without particular order and +same size: + +``` fennel +>> (= (ordered-set :a :b) (ordered-set :b :a)) +true +>> (= (ordered-set :a :b) (ordered-set :b :a :c)) +false +>> (= (ordered-set :a :b) (hash-set :a :b)) +true +``` + ## `pos-int?` Function signature: @@ -909,6 +1055,15 @@ Additionally you can use [`conj`](#conj) and [`apply`](#apply) with ;; => {:a 1 :b 2 :c 3} ``` +## `set?` +Function signature: + +``` +(set? [s]) +``` + + + ## `some` Function signature: diff --git a/tests/core.fnl b/tests/core.fnl index a4d4a4e..1921a05 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -43,6 +43,7 @@ (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) (assert-not (eq [1 [2]] [1 [2]] [1 [2 [3]]])) + (assert-not (eq {:a {:b 2}} {:a {:b 2}} {:a {:b 3}})) (let [a {:a 1 :b 2} b {:a 1 :b 2}] @@ -96,40 +97,58 @@ (testing "zero?" (assert-is (zero? 0)) (assert-is (zero? -0)) - (assert-not (zero? 1))) + (assert-not (zero? 1)) + (assert-not (pcall zero?)) + (assert-not (pcall zero? 1 2))) (testing "int?" (assert-is (int? 1)) - (assert-not (int? 1.1))) + (assert-not (int? 1.1)) + (assert-not (pcall int?)) + (assert-not (pcall int? 1 2))) (testing "pos?" (assert-is (pos? 1)) - (assert-is (and (not (pos? 0)) (not (pos? -1))))) + (assert-is (and (not (pos? 0)) (not (pos? -1)))) + (assert-not (pcall pos?)) + (assert-not (pcall pos? 1 2))) (testing "neg?" (assert-is (neg? -1)) - (assert-is (and (not (neg? 0)) (not (neg? 1))))) + (assert-is (and (not (neg? 0)) (not (neg? 1)))) + (assert-not (pcall neg?)) + (assert-not (pcall neg? 1 2))) (testing "pos-int?" (assert-is (pos-int? 42)) - (assert-not (pos-int? 4.2))) + (assert-not (pos-int? 4.2)) + (assert-not (pcall pos-int?)) + (assert-not (pcall pos-int? 1 2))) (testing "neg-int?" (assert-is (neg-int? -42)) - (assert-not (neg-int? -4.2))) + (assert-not (neg-int? -4.2)) + (assert-not (pcall neg-int?)) + (assert-not (pcall neg-int? 1 2))) (testing "string?" - (assert-is (string? :s))) + (assert-is (string? :s)) + (assert-not (pcall string?)) + (assert-not (pcall string? 1 2))) (testing "double?" (assert-is (double? 3.3)) - (assert-not (double? 3.0))) + (assert-not (double? 3.0)) + (assert-not (pcall double?)) + (assert-not (pcall double? 1 2))) (testing "map?" (assert-is (map? {:a 1})) (assert-not (map? {})) (assert-is (map? (empty {}))) - (assert-not (map? (empty [])))) + (assert-not (map? (empty []))) + (assert-not (pcall map?)) + (assert-not (pcall map? 1 2))) (testing "vector?" (assert-not (vector? [])) @@ -137,45 +156,74 @@ (assert-not (vector? {})) (assert-not (vector? {:a 1})) (assert-is (vector? (empty []))) - (assert-not (vector? (empty {})))) + (assert-not (vector? (empty {}))) + (assert-not (pcall vector?)) + (assert-not (pcall vector? 1 2))) + + (testing "multifn?" + (assert-not (multifn? [])) + (assert-is (multifn? (do (defmulti f identity) f))) + (assert-not (pcall multifn?)) + (assert-not (pcall multifn? 1 2))) + + (testing "set?" + (assert-is (set? (ordered-set))) + (assert-is (set? (hash-set))) + (assert-eq (set? (hash-set)) :cljlib/hash-set) + (assert-eq (set? (ordered-set)) :cljlib/ordered-set) + (assert-not (pcall set?)) + (assert-not (pcall set? 1 2))) (testing "nil?" (assert-is (nil?)) (assert-is (nil? nil)) - (assert-not (nil? 1))) + (assert-not (nil? 1)) + (assert-not (pcall nil? 1 2))) (testing "odd?" (assert-is (odd? 3)) (assert-is (odd? -3)) (assert-not (odd? 2)) - (assert-not (odd? -2))) + (assert-not (odd? -2)) + (assert-not (pcall odd?)) + (assert-not (pcall odd? 1 2))) (testing "even?" (assert-is (even? 2)) (assert-is (even? -2)) (assert-not (even? 23)) - (assert-not (even? -23))) + (assert-not (even? -23)) + (assert-not (pcall even?)) + (assert-not (pcall even? 1 2))) (testing "true?" (assert-is (true? true)) (assert-not (true? false)) (assert-not (true? 10)) - (assert-not (true? :true))) + (assert-not (true? :true)) + (assert-not (pcall true?)) + (assert-not (pcall true? 1 2))) (testing "false?" (assert-is (false? false)) (assert-not (false? true)) (assert-not (false? 10)) - (assert-not (false? :true))) + (assert-not (false? :true)) + (assert-not (pcall false?)) + (assert-not (pcall false? 1 2))) (testing "boolean?" (assert-is (boolean? true)) (assert-is (boolean? false)) (assert-not (boolean? :false)) - (assert-not (boolean? (fn [] true))))) + (assert-not (boolean? (fn [] true))) + (assert-not (pcall boolean?)) + (assert-not (pcall boolean? 1 2)))) (deftest sequence-functions (testing "seq" + (assert-not (pcall seq)) + (assert-not (pcall seq [] [])) (assert-eq (seq []) nil) (assert-eq (seq {}) nil) (assert-eq (seq [1]) [1]) @@ -183,7 +231,20 @@ (assert-eq (seq {:a 1}) [["a" 1]]) (assert-eq (seq "abc") ["a" "b" "c"]) (assert-eq (seq "абв") ["а" "б" "в"]) - (assert-eq (seq {12345 123}) [[12345 123]])) + (assert-eq (seq {12345 123}) [[12345 123]]) + (assert-eq (seq (ordered-set 1 2 3)) [1 2 3]) + (assert-eq (length (seq (ordered-set 1 2 3))) 3) + (assert-eq (seq (hash-set 1)) [1]) + (assert-eq (length (seq (hash-set 1 2 3))) 3)) + + (testing "kvseq" + (assert-not (pcall kvseq)) + (assert-not (pcall kvseq [] [])) + (assert-eq (kvseq {123 456}) [[123 456]]) + (assert-eq (kvseq {:a 1}) [[:a 1]]) + (assert-eq (kvseq [0 0 0 10]) [[1 0] [2 0] [3 0] [4 10]]) + (assert-eq (kvseq (ordered-set :a :b :c)) [[1 :a] [2 :b] [3 :c]]) + (assert-eq (kvseq (hash-set :a)) [[1 :a]])) (testing "mapv" (assert-not (pcall mapv)) @@ -271,42 +332,62 @@ (assert-not (pcall concat [1] 2))) (testing "reverse" + (assert-not (pcall reverse)) + (assert-not (pcall reverse [] [])) (assert-eq (reverse []) nil) (assert-eq (reverse [1 2 3]) [3 2 1]) (assert-eq (reverse {:a 1}) [[:a 1]])) (testing "conj" (assert-eq (conj) []) - (assert-eq (conj [1] nil) [1]) + (assert-eq (conj [1]) [1]) (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}) (assert-eq (conj {:a 1}) {:a 1}) (assert-eq (conj [1] 2 3 4 5 6 7) [1 2 3 4 5 6 7])) + (testing "disj" + (assert-not (pcall disj)) + (assert-not (pcall disj [1])) + (assert-not (pcall disj [1] 1)) + (assert-eq (disj (ordered-set)) (ordered-set)) + (assert-eq (disj (ordered-set 1 3 2 5) 3) (ordered-set 1 2 5)) + (assert-eq (disj (ordered-set 1 3 2 5) 3 1 5) (ordered-set 2))) + (testing "cons" + (assert-not (pcall cons)) + (assert-not (pcall cons [] [] [])) (assert-eq (cons nil [1]) [1]) (assert-eq (cons 1 []) [1]) (assert-eq (cons 1 [0]) [1 0])) (testing "first" + (assert-not (pcall first)) + (assert-not (pcall first [] [])) (assert-eq (first [1 2 3]) 1) (assert-eq (first {:a 1}) [:a 1]) (assert-eq (first []) nil)) (testing "last" + (assert-not (pcall last)) + (assert-not (pcall last [] [])) (assert-eq (last [1 2 3]) 3) (assert-eq (last []) nil) (assert-eq (last nil) nil) (assert-eq (last {:a 1}) [:a 1])) (testing "rest" + (assert-not (pcall rest)) + (assert-not (pcall rest [] [])) (assert-eq (rest [1 2 3]) [2 3]) (assert-eq (rest {:a 1}) []) (assert-eq (rest []) []) (assert-eq (rest nil) [])) (testing "butlast" + (assert-not (pcall butlast)) + (assert-not (pcall butlast [] [])) (assert-eq (butlast [1 2 3]) [1 2]) (assert-eq (butlast {:a 1}) nil) (assert-eq (butlast []) nil) @@ -320,6 +401,8 @@ (assert-not (pcall reduce-kv))) (testing "reduced" + (assert-not (pcall reduced)) + (assert-not (pcall reduced 1 2 3)) (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1]) 1) (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2]) 3) (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4]) 10) @@ -344,6 +427,8 @@ (deftest function-manipulation (testing "constantly" + (assert-not (pcall constantly)) + (assert-not (pcall constantly nil nil)) (let [always-nil (constantly nil)] (assert-eq (always-nil) nil) (assert-eq (always-nil 1) nil) @@ -354,6 +439,8 @@ (assert-is (always-true false)))) (testing "complement" + (assert-not (pcall complement)) + (assert-not (pcall complement #nil #nil)) (assert-is ((complement #(do false)))) (assert-is ((complement nil?) 10)) (assert-is ((complement every?) double? [1 2 3 4])) @@ -377,6 +464,7 @@ (testing "comp" (assert-eq ((comp) 10) 10) + (assert-eq ((comp #10)) 10) (fn square [x] (* x x)) (assert-eq (comp square) square) (assert-eq ((comp square inc) 6) 49) @@ -392,11 +480,15 @@ (testing "identity" (fn f [] nil) + (local a {}) + (assert-not (pcall identity)) + (assert-not (pcall identity 1 2)) (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") - (assert-eq (identity f) f))) + (assert-eq (identity f) f) + (assert-eq (identity a) a))) (deftest sequence-predicates (testing "some" @@ -479,8 +571,9 @@ (defmethod f :a [_] :a) (defmethod f :b [_] :b) (defmethod f :c [x] (* x x)) - (assert-eq (methods f) (. (getmetatable f) :multimethods)) + (assert-eq (methods f) f) (assert-not (pcall methods)) + (assert-not (pcall methods [])) (assert-not (pcall methods f f))) (testing "get-method" @@ -492,6 +585,8 @@ (assert-eq ((get-method f :b) 20) :b) (assert-eq ((get-method f :c) 4) 16) (assert-not (pcall get-method)) + (assert-not (pcall get-method [])) + (assert-not (pcall get-method [] :a)) (assert-not (pcall get-method f)) (assert-not (pcall get-method f :a :b))) @@ -504,6 +599,8 @@ (defmethod f :default [_] :default) (assert-eq (get-method f :a) (get-method f :default)) (assert-not (pcall remove-method)) + (assert-not (pcall remove-method [])) + (assert-not (pcall remove-method [] :a)) (assert-not (pcall remove-method f)) (assert-not (pcall remove-method f :a :b))) @@ -515,6 +612,7 @@ (remove-all-methods f) (assert-eq (methods f) {}) (assert-not (pcall remove-all-methods)) + (assert-not (pcall remove-all-methods [])) (assert-not (pcall remove-all-methods f f)))) (deftest math-functions @@ -600,7 +698,7 @@ (assert-eq (vector) []) (assert-eq (vector 1) [1]) (assert-eq (vector 1 2 3) [1 2 3]) - (assert-eq (getmetatable (vector 1 2 3)) {:cljlib/table-type :seq}))) + (assert-eq (getmetatable (vector 1 2 3)) {:cljlib/type :seq}))) (deftest hash-map (testing "hash-map" @@ -608,7 +706,7 @@ (assert-eq (hash-map) {}) (assert-eq (hash-map :a 1) {:a 1}) (assert-eq (hash-map :a 1 :b 2 :c 3) {:a 1 :b 2 :c 3}) - (assert-eq (getmetatable (hash-map)) {:cljlib/table-type :table}))) + (assert-eq (getmetatable (hash-map)) {:cljlib/type :table}))) (deftest sets (testing "hash-set" @@ -616,21 +714,86 @@ h2 (hash-set [1] [2] [3] [:a])] (assert-is (eq h1 h2))) - (let [h1 (hash-set [1] [1] [2] [3] [:a]) - h2 (hash-set [1] [1] [3] [:a])] - (assert-not (eq h1 h2))) + (let [h3 (hash-set [1] [1] [2] [3] [:a]) + h4 (hash-set [1] [1] [3] [:a])] + (assert-not (eq h3 h4))) (assert-eq (. (hash-set [1]) [1]) [1]) - (assert-eq (. (hash-set [1]) [2]) nil)) + (assert-eq (. (hash-set [1]) [2]) nil) + (assert-eq ((hash-set [1]) [1]) [1]) + (assert-eq ((hash-set [1]) [2]) nil)) (testing "ordered-set" - (let [h1 (ordered-set [1] [1] [2] [3] [:a]) - h2 (ordered-set [1] [2] [3] [:a])] - (assert-is (eq h1 h2))) + (let [o1 (ordered-set [1] [1] [2] [3] [:a]) + o2 (ordered-set [1] [2] [3] [:a])] + (assert-eq o1 o2)) - (let [h1 (ordered-set [1] [1] [2] [3] [:a]) - h2 (ordered-set [2] [1] [1] [3] [:a])] - (assert-not (eq h1 h2))) + (let [o3 (ordered-set [1] [1] [2] [3] [:a]) + o4 (ordered-set [2] [1] [1] [3] [:a])] + (assert-eq o3 o4)) (assert-eq (. (ordered-set [1]) [1]) [1]) - (assert-eq (. (ordered-set [1]) [2]) nil))) + (assert-eq ((ordered-set [1]) [1]) [1]) + (assert-eq (. (ordered-set [1]) [2]) nil) + (assert-eq ((ordered-set [1]) [2]) nil)) + + (testing "set equality" + (let [o1 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h1 (hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] + (assert-eq o1 h1)) + + (let [o2 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h2 (hash-set [1] [[-1 1] 1] [2] [3] [:a] :a 2)] + (assert-ne o2 h2)) + + (let [o3 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h3 (hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] + (assert-eq (disj o3 [2]) (disj h3 [2])) + (assert-ne (disj o3 :a) h3) + (assert-eq (disj h3 :a) o3)) + + (let [o4 (ordered-set [1] [[-1 5] 1] [3] [:a] :a 2) + h4 (hash-set [1] [[-1 5] 1] [2] [3] [:a] :a 2)] + (assert-eq (conj o4 [2]) (conj (disj h4 [2]) [2])))) + + (testing "empty sets" + (assert-eq (empty (ordered-set)) (ordered-set)) + (assert-eq (empty (ordered-set 1 2 3)) (ordered-set)) + (assert-eq (. (getmetatable (empty (ordered-set))) :cljlib/type ) :cljlib/ordered-set) + + (assert-eq (empty (hash-set)) (hash-set)) + (assert-eq (empty (hash-set 1 2 3)) (hash-set)) + (assert-eq (. (getmetatable (empty (hash-set))) :cljlib/type ) :cljlib/hash-set)) + + (testing "into sets" + (assert-eq (into (ordered-set) [1 2 3]) (ordered-set 1 2 3)) + (assert-eq (into (ordered-set) {:a 1 :b 2}) (ordered-set [:a 1] [:b 2])) + (assert-eq (into (ordered-set) "vaiv") (ordered-set "v" "a" "i" "v")) + (assert-eq (into (hash-set) [1 2 3]) (hash-set 1 2 3)) + (assert-eq (into (hash-set) {:a 1 :b 2}) (hash-set [:a 1] [:b 2])) + (assert-eq (into (hash-set) "vaiv") (hash-set "v" "a" "i" "v")))) + +(deftest memoization + (testing "memoize" + (macros {:time #`(let [clock# os.clock + start# (clock#) + res# ,$ + end# (clock#)] + (values res# (* 1000 (- end# start#))))}) + + (fn slow [x] (for [i 0 1000000] nil) x) + + (assert-not (pcall memoize)) + (assert-not (pcall memoize slow 2)) + + (local fast (memoize slow)) + + (let [(res1 time1) (time (fast 42)) + (res2 time2) (time (fast 42))] + (assert-is (and res1 res2 42)) + (assert-is (< time2 time1))) + + (let [(res1 time1) (time (fast [10])) + (res2 time2) (time (fast [10]))] + (assert-is (and (eq res1 res2 [10]))) + (assert-is (< time2 time1))))) diff --git a/tests/macros.fnl b/tests/macros.fnl index 29b5317..9ac9d95 100644 --- a/tests/macros.fnl +++ b/tests/macros.fnl @@ -18,9 +18,9 @@ ;; different bodies are being used at compile time so worth testing (assert-eq (into [] {}) []) (assert-eq (into {} []) []) - (assert-eq (. (getmetatable (into [] {})) :cljlib/table-type) :seq) - (assert-eq (. (getmetatable (into {} [])) :cljlib/table-type) :table) - (let [a []] (assert-eq (. (getmetatable (into a a)) :cljlib/table-type) :seq)) + (assert-eq (. (getmetatable (into [] {})) :cljlib/type) :seq) + (assert-eq (. (getmetatable (into {} [])) :cljlib/type) :table) + (let [a []] (assert-eq (. (getmetatable (into a a)) :cljlib/type) :seq)) ;; can't transform table with more than one key-value pair, as order ;; is undeterminitive @@ -189,17 +189,17 @@ (deftest empty (testing "empty map" (assert-eq (empty {}) {}) - (assert-eq (getmetatable (empty {})) {:cljlib/table-type :table}) + (assert-eq (getmetatable (empty {})) {:cljlib/type :table}) (let [a {:a 1 :b 2}] (assert-eq (empty a) {}) - (assert-eq (getmetatable (empty a)) {:cljlib/table-type :table})) + (assert-eq (getmetatable (empty a)) {:cljlib/type :table})) (let [a {}] (assert-eq (empty a) []) - (assert-eq (getmetatable (empty a)) {:cljlib/table-type :empty}))) + (assert-eq (getmetatable (empty a)) {:cljlib/type :empty}))) (testing "empty seq" (assert-eq (empty []) {}) - (assert-eq (getmetatable (empty [])) {:cljlib/table-type :seq}) + (assert-eq (getmetatable (empty [])) {:cljlib/type :seq}) (let [a [:a 1 :b 2]] (assert-eq (empty a) []) - (assert-eq (getmetatable (empty a)) {:cljlib/table-type :seq})))) + (assert-eq (getmetatable (empty a)) {:cljlib/type :seq})))) diff --git a/tests/test.fnl b/tests/test.fnl index b250af4..0fcd750 100644 --- a/tests/test.fnl +++ b/tests/test.fnl @@ -6,7 +6,9 @@ This function is able to compare tables of any depth, even if one of the tables uses tables as keys." `(fn eq# [left# right#] - (if (and (= (type left#) :table) (= (type right#) :table)) + (if (= left# right#) + true + (and (= (type left#) :table) (= (type right#) :table)) (let [oldmeta# (getmetatable right#)] ;; In case if we'll get something like ;; (eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}}) @@ -29,7 +31,7 @@ the tables uses tables as keys." (set res# (= count-a# count-b#))) (setmetatable right# oldmeta#) res#) - (= left# right#)))) + false))) (fn test.assert-eq [expr1 expr2 msg] |