diff options
| -rw-r--r-- | README.org | 57 | ||||
| -rw-r--r-- | core.fnl | 163 | ||||
| -rw-r--r-- | fn.fnl | 42 |
3 files changed, 262 insertions, 0 deletions
diff --git a/README.org b/README.org new file mode 100644 index 0000000..ae75172 --- /dev/null +++ b/README.org @@ -0,0 +1,57 @@ +* Fennel Cljlib +Library for [[https://fennel-lang.org/][Fennel]] language that adds a lot of functions from [[https://clojure.org/][Clojure]] 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. +Therefore some names were changed, but they should be still recognizable. + +Goals of this project are: + +- Have a self contained library, with no dependencies, that provides a set of useful functions from Clojure =core=, +- Be close to the platform, e.g. implement functions in a way that is efficient to use in Lua VM, +- Be well documented library, with good test coverage. + +** Functions +Here are some important functions from the library. +Full set can be examined by requiring the module. + +*** =mapv= and =mapkv= +Mapping functions. +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=. + +#+begin_src fennel + (fn cube [x] (* x x x)) + (mapv cube [1 2 3]) + ;; [1 8 27] + + (mapv #(* $1 $2) [1 2 3] [1 -1 0]) + ;; [1 -2 0] + + (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"] + + (mapkv (fn [k v] [k v]) {:host "localhost" :port 1344}) + ;; [["port" 1344] ["host" "localhost"]] +#+end_src + +*** =reduce= and =reduce-kv= +Ordinary reducing functions. +Work the same as in Clojure, except doesn't yield transducer when only function was passed. + +#+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 +#+end_src + +# LocalWords: Luajit VM diff --git a/core.fnl b/core.fnl new file mode 100644 index 0000000..e09cf67 --- /dev/null +++ b/core.fnl @@ -0,0 +1,163 @@ +(local insert table.insert) +(local _unpack (or table.unpack unpack)) + +(fn first [itbl] + "Return first element of an indexed table." + (. itbl 1)) + + +(fn rest [itbl] + "Returns table of all elements of inexed table but the first one." + (let [[_ & xs] itbl] + xs)) + + +(fn conj [...] + "Insert `x' as a last element of indexed table `itbl'. Modifies `itbl'" + (match (length [...]) + 0 [] + 1 (let [[itbl] [...]] itbl) + 2 (let [[itbl x] [...]] (insert itbl x) itbl) + _ (let [[itbl x & xs] [...]] + (if (> (length xs) 0) + (let [[y & xs] xs] (conj (conj itbl x) y (_unpack xs))) + (conj itbl x))))) + + +(fn consj [...] + "Like conj but joins at the front. Modifies `itbl'." + (match (length [...]) + 0 [] + 1 (let [[itbl] [...]] itbl) + 2 (let [[itbl x] [...]] (insert itbl 1 x) itbl) + _ (let [[itbl x & xs] [...]] + (if (> (length xs) 0) + (let [[y & xs] xs] (consj (consj itbl x) y (_unpack xs))) + (consj itbl x))))) + + +(fn cons [x itbl] + "Insert `x' to `itbl' at the front. Modifies `itbl'." + (doto (or itbl []) + (insert 1 x))) + + +(fn reduce3 [f val [x & xs]] + (if (not (= x nil)) + (reduce3 f (f val x) xs) + val)) + +(fn reduce [...] + "Reduce collection using function of two arguments and optional initial value. + +f should be a function of 2 arguments. If val is not supplied, +returns the result of applying f to the first 2 items in coll, then +applying f to that result and the 3rd item, etc. If coll contains no +items, f must accept no arguments as well, and reduce returns the +result of calling f with no arguments. If coll has only 1 item, it is +returned and f is not called. If val is supplied, returns the result +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." + (match (length [...]) + 2 (let [[f itbl] [...]] + (match (length itbl) + 0 (f) + 1 (. itbl 1) + 2 (f (. itbl 1) (. itbl 2)) + _ (let [[a b & rest] itbl] + (reduce3 f (f a b) rest)))) + 3 (let [[f val itbl] [...]] + (reduce3 f val itbl)) + _ (error "wrong amount of arguments to reduce" 2))) + + +(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'. Applyes +`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. " + (let [res []] + (match (length [...]) + 1 (error "wrong argument amount for mapv" 2) + 2 (let [[f itbl] [...]] + (each [_ v (ipairs itbl)] + (insert res (f v)))) + 3 (let [[f t1 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)))) + 4 (let [[f t1 t2 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)))) + _ (let [[f t1 t2 t3 & tbls] [...] + step (fn step [tbls] + (when (->> tbls + (mapv #(if (next $) true false)) + (reduce #(and $1 $2))) + (cons (mapv first tbls) (step (mapv rest tbls)))))] + (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." + (match (length [...]) + 2 (let [[f kvtbl] [...]] + (var res []) + (each [k v (pairs kvtbl)] + (insert res (f k v))) + res) + _ (let [[f & kvtbls] [...] + itbls []] + (each [_ t (ipairs kvtbls)] + (insert itbls (kvseq t))) + (mapv f (_unpack itbls))))) + + +(fn eq2 [a b] + (if (and (= (type a) "table") (= (type b) "table")) + (and (reduce #(and $1 $2) (mapkv (fn [k v] (eq2 (. b k) v)) a)) + (reduce #(and $1 $2) (mapkv (fn [k v] (eq2 (. a k) v)) b))) + (= a b))) + +(fn eq? [...] + "Deep compare values." + (let [[x & xs] [...]] + (reduce #(and $1 $2) (mapv #(eq2 x $) xs)))) + + +{: mapv + : mapkv + : reduce + : conj + : cons + : first + : rest + : eq?} + +;; (local {: mapv : mapkv : reduce : conj : cons : first : rest : eq?} (require :core)) @@ -0,0 +1,42 @@ +(fn string? [x] + (= (type x) "string")) + +(fn has-amp? [args] + (var res false) + (each [_ s (ipairs args)] + (when (= (tostring s) "&") + (set res true))) + res) + +(fn gen-arity [[args & body]] + (assert-compile (sequence? args) "fn* expects vector as it's parameter list. +Try wrapping arguments in square brackets." args) + (let [arg-length (if (has-amp? args) (sym "_") (length args)) + body (list 'let [args [(sym "...")]] (unpack body))] + (list arg-length body))) + +(fn fn* [name doc? ...] + (assert-compile (not (string? name)) "fn* expects symbol as function name" name) + (let [docstring (if (string? doc?) doc? nil) + args (if (sym? name) + (if (string? doc?) [...] [doc? ...]) + [name doc? ...]) + [x & xs] args] + (if (sequence? x) + ;; Ordinary function + (let [[args & body] args] + (if (sym? name) + `(fn ,name ,args ,docstring ,(unpack body)) + `(fn ,args ,docstring ,(unpack body)))) + ;; Multi-arity function + (list? x) + (let [bodies []] + (each [_ arity (ipairs args)] + (let [[arity body] (gen-arity arity)] + (table.insert bodies arity) + (table.insert bodies body))) + `(fn ,name [...] ,docstring (match (length [...]) ,(unpack bodies))))))) + +{: fn*} + +;; (import-macros {: fn*} :fn) (macrodebug (fn* f ([a] a))) |