diff options
| -rw-r--r-- | README.org | 62 | ||||
| -rw-r--r-- | core.fnl | 187 | ||||
| -rw-r--r-- | core_test.fnl | 87 | ||||
| -rw-r--r-- | macros/core.fnl | 1 | ||||
| -rw-r--r-- | macros_test.fnl | 2 | ||||
| -rw-r--r-- | test.fnl | 23 |
6 files changed, 266 insertions, 96 deletions
@@ -1,5 +1,4 @@ #+title: Fennel Cljlib -#+date: 2020-10-24 Experimental library for [[https://fennel-lang.org/][Fennel]] language, that adds many functions from [[https://clojure.org/][Clojure]]'s standard library. This is not a one to one port of Clojure =core=, because many Clojure functions require certain guarantees, like immutability of the underlying data structures, or laziness. @@ -20,7 +19,7 @@ Clojure's =fn= equivalent. Returns a function of fixed arity by doing runtime dispatch, based on argument amount. Capable of producing multi-arity functions: -#+begin_src clojure +#+begin_src fennel (fn* square "square number" [x] (^ x 2)) (square 9) ;; => 81.0 @@ -45,7 +44,7 @@ Capable of producing multi-arity functions: Both variants support up to one arity with =& more=: -#+begin_src clojure +#+begin_src fennel (fn* vec [& xs] xs) (vec 1 2 3) ;; => [1 2 3] @@ -68,7 +67,7 @@ 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. -#+begin_src clojure +#+begin_src fennel (if-let [val (test)] (print val) :fail) @@ -76,7 +75,7 @@ When test expression is not =nil= or =false=, evaluates the first body form with Expanded form: -#+begin_src clojure +#+begin_src fennel (let [tmp (test)] (if tmp (let [val tmp] @@ -86,7 +85,7 @@ Expanded form: =when-let= is mostly the same, except doesn't have false branch and accepts any amount of forms: -#+begin_src clojure +#+begin_src fennel (when-let [val (test)] (print val) val) @@ -94,7 +93,7 @@ Expanded form: Expanded form: -#+begin_src clojure +#+begin_src fennel (let [tmp (test)] (if tmp (let [val tmp] @@ -105,7 +104,7 @@ Expanded form: ** =if-some= and =when-some= Much like =if-let= and =when-let=, except tests expression for not being =nil=. -#+begin_src clojure +#+begin_src fennel (when-some [val (foo)] (print (.. "val is not nil: " val)) val) @@ -115,7 +114,7 @@ Much like =if-let= and =when-let=, except tests expression for not being =nil=. Clojure's =into= function is implemented as macro, because Fennel has no runtime distinction between =[]= and ={}= tables, since Lua also doesn't feature this feature. However we can do this at compile time. -#+begin_src clojure +#+begin_src fennel (into [1 2 3] [4 5 6]) ;; => [1 2 3 4 5 6] (into [] {:a 1 :b 2 :c 3 :d 4}) ;; => [["d" 4] ["a" 1] ["b" 2] ["c" 3]] (into {} [[:d 4] [:a 1] [:b 2] [:c 3]]) ;; => {:a 1 :b 2 :c 3 :d 4} @@ -126,7 +125,7 @@ Because the type check at compile time it will only respect the type when litera If a variable holding the table, its type is checked at runtime. Empty tables default to sequential ones: -#+begin_src clojure +#+begin_src fennel (local a []) (into a {:a 1 :b 2}) ;; => [["b" 2] ["a" 1]] @@ -136,7 +135,7 @@ Empty tables default to sequential ones: However, if target table is not empty, its type can be deduced: -#+begin_src clojure +#+begin_src fennel (local a {:c 3}) (into a {:a 1 :b 2}) ;; => {:a 1 :b 2 :c 3} @@ -156,7 +155,7 @@ Full set can be examined by requiring the module. =seq= produces a sequential table from any kind of table in linear time. Works mostly like in Clojure, but, since Fennel doesn't have list object, it returns sequential table or =nil=: -#+begin_src clojure +#+begin_src fennel (seq [1 2 3 4 5]) ;; => [1 2 3 4 5] (seq {:a 1 :b 2 :c 3 :d 4}) ;; => [["d" 4] ["a" 1] ["b" 2] ["c" 3]] @@ -171,7 +170,7 @@ See =into= on how to transform such sequence back into associative 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 clojure +#+begin_src fennel (first [1 2 3]) ;; => 1 (first {:host "localhost" :port 2344 :options {}}) ;; => ["host" "localhost"] @@ -180,7 +179,7 @@ As a consequence, associative tables are supported: =last= works the same way, but returns everything except first argument as a table. It also calls =seq= on its argument. -#+begin_src clojure +#+begin_src fennel (rest [1 2 3]) ;; => [2 3] (rest {:host "localhost" :port 2344 :options {}}) ;; => [["port" 2344] ["options" {}]] @@ -195,21 +194,21 @@ This is done both to avoid copying of whole thing, and because Fennel doesn't ha =cons= accepts value as its first argument and table as second, and puts value to the front of the table: -#+begin_src clojure +#+begin_src fennel (cons 1 [2 3]) ;; => [1 2 3] #+end_src =conj= accepts table as its first argument and any amount of values afterwards. It puts values in order given into the table: -#+begin_src clojure +#+begin_src fennel (conj [] 1 2 3) ;; => [1 2 3] #+end_src Both functions return the resulting table, so it is possible to nest calls to both of these. As an example, here's a classic map function: -#+begin_src clojure +#+begin_src fennel (fn map [f col] (if-some [val (first col)] (cons (f val) (map f (rest col))) @@ -224,7 +223,7 @@ Mapping function over table. In Clojure we have a =seq= abstraction, that allows us to use single =mapv= on both vectors, and hash tables. In this library the =seq= function is implemented in a similar way, so you can expect =mapv= to behave similarly to Clojure: -#+begin_src clojure +#+begin_src fennel (fn cube [x] (* x x x)) (mapv cube [1 2 3]) ;; => [1 8 27] @@ -247,7 +246,7 @@ In this library the =seq= function is implemented in a similar way, so you can e Ordinary reducing functions. Work the same as in Clojure, except doesn't yield transducer when only function was passed. -#+begin_src clojure +#+begin_src fennel (fn add [a b] (+ a b)) (reduce add [1 2 3 4 5]) ;; => 15 (reduce add 10 [1 2 3 4 5]) ;; => 25 @@ -256,7 +255,7 @@ Work the same as in Clojure, except doesn't yield transducer when only function =reduce-kv= expects function that accepts 3 arguments and initial value. Then it maps function over the associative map, by passing initial value as a first argument, key as second argument, and value as third argument. -#+begin_src clojure +#+begin_src fennel (reduce-kv (fn [acc key val] (if (or (= key :a) (= key :c)) (+ acc val) acc)) @@ -266,3 +265,26 @@ Then it maps function over the associative map, by passing initial value as a fi #+end_src # LocalWords: Luajit VM arity runtime multi Cljlib fn mapv kv + +** Predicate functions +Set of functions, that are small but useful with =mapv= or =reduce=. +These are commonly used so it makes sense to have that, without defining via anonymous function or =#= shorthand every time. + +- =map?= - check if table is an associative table. + Returns =false= for empty table. +- =seq?= - check if table is a sequential table + Returns =false= for empty table. + +Other predicates are self-explanatory: + +- =nil?= +- =even?= +- =odd?= +- =double?= +- =int?= +- =pos?= +- =pos-int?= +- =neg?= +- =neg-int?= +- =zero?= +- =string?= @@ -1,7 +1,24 @@ (local insert table.insert) (local _unpack (or table.unpack unpack)) (import-macros {: fn*} :macros.fn) -(import-macros {: when-some : if-some : when-let} :macros.core) +(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 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))))) + +;; sequence manipulating functions (fn seq [tbl] "Create sequential table. @@ -19,7 +36,7 @@ If `tbl' is sequential table, leaves it unchanged." (insert res [k v])) (if assoc? res tbl)))) -(macro safe-seq [tbl] +(macro -safe-seq [tbl] `(or (seq ,tbl) [])) (fn first [tbl] @@ -33,19 +50,6 @@ If `tbl' is sequential table, leaves it unchanged." [(_unpack (seq tbl) 2)] [])) -(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* conj "Insert `x' as a last element of indexed table `tbl'. Modifies `tbl'" ([] []) @@ -54,7 +58,7 @@ If `tbl' is sequential table, leaves it unchanged." (doto tbl (insert x)))) ([tbl x & xs] (if (> (length xs) 0) - (let [[y & xs] xs] (conj (conj tbl x) y (_unpack xs))) + (let [[y & xs] xs] (apply conj (conj tbl x) y xs)) (conj tbl x)))) (fn* consj @@ -65,7 +69,7 @@ If `tbl' is sequential table, leaves it unchanged." (doto tbl (insert 1 x)))) ([tbl x & xs] (if (> (length xs) 0) - (let [[y & xs] xs] (consj (consj tbl x) y (_unpack xs))) + (let [[y & xs] xs] (apply consj (consj tbl x) y xs)) (consj tbl x)))) (fn cons [x tbl] @@ -74,6 +78,14 @@ If `tbl' is sequential table, leaves it unchanged." (doto (or tbl []) (insert 1 x)))) +(fn* concat + "Concatenate tables." + ([] nil) + ([x] (-safe-seq x)) + ([x y] (into (-safe-seq x) (-safe-seq y))) + ([x y & xs] + (apply concat (into (-safe-seq x) (-safe-seq y)) xs))) + (fn* reduce "Reduce indexed table using function `f' and optional initial value `val'. @@ -117,7 +129,7 @@ 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 tbl] (var res val) - (each [_ [k v] (pairs (safe-seq tbl))] + (each [_ [k v] (pairs (-safe-seq tbl))] (set res (f res k v))) res) @@ -132,14 +144,14 @@ any of the tables is exhausted. All remaining values are ignored. Returns a table of results." ([f tbl] (local res []) - (each [_ v (ipairs (safe-seq tbl))] + (each [_ v (ipairs (-safe-seq tbl))] (when-some [tmp (f v)] (insert res tmp))) res) ([f t1 t2] (let [res [] - t1 (safe-seq t1) - t2 (safe-seq t2)] + t1 (-safe-seq t1) + t2 (-safe-seq t2)] (var (i1 v1) (next t1)) (var (i2 v2) (next t2)) (while (and i1 i2) @@ -150,9 +162,9 @@ ignored. Returns a table of results." res)) ([f t1 t2 t3] (let [res [] - t1 (safe-seq t1) - t2 (safe-seq t2) - t3 (safe-seq t3)] + t1 (-safe-seq t1) + t2 (-safe-seq t2) + t3 (-safe-seq t3)] (var (i1 v1) (next t1)) (var (i2 v2) (next t2)) (var (i3 v3) (next t3)) @@ -168,10 +180,10 @@ ignored. Returns a table of results." (when (->> tbls (mapv #(~= (next $) nil)) (reduce #(and $1 $2))) - (cons (mapv #(first (safe-seq $)) tbls) (step (mapv rest tbls))))) + (cons (mapv #(first (-safe-seq $)) tbls) (step (mapv rest tbls))))) res []] (each [_ v (ipairs (step (consj tbls t3 t2 t1)))] - (when-some [tmp (f (_unpack v))] + (when-some [tmp (apply f v)] (insert res tmp))) res))) @@ -182,7 +194,65 @@ ignored. Returns a table of results." (cons f (filter pred r)) (filter pred r))))) -(fn kvseq [tbl] + +;; 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 []] (each [k v (pairs tbl)] @@ -194,8 +264,8 @@ ignored. Returns a table of results." ([x] true) ([x y] (if (and (= (type x) :table) (= (type y) :table)) - (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. y k) v)) (kvseq x))) - (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. x k) v)) (kvseq y)))) + (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. y k) v)) (-kvseq x))) + (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq? (. x k) v)) (-kvseq y)))) (= x y))) ([x y & xs] (reduce #(and $1 $2) (eq? x y) (mapv #(eq? x $) xs)))) @@ -211,9 +281,9 @@ ignored. Returns a table of results." ([x] (f (g x))) ([x y] (f (g x y))) ([x y z] (f (g x y z))) - ([x y z & args] (f g x y z (_unpack args))))) + ([x y z & args] (apply f g x y z args)))) ([f g & fs] - (reduce comp (conj [f g] (_unpack fs))))) + (apply reduce comp (conj [f g] fs)))) (fn* every? [pred tbl] @@ -229,7 +299,18 @@ ignored. Returns a table of results." (local not-any? (comp #(not $) some)) (fn complement [f] - #(not (partial f))) + "Takes a function `f' and returns the function that takes the same +amount of arguments as `f', has the same effect, and returns the +oppisite truth value." + (fn* + ([] (not (f))) + ([a] (not (f a))) + ([a b] (not (f a b))) + ([a b & cs] (not (apply f a b cs))))) + +(fn constantly [x] + "Returns a function that takes any number of arguments and returns `x'." + (fn [...] x)) (fn* range "return range of of numbers from `lower' to `upper' with optional `step'." @@ -241,30 +322,40 @@ ignored. Returns a table of results." (insert res i)) res))) -(fn even? [x] - (when-some [x x] - (= (% x 2) 0))) +(fn reverse [tbl] + (when-some [tbl (seq tbl)] + (reduce consj [] tbl))) -(fn odd? [x] - (not (even? x))) - -{: seq - : mapv - : filter - : reduce - : reduce-kv - : conj - : cons +{: 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 - : not-any? + : complement + : constantly : range - : even? - : odd?} + : reverse} diff --git a/core_test.fnl b/core_test.fnl index d0fbb1f..e5fbc22 100644 --- a/core_test.fnl +++ b/core_test.fnl @@ -2,29 +2,42 @@ (import-macros {: into} :macros.core) (import-macros {: assert-eq : assert-ne : assert* : test} :test) -(local {: seq - : mapv - : filter - : reduce - : reduce-kv - : conj - : cons +(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 - : not-any? + : complement + : constantly : range - : even? - : odd?} + : reverse} (require :core)) -(test equality-test +(test equality ;; comparing basetypes (assert-eq 1 1) (assert-ne 1 2) @@ -68,14 +81,14 @@ ;; different. (assert-eq {4 1} [nil nil nil 1])) -(test seq-test +(test seq (assert-eq (seq []) nil) (assert-eq (seq {}) nil) (assert-eq (seq [1]) [1]) (assert-eq (seq [1 2 3]) [1 2 3]) (assert-eq (seq {:a 1}) [["a" 1]])) -(test mapv-test +(test mapv (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})) @@ -96,8 +109,8 @@ ["Bob Smith works as secretary at Happy Days co." "Alice Watson works as chief officer at Coffee With You"])) -(test reduce-test - (fn* ++ +(test reduce + (fn* plus ([] 0) ([a] a) ([a b] (+ a b)) @@ -107,9 +120,9 @@ (set res (+ res v))) res)) - (assert-eq (reduce ++ (range 10)) 45) - (assert-eq (reduce ++ -3 (range 10)) 42) - (assert-eq (reduce ++ 10 nil) 10) + (assert-eq (reduce plus (range 10)) 45) + (assert-eq (reduce plus -3 (range 10)) 42) + (assert-eq (reduce plus 10 nil) 10) (fn mapping [f] @@ -122,10 +135,42 @@ (reduce f (f init (first tbl)) (rest tbl)) init)) - (assert-eq (reduce ++ (range 10)) (reduce- ++ 0 (range 10)))) - -(test filter-test + (assert-eq (reduce plus (range 10)) (reduce- plus 0 (range 10)))) + +(test predicate + (assert* (int? 1)) + (assert* (not (int? 1.1))) + (assert* (pos? 1)) + (assert* (and (not (pos? 0)) (not (pos? -1)))) + (assert* (neg? -1)) + (assert* (and (not (neg? 0)) (not (neg? 1)))) + (assert* (pos-int? 42)) + (assert* (not (pos-int? 4.2))) + (assert* (neg-int? -42)) + (assert* (not (neg-int? -4.2))) + (assert* (string? :s)) + (assert* (double? 3.3)) + (assert* (not (double? 3.0))) + (assert* (map? {:a 1})) + (assert* (not (map? {}))) + (assert* (not (seq? []))) + (assert* (seq? [{:a 1}])) + (assert* (not (seq? {}))) + (assert* (not (seq? {:a 1}))) + (assert* (nil?)) + (assert* (nil? nil)) + (assert* (not (nil? 1)))) + +(test filter (assert-eq (filter even? (range 10)) [0 2 4 6 8]) (assert-eq (filter odd? (range 10)) [1 3 5 7 9]) (assert-eq (filter map? [{:a 1} {5 1} [1 2] [] {}]) [{:a 1} {5 1}]) (assert-eq (filter seq? [{:a 1} {5 1} [1 2] [] {}]) [[1 2]])) + +(test concat + (assert-eq (concat) nil) + (assert-eq (concat []) []) + (assert-eq (concat [1 2 3]) [1 2 3]) + (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]])) diff --git a/macros/core.fnl b/macros/core.fnl index b47f38b..a53eced 100644 --- a/macros/core.fnl +++ b/macros/core.fnl @@ -106,6 +106,7 @@ :else (error "expected table as first argument")) to#)) + {: if-let : when-let : if-some diff --git a/macros_test.fnl b/macros_test.fnl index 349be1b..7d3818a 100644 --- a/macros_test.fnl +++ b/macros_test.fnl @@ -3,7 +3,7 @@ (local {: eq?} (require :core)) ;; required for testing -(test into-test +(test 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]) @@ -24,20 +24,31 @@ 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)) ([expr msg] - `(assert ,expr (.. "assertion failed for " (or ,msg ,(tostring expr)))))) + `(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))) + (let [test-name (sym (.. (tostring name) "-test"))] + `(do (fn ,test-name [] + ,(or docstring nil) + ((or table.unpack unpack) ,body)) + (io.stderr:write (.. "running: " ,(tostring test-name) "\n")) + (,test-name)))) {: assert-eq : assert-ne |