summaryrefslogtreecommitdiff
path: root/cljlib.fnl
diff options
context:
space:
mode:
Diffstat (limited to 'cljlib.fnl')
-rw-r--r--cljlib.fnl1286
1 files changed, 0 insertions, 1286 deletions
diff --git a/cljlib.fnl b/cljlib.fnl
deleted file mode 100644
index 5820d57..0000000
--- a/cljlib.fnl
+++ /dev/null
@@ -1,1286 +0,0 @@
-(local core {:_VERSION "0.3.0"
- :_LICENSE "[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)"
- :_COPYRIGHT "Copyright (C) 2020 Andrey Orst"
- :_DESCRIPTION "Fennel-cljlib - functions from Clojure's core.clj implemented on top
-of Fennel.
-
-This library contains a set of functions providing functions that
-behave similarly to Clojure's equivalents. Library itself has nothing
-Fennel specific so it should work, e.g:
-
-``` lua
-Lua 5.3.5 Copyright (C) 1994-2018 Lua.org, PUC-Rio
-> clj = require\"cljlib\"
-> table.concat(clj.mapv(function (x) return x * x end, {1, 2, 3}), \" \")
--- 1 4 9
-```
-
-This example is mapping an anonymous `function` over a table,
-producing new table and concatenating it with `\" \"`.
-
-However this library also provides Fennel-specific set of
-[macros](./cljlib-macros.md), that provides additional facilities like
-`fn*` or `defmulti` which extend the language allowing writing code
-that looks and works mostly like Clojure.
-
-Each function in this library is created with `fn*`, which is a
-special macros for creating multi-arity functions. So when you see
-function signature like `(foo [x])`, this means that this is function
-`foo`, that accepts exactly one argument `x`. In contrary, functions
-created with `fn` will produce `(foo x)` signature (`x` is not inside
-brackets).
-
-Functions, which signatures look like `(foo ([x]) ([x y]) ([x y &
-zs]))`, it is a multi-arity function, which accepts either one, two,
-or three-or-more arguments. Each `([...])` represents different body
-of a function which is chosen by checking amount of arguments passed
-to the function. See [Clojure's doc section on multi-arity
-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)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(fn* core.apply
- "Apply `f` to the argument list formed by prepending intervening
-arguments to `args`, and `f` must support variadic amount of
-arguments.
-
-# Examples
-Applying `print` to different arguments:
-
-``` fennel
-(apply print [1 2 3 4])
-;; prints 1 2 3 4
-(apply print 1 [2 3 4])
-;; => 1 2 3 4
-(apply print 1 2 3 4 5 6 [7 8 9])
-;; => 1 2 3 4 5 6 7 8 9
-```"
- ([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 (empty [])]
- (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)))))
-
-(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))
-
-(local utility-doc-order
- [:apply :add :sub :mul :div :le :lt :ge :gt :inc :dec])
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;; Tests and predicates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(fn fast-table-type [tbl]
- (let [m (getmetatable tbl)]
- (if-let [t (and m (. m :cljlib/type))]
- t)))
-
-(fn* core.map?
- "Check whether `tbl` is an associative table.
-
-Non empty associative tables are tested for two things:
-- `next` returns the key-value pair,
-- key, that is returned by the `next` is not equal to `1`.
-
-Empty tables can't be analyzed with this method, and `map?` will
-return `false`. If you need this test pass for empty table, see
-[`hash-map`](#hash-map) for creating tables that have additional
-metadata attached for this test to work.
-
-# Examples
-Non empty tables:
-
-``` fennel
-(assert (map? {:a 1 :b 2}))
-
-(local some-table {:key :value})
-(assert (map? some-table))
-```
-
-Empty tables:
-
-``` fennel
-(local some-table {})
-(assert (not (map? some-table)))
-```
-
-Empty tables created with [`hash-map`](#hash-map) will pass the test:
-
-``` fennel
-(local some-table (hash-map))
-(assert (map? some-table))
-```"
- [tbl]
- (if (= (type tbl) :table)
- (if-let [t (fast-table-type tbl)]
- (= t :table)
- (let [(k _) (next tbl)]
- (and (not= k nil)
- (not= k 1))))))
-
-(fn* core.vector?
- "Check whether `tbl` is an sequential table.
-
-Non empty sequential tables are tested for two things:
-- `next` returns the key-value pair,
-- key, that is returned by the `next` is equal to `1`.
-
-Empty tables can't be analyzed with this method, and `vector?` will
-always return `false`. If you need this test pass for empty table,
-see [`vector`](#vector) for creating tables that have additional
-metadata attached for this test to work.
-
-# Examples
-Non empty vector:
-
-``` fennel
-(assert (vector? [1 2 3 4]))
-
-(local some-table [1 2 3])
-(assert (vector? some-table))
-```
-
-Empty tables:
-
-``` fennel
-(local some-table [])
-(assert (not (vector? some-table)))
-```
-
-Empty tables created with [`vector`](#vector) will pass the test:
-
-``` fennel
-(local some-table (vector))
-(assert (vector? some-table))
-```"
- [tbl]
- (if (= (type tbl) :table)
- (if-let [t (fast-table-type tbl)]
- (= t :seq)
- (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."
- ([] true)
- ([x] (= x nil)))
-
-(fn* core.zero?
- "Test if value is equal to zero."
- [x]
- (= x 0))
-
-(fn* core.pos?
- "Test if `x` is greater than zero."
- [x]
- (> x 0))
-
-(fn* core.neg?
- "Test if `x` is less than zero."
- [x]
- (< x 0))
-
-(fn* core.even?
- "Test if value is even."
- [x]
- (= (% x 2) 0))
-
-(fn* core.odd?
- "Test if value is odd."
- [x]
- (not (even? x)))
-
-(fn* core.string?
- "Test if `x` is a string."
- [x]
- (= (type x) :string))
-
-(fn* core.boolean?
- "Test if `x` is a Boolean"
- [x]
- (= (type x) :boolean))
-
-(fn* core.true?
- "Test if `x` is `true`"
- [x]
- (= x true))
-
-(fn* core.false?
- "Test if `x` is `false`"
- [x]
- (= x false))
-
-(fn* core.int?
- "Test if `x` is a number without floating point data.
-
-Number is rounded with `math.floor` and compared with original number."
- [x]
- (and (= (type x) :number)
- (= x (math.floor x))))
-
-(fn* core.pos-int?
- "Test if `x` is a positive integer."
- [x]
- (and (int? x)
- (pos? x)))
-
-(fn* core.neg-int?
- "Test if `x` is a negetive integer."
- [x]
- (and (int? x)
- (neg? x)))
-
-(fn* core.double?
- "Test if `x` is a number with floating point data."
- [x]
- (and (= (type x) :number)
- (not= x (math.floor x))))
-
-(fn* core.empty?
- "Check if collection is empty."
- [x]
- (match (type x)
- :table (= (next x) nil)
- :string (= x "")
- _ (error "empty?: unsupported collection")))
-
-(fn* core.not-empty
- "If `x` is empty, returns `nil`, otherwise `x`."
- [x]
- (if (not (empty? x))
- x))
-
-(local predicate-doc-order
- [:map? :vector? :multifn? :set? :nil? :zero? :pos?
- :neg? :even? :odd? :string? :boolean? :true? :false?
- :int? :pos-int? :neg-int? :double? :empty? :not-empty])
-
-
-;;;;;;;;;;;;;;;;;;;;;; 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.
-
-Transforms original table to sequential table of key value pairs
-stored as sequential tables in linear time. If `col` is an
-associative table, returns sequential table of vectors with key and
-value. If `col` is sequential table, returns its shallow copy.
-
-# Examples
-Sequential tables remain as is:
-
-``` fennel
-(seq [1 2 3 4])
-;; [1 2 3 4]
-```
-
-Associative tables are transformed to format like this `[[key1 value1]
-... [keyN valueN]]` and order is non deterministic:
-
-``` fennel
-(seq {:a 1 :b 2 :c 3})
-;; [[:b 2] [:a 1] [:c 3]]
-```
-
-See `into` macros for transforming this back to associative table.
-Additionally you can use [`conj`](#conj) and [`apply`](#apply) with
-[`hash-map`](#hash-map):
-
-``` fennel
-(apply conj (hash-map) [:c 3] [[:a 1] [:b 2]])
-;; => {:a 1 :b 2 :c 3}
-```"
- [col]
- (let [res (empty [])]
- (match (type col)
- :table (let [m (or (getmetatable col) {})]
- (when-some [_ ((or m.cljlib/next next) col)]
- (var assoc? false)
- (let [assoc-res (empty [])]
- (each [k v (pairs col)]
- (if (and (not assoc?)
- (map? col))
- (set assoc? true))
- (insert res v)
- (insert assoc-res [k v]))
- (if assoc? assoc-res res))))
- :string (let [char utf8.char]
- (each [_ b (utf8.codes col)]
- (insert res (char b)))
- res)
- :nil nil
- _ (error (.. "expected table, string or nil") 2))))
-
-(fn* core.kvseq
- "Transforms any table kind to key-value sequence."
- [tbl]
- (let [res (empty [])]
- (each [k v (pairs tbl)]
- (insert res [k v]))
- res))
-
-(fn* core.first
- "Return first element of a table. Calls `seq` on its argument."
- [col]
- (when-some [col (seq col)]
- (. col 1)))
-
-(fn* core.rest
- "Returns table of all elements of a table but the first one. Calls
- `seq` on its argument."
- [col]
- (if-some [col (seq col)]
- (vector (_unpack col 2))
- (empty [])))
-
-(fn* core.last
- "Returns the last element of a table. Calls `seq` on its argument."
- [col]
- (when-some [col (seq col)]
- (var (i v) (next col))
- (while i
- (local (_i _v) (next col i))
- (if _i (set v _v))
- (set i _i))
- v))
-
-(fn* core.butlast
- "Returns everything but the last element of a table as a new
- table. Calls `seq` on its argument."
- [col]
- (when-some [col (seq col)]
- (table.remove col (length col))
- (when (not (empty? col))
- col)))
-
-(fn* core.conj
- "Insert `x` as a last element of a table `tbl`.
-
-If `tbl` is a sequential table or empty table, inserts `x` and
-optional `xs` as final element in the table.
-
-If `tbl` is an associative table, that satisfies [`map?`](#map?) test,
-insert `[key value]` pair into the table.
-
-Mutates `tbl`.
-
-# Examples
-Adding to sequential tables:
-
-``` fennel
-(conj [] 1 2 3 4)
-;; => [1 2 3 4]
-(conj [1 2 3] 4 5)
-;; => [1 2 3 4 5]
-```
-
-Adding to associative tables:
-
-``` fennel
-(conj {:a 1} [:b 2] [:c 3])
-;; => {:a 1 :b 2 :c 3}
-```
-
-Note, that passing literal empty associative table `{}` will not work:
-
-``` fennel
-(conj {} [:a 1] [:b 2])
-;; => [[:a 1] [:b 2]]
-(conj (hash-map) [:a 1] [:b 2])
-;; => {:a 1 :b 2}
-```
-
-See [`hash-map`](#hash-map) for creating empty associative tables."
- ([] (empty []))
- ([tbl] tbl)
- ([tbl x]
- (when-some [x x]
- (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] [...]]
- (if (nil? x) tbl
- (consj (doto tbl (insert 1 x)) (_unpack xs)))))
-
-(fn* core.cons
- "Insert `x` to `tbl` at the front. Calls [`seq`](#seq) on `tbl`."
- [x tbl]
- (if-some [x x]
- (doto (or (seq tbl) (empty []))
- (insert 1 x))
- tbl))
-
-(fn* core.concat
- "Concatenate tables."
- ([] nil)
- ([x] (or (seq x) (empty [])))
- ([x y] (let [to (or (seq x) (empty []))
- from (or (seq y) (empty []))]
- (each [_ v (ipairs from)]
- (insert to v))
- to))
- ([x y & xs]
- (apply concat (concat x y) xs)))
-
-(fn* core.reduce
- "Reduce collection `col` using function `f` and optional initial value `val`.
-
-`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. Calls `seq` on `col`.
-
-Early termination is possible with the use of [`reduced`](#reduced)
-function.
-
-# Examples
-Reduce sequence of numbers with [`add`](#add)
-
-``` fennel
-(reduce add [1 2 3 4])
-;; => 10
-(reduce add 10 [1 2 3 4])
-;; => 20
-```
-
-"
- ([f col]
- (let [col (or (seq col) (empty []))]
- (match (length col)
- 0 (f)
- 1 (. col 1)
- 2 (f (. col 1) (. col 2))
- _ (let [[a b & rest] col]
- (reduce f (f a b) rest)))))
- ([f val col]
- (if-some [reduced (when-some [m (getmetatable val)]
- (and m.cljlib/reduced
- (= m.cljlib/reduced.status :ready)
- m.cljlib/reduced.val))]
- reduced
- (let [col (or (seq col) (empty []))]
- (let [[x & xs] col]
- (if (nil? x)
- val
- (reduce f (f val x) xs)))))))
-
-(fn* core.reduced
- "Wraps `x` in such a way so [`reduce`](#reduce) will terminate early
-with this value.
-
-# Examples
-Stop reduction is result is higher than `10`:
-
-``` fennel
-(reduce (fn [res x]
- (if (>= res 10)
- (reduced res)
- (+ res x)))
- [1 2 3])
-;; => 6
-
-(reduce (fn [res x]
- (if (>= res 10)
- (reduced res)
- (+ res x)))
- [1 2 3 4 :nil])
-;; => 10
-```
-
-Note that in second example we had `:nil` in the array, which is not a
-valid number, but we've terminated right before we've reached it."
- [x]
- (setmetatable
- {} {:cljlib/reduced {:status :ready
- :val x}}))
-
-(fn* core.reduce-kv
- "Reduces an associative table using function `f` and initial value `val`.
-
-`f` should be a function of 3 arguments. Returns the result of
-applying `f` to `val`, the first key and the first value in `tbl`,
-then applying `f` to that result and the 2nd key and value, etc. If
-`tbl` contains no entries, returns `val` and `f` is not called. Note
-that reduce-kv is supported on sequential tables and strings, where
-the keys will be the ordinals.
-
-Early termination is possible with the use of [`reduced`](#reduced)
-function.
-
-# Examples
-Reduce associative table by adding values from all keys:
-
-``` fennel
-(local t {:a1 1
- :b1 2
- :a2 2
- :b2 3})
-
-(reduce-kv #(+ $1 $3) 0 t)
-;; => 8
-```
-
-Reduce table by adding values from keys that start with letter `a`:
-
-``` fennel
-(local t {:a1 1
- :b1 2
- :a2 2
- :b2 3})
-
-(reduce-kv (fn [res k v] (if (= (string.sub k 1 1) :a) (+ res v) res))
- 0 t)
-;; => 3
-```"
- [f val tbl]
- (var res val)
- (each [_ [k v] (ipairs (or (kvseq tbl) (empty [])))]
- (set res (f res k v))
- (match (getmetatable res)
- m (if (and m.cljlib/reduced
- (= m.cljlib/reduced.status :ready))
- (do (set res m.cljlib/reduced.val)
- (lua :break)))))
- res)
-
-(fn* core.mapv
- "Maps function `f` over one or more collections.
-
-Accepts arbitrary amount of collections, calls `seq` on each of it.
-Function `f` must take the same amount of arguments 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 sequential table of results.
-
-# Examples
-Map `string.upcase` over the string:
-
-``` fennel
-(mapv string.upper \"string\")
-;; => [\"S\" \"T\" \"R\" \"I\" \"N\" \"G\"]
-```
-
-Map [`mul`](#mul) over two tables:
-
-``` fennel
-(mapv mul [1 2 3 4] [1 0 -1])
-;; => [1 0 -3]
-```
-
-Basic `zipmap` implementation:
-
-``` fennel
-(fn zipmap [keys vals]
- (into {} (mapv vector keys vals)))
-
-(zipmap [:a :b :c] [1 2 3 4])
-;; => {:a 1 :b 2 :c 3}
-```"
- ([f col]
- (local res (empty []))
- (each [_ v (ipairs (or (seq col) (empty [])))]
- (when-some [tmp (f v)]
- (insert res tmp)))
- res)
- ([f col1 col2]
- (let [res (empty [])
- col1 (or (seq col1) (empty []))
- col2 (or (seq col2) (empty []))]
- (var (i1 v1) (next col1))
- (var (i2 v2) (next col2))
- (while (and i1 i2)
- (when-some [tmp (f v1 v2)]
- (insert res tmp))
- (set (i1 v1) (next col1 i1))
- (set (i2 v2) (next col2 i2)))
- res))
- ([f col1 col2 col3]
- (let [res (empty [])
- col1 (or (seq col1) (empty []))
- col2 (or (seq col2) (empty []))
- col3 (or (seq col3) (empty []))]
- (var (i1 v1) (next col1))
- (var (i2 v2) (next col2))
- (var (i3 v3) (next col3))
- (while (and i1 i2 i3)
- (when-some [tmp (f v1 v2 v3)]
- (insert res tmp))
- (set (i1 v1) (next col1 i1))
- (set (i2 v2) (next col2 i2))
- (set (i3 v3) (next col3 i3)))
- res))
- ([f col1 col2 col3 & cols]
- (let [step (fn step [cols]
- (if (->> cols
- (mapv #(not= (next $) nil))
- (reduce #(and $1 $2)))
- (cons (mapv #(. (or (seq $) (empty [])) 1) cols) (step (mapv #(do [(_unpack $ 2)]) cols)))
- (empty [])))
- res (empty [])]
- (each [_ v (ipairs (step (consj cols col3 col2 col1)))]
- (when-some [tmp (apply f v)]
- (insert res tmp)))
- res)))
-
-(fn* core.filter
- "Returns a sequential table of the items in `col` for which `pred`
- returns logical true."
- [pred col]
- (if-let [col (seq col)]
- (let [f (. col 1)
- r [(_unpack col 2)]]
- (if (pred f)
- (cons f (filter pred r))
- (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)))
-
-(local sequence-doc--order [:vector :seq :kvseq :first :rest :last :butlast
- :conj :disj :cons :concat :reduce :reduced :reduce-kv
- :mapv :filter :every? :some :not-any? :range :reverse])
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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
- "Compose functions."
- ([] identity)
- ([f] f)
- ([f g]
- (fn*
- ([] (f (g)))
- ([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))))))
- ([f g & fs]
- (reduce comp (consj fs g f))))
-
-(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
-oppisite truth value."
- [f]
- (fn*
- ([] (not (f)))
- ([a] (not (f a)))
- ([a b] (not (f a b)))
- ([a b & cs] (not (apply f a b cs)))))
-
-(fn* core.constantly
- "Returns a function that takes any number of arguments and returns `x`."
- [x]
- (fn [...] x))
-
-(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))))))
-
-(local function-manipulation-doc-order
- [:identity :comp :complement :constantly :memoize])
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hash table extras ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(fn* core.assoc
- "Associate key `k` with value `v` in `tbl`."
- ([tbl k v]
- (setmetatable
- (doto tbl (tset k v))
- {:cljlib/type :table}))
- ([tbl k v & kvs]
- (assert (= (% (length kvs) 2) 0)
- (.. "no value supplied for key " (. kvs (length kvs))))
- (tset tbl k v)
- (var [k v] [nil nil])
- (var (i k) (next kvs))
- (while i
- (set (i v) (next kvs i))
- (tset tbl k v)
- (set (i k) (next kvs i)))
- (setmetatable tbl {:cljlib/type :table})))
-
-(fn* core.hash-map
- "Create associative table from keys and values"
- ([] (empty {}))
- ([& kvs] (apply assoc {} kvs)))
-
-(fn* core.get
- "Get value from the table by accessing it with a `key`.
-Accepts additional `not-found` as a marker to return if value wasn't
-found in the table."
- ([tbl key] (get tbl key nil))
- ([tbl key not-found]
- (if-some [res (. tbl key)]
- res
- not-found)))
-
-(fn* core.get-in
- "Get value from nested set of tables by providing key sequence.
-Accepts additional `not-found` as a marker to return if value wasn't
-found in the table."
- ([tbl keys] (get-in tbl keys nil))
- ([tbl keys not-found]
- (var res tbl)
- (var t tbl)
- (each [_ k (ipairs keys)]
- (if-some [v (. t k)]
- (set [res t] [v v])
- (set res not-found)))
- res))
-
-(fn* core.keys
- "Returns a sequence of the table's keys, in the same order as [`seq`](#seq)."
- [tbl]
- (let [res []]
- (each [k _ (pairs tbl)]
- (insert res k))
- res))
-
-(fn* core.vals
- "Returns a sequence of the table's values, in the same order as [`seq`](#seq)."
- [tbl]
- (let [res []]
- (each [_ v (pairs tbl)]
- (insert res v))
- res))
-
-(fn* core.find
- "Returns the map entry for `key`, or `nil` if key not present."
- [tbl key]
- (when-some [v (. tbl key)]
- [key v]))
-
-(fn* core.dissoc
- "Remove `key` from table `tbl`."
- ([tbl] tbl)
- ([tbl key]
- (doto tbl (tset key nil)))
- ([tbl key & keys]
- (apply dissoc (dissoc tbl key) keys)))
-
-(local hash-table-doc-order
- [:assoc :hash-map :get :get-in :keys :vals :find :dissoc])
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Multimethods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(fn* core.remove-method
- "Remove method from `multifn` for given `dispatch-val`."
- [multifn dispatch-val]
- (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]
- (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]
- (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]
- (if (multifn? multifn)
- (or (. multifn dispatch-val)
- (. multifn :default))
- (error (.. (tostring multifn) " is not a multifn") 2)))
-
-(local multimethods-doc-order
- [:remove-method :remove-all-methods :methods :get-method])
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Sets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(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 ordered-set-newindex [Set]
- "`__newindex` metamethod for ordered-set."
- (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 hash-set-newindex [Set]
- "`__newindex` metamethod for hash-set."
- (fn [t k v]
- (if (= nil v)
- (each [key _ (pairs Set)]
- (when (eq key k)
- (tset Set key nil)
- (lua :break)))
- (if (not (. Set v))
- (tset Set v true)))))
-
-(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)))
-
-;; Sets are bootstrapped upon previous functions.
-
-(fn* core.ordered-set
- "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
-```"
- [& xs]
- (let [Set (setmetatable {} {:__index deep-index})
- set-ipairs (ordered-set-ipairs Set)]
- (var i 1)
- (each [_ val (ipairs xs)]
- (when (not (. Set val))
- (tset Set val i)
- (set i (+ 1 i))))
- (setmetatable {}
- {:cljlib/type :cljlib/ordered-set
- :cljlib/next #(next Set $2)
- :__eq set-eq
- :__call #(if (. Set $2) $2)
- :__len (set-length Set)
- :__index #(match $2
- :cljlib/empty #(ordered-set)
- _ (if (. Set $2) $2))
- :__newindex (ordered-set-newindex Set)
- :__ipairs set-ipairs
- :__pairs set-ipairs
- :__name "ordered set"
- :__fennelview viewset})))
-
-(fn* core.hash-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]
- (let [Set (setmetatable {} {:__index deep-index})
- set-ipairs (hash-set-ipairs Set)]
- (each [_ val (ipairs xs)]
- (when (not (. Set val))
- (tset Set val true)))
- (setmetatable {}
- {:cljlib/type :cljlib/hash-set
- :cljlib/next #(next Set $2)
- :__eq set-eq
- :__call #(if (. Set $2) $2)
- :__len (set-length Set)
- :__index #(match $2
- :cljlib/empty #(hash-set)
- _ (if (. Set $2) $2))
- :__newindex (hash-set-newindex Set)
- :__ipairs set-ipairs
- :__pairs set-ipairs
- :__name "hash set"
- :__fennelview viewset})))
-
-(local set-doc-order
- [:ordered-set :hash-set])
-
-
-(doto core
- (tset :_DOC_ORDER (concat utility-doc-order
- [:eq]
- predicate-doc-order
- sequence-doc--order
- function-manipulation-doc-order
- hash-table-doc-order
- multimethods-doc-order
- set-doc-order)))
-
-;; LocalWords: cljlib Clojure's clj lua PUC mapv concat Clojure fn zs
-;; LocalWords: defmulti multi arity eq metadata prepending variadic
-;; LocalWords: args tbl LocalWords memoized referentially
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-02 15:05:36 +0000