diff options
Diffstat (limited to 'init.fnl')
| -rw-r--r-- | init.fnl | 2993 |
1 files changed, 1893 insertions, 1100 deletions
@@ -1,94 +1,91 @@ -(local module-info - {:_MODULE_NAME "cljlib" - :_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 on Lua, 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](./macros.md), that provides additional facilities like -`defn' or `defmulti' which extend the language allowing writing code -that looks and works mostly like Clojure. - -Each function in this library is created with `defn', 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). - -## Compatibility -This library is mainly developed with Lua 5.4, and tested against -Lua 5.2, 5.3, 5.4, and LuaJIT 2.1.0-beta3. Note, that in lua 5.2 and -LuaJIT equality semantics are a bit different from Lua 5.3 and Lua 5.4. -Main difference is that when comparing two tables, they must have -exactly the same `__eq` metamethods, so comparing hash sets with hash -sets will work, but comparing sets with other tables works only in -Lua5.3+. Another difference is that Lua 5.2 and LuaJIT don't have -inbuilt UTF-8 library, therefore `seq' function will not work for -non-ASCII strings."}) - -(local core {}) - -(local insert table.insert) -(local _unpack (or table.unpack _G.unpack)) - -(import-macros {: defn : into : empty - : when-let : if-let : when-some : if-some} - ;; tricky relative require to make it work from - ;; anywhere as (require :cljlib) and as well - ;; (import-macros cljm :cljlib) - (if ... (if (= ... :init) :init-macros ...) :init-macros)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn core.apply - "Apply `f' to the argument list formed by prepending intervening -arguments to `args', and `f' must support variadic amount of +(import-macros + {: defn + : defn- + : ns + : def + : fn* + : if-let + : if-some + : cond} + (if ... (if (= ... :init) :init-macros ...) :init-macros)) + +(ns core + "MIT License + +Copyright (c) 2022 Andrey Listopadov + +Permission is hereby granted‚ free of charge‚ to any person obtaining a copy +of this software and associated documentation files (the “Software”)‚ to deal +in the Software without restriction‚ including without limitation the rights +to use‚ copy‚ modify‚ merge‚ publish‚ distribute‚ sublicense‚ and/or sell +copies of the Software‚ and to permit persons to whom the Software is +furnished to do so‚ subject to the following conditions： + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED “AS IS”‚ WITHOUT WARRANTY OF ANY KIND‚ EXPRESS OR +IMPLIED‚ INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY‚ +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM‚ DAMAGES OR OTHER +LIABILITY‚ WHETHER IN AN ACTION OF CONTRACT‚ TORT OR OTHERWISE‚ ARISING FROM‚ +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE." + (:require [lazy-seq :as lazy] + [itable :as itable])) + +;;; Utility functions + +(fn unpack* [x ...] + (if (core.seq? x) + (lazy.unpack x) + (itable.unpack x ...))) + +(fn pack* [...] + (doto [...] (tset :n (select "#" ...)))) + +(fn pairs* [t] + (match (getmetatable t) + {:__pairs p} (p t) + _ (pairs t))) + +(fn ipairs* [t] + (match (getmetatable t) + {:__ipairs i} (i t) + _ (ipairs t))) + +(fn length* [t] + (match (getmetatable t) + {:__len l} (l t) + _ (length t))) + +(defn apply + "Apply `f` to the argument list formed by prepending intervening +arguments to `args`, and `f` must support variadic amount of arguments. # Examples -Applying `add' to different amount of arguments: +Applying `add` to different amount of arguments: ``` fennel (assert-eq (apply add [1 2 3 4]) 10) (assert-eq (apply add 1 [2 3 4]) 10) (assert-eq (apply add 1 2 3 4 5 6 [7 8 9]) 45) ```" - ([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 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 [] - len (- (length args) 1)] + len (- (length* args) 1)] (for [i 1 len] (tset flat-args i (. args i))) - (each [i a (ipairs (. args (+ len 1)))] + (each [i a (pairs* (. args (+ len 1)))] (tset flat-args (+ i len) a)) - (f a b c d (_unpack flat-args))))) + (f a b c d (unpack* flat-args))))) -(defn core.add +(defn add "Sum arbitrary amount of numbers." ([] 0) ([a] a) @@ -97,7 +94,7 @@ Applying `add' to different amount of arguments: ([a b c d] (+ a b c d)) ([a b c d & rest] (apply add (+ a b c d) rest))) -(defn core.sub +(defn sub "Subtract arbitrary amount of numbers." ([] 0) ([a] (- a)) @@ -106,7 +103,7 @@ Applying `add' to different amount of arguments: ([a b c d] (- a b c d)) ([a b c d & rest] (apply sub (- a b c d) rest))) -(defn core.mul +(defn mul "Multiply arbitrary amount of numbers." ([] 1) ([a] a) @@ -115,7 +112,7 @@ Applying `add' to different amount of arguments: ([a b c d] (* a b c d)) ([a b c d & rest] (apply mul (* a b c d) rest))) -(defn core.div +(defn div "Divide arbitrary amount of numbers." ([a] (/ 1 a)) ([a b] (/ a b)) @@ -123,7 +120,7 @@ Applying `add' to different amount of arguments: ([a b c d] (/ a b c d)) ([a b c d & rest] (apply div (/ a b c d) rest))) -(defn core.le +(defn le "Returns true if nums are in monotonically non-decreasing order" ([a] true) ([a b] (<= a b)) @@ -133,7 +130,7 @@ Applying `add' to different amount of arguments: (<= b c)) false))) -(defn core.lt +(defn lt "Returns true if nums are in monotonically decreasing order" ([a] true) ([a b] (< a b)) @@ -143,7 +140,7 @@ Applying `add' to different amount of arguments: (< b c)) false))) -(defn core.ge +(defn ge "Returns true if nums are in monotonically non-increasing order" ([a] true) ([a b] (>= a b)) @@ -153,7 +150,7 @@ Applying `add' to different amount of arguments: (>= b c)) false))) -(defn core.gt +(defn gt "Returns true if nums are in monotonically increasing order" ([a] true) ([a b] (> a b)) @@ -163,521 +160,1363 @@ Applying `add' to different amount of arguments: (> b c)) false))) -(defn core.inc "Increase number `x' by one" [x] (+ x 1)) -(defn core.dec "Decrease number `x' 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] - (-?> tbl getmetatable (. :cljlib/type))) - -(defn 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' for creating tables that have additional -metadata attached for this test to work. - -# Examples -Non empty tables: - -``` fennel -(assert-is (map? {:a 1 :b 2})) - -(local some-table {:key :value}) -(assert-is (map? some-table)) -``` - -Empty tables: - -``` fennel -(local some-table {}) -(assert-not (map? some-table)) -``` - -Empty tables created with `hash-map' will pass the test: - -``` fennel -(local some-table (hash-map)) -(assert-is (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)))))) +(defn inc + "Increase number `x` by one" + [x] + (+ x 1)) -(defn core.vector? - "Check whether `tbl' is an sequential table. +(defn dec + "Decrease number `x` by one" + [x] + (- x 1)) -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`. +(defn class + "Return cljlib type of the `x`, or lua type." + [x] + (match (type x) + :table (match (getmetatable x) + {:cljlib/type t} t + _ :table) + t t)) -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' for creating tables that have additional -metadata attached for this test to work. +(defn constantly + "Returns a function that takes any number of arguments and returns `x`." + [x] + (fn [] x)) -# Examples -Non empty vector: +(defn 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))))) -``` fennel -(assert-is (vector? [1 2 3 4])) +(defn identity + "Returns its argument." + [x] + x) -(local some-table [1 2 3]) -(assert-is (vector? some-table)) -``` +(defn 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 (apply g x y z args))))) + ([f g & fs] + (core.reduce comp (core.cons f (core.cons g fs))))) -Empty tables: +(defn eq + "Comparison function. -``` fennel -(local some-table []) -(assert-not (vector? some-table)) -``` +Accepts arbitrary amount of values, and does the deep comparison. If +values implement `__eq` metamethod, tries to use it, by checking if +first value is equal to second value, and the second value is equal to +the first value. If values are not equal and are tables does the deep +comparison. Tables as keys are supported." + ([] true) + ([_] true) + ([a b] + (if (and (= a b) (= b a)) + true + (= :table (type a) (type b)) + (do (var (res count-a) (values true 0)) + (each [k v (pairs* a) :until (not res)] + (set res (eq v (do (var (res done) (values nil nil)) + (each [k* v (pairs* b) :until done] + (when (eq k* k) + (set (res done) (values v true)))) + res))) + (set count-a (+ count-a 1))) + (when res + (let [count-b (accumulate [res 0 _ _ (pairs* b)] + (+ res 1))] + (set res (= count-a count-b)))) + res) + false)) + ([a b & cs] + (and (eq a b) (apply eq b cs)))) -Empty tables created with `vector' will pass the test: +(fn deep-index [tbl key] + "This function uses the `eq` function to compare keys of the given +table `tbl` and the given `key`. Several other functions also reuse +this indexing method, such as sets." + (accumulate [res nil + k v (pairs* tbl) + :until res] + (when (eq k key) + v))) + +(fn deep-newindex [tbl key val] + "This function uses the `eq` function to compare keys of the given +table `tbl` and the given `key`. If the key is found it's being +set, if not a new key is set." + (var done false) + (when (= :table (type key)) + (each [k _ (pairs* tbl) :until done] + (when (eq k key) + (rawset tbl k val) + (set done true)))) + (when (not done) + (rawset tbl key val))) + +(defn 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 deep-index})] + (fn* [& args] + (match (. memo args) + res (unpack* res 1 res.n) + _ (let [res (pack* (f ...))] + (tset memo args res) + (unpack* res 1 res.n)))))) -``` fennel -(local some-table (vector)) -(assert-is (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)))))) - -(defn core.multifn? - "Test if `mf' is an instance of `multifn'. +(defn deref + "Dereference an object." + [x] + (match (getmetatable x) + {:cljlib/deref f} (f x) + _ (error "object doesn't implement cljlib/deref metamethod" 2))) -`multifn' is a special kind of table, created with `defmulti' macros -from `macros.fnl'." - [mf] - (= (. (or (getmetatable mf) {}) :cljlib/type) :multifn)) +(defn empty + "Get an empty variant of a given collection." + [x] + (match (getmetatable x) + {:cljlib/empty f} (f) + _ (match (type x) + :table [] + :string "" + _ (error (.. "don't know how to create empty variant of type " _))))) -(defn core.set? - "Test if `s` is either instance of a `hash-set' or `ordered-set'." - [s] - (match (. (or (getmetatable s) {}) :cljlib/type) - :cljlib/ordered-set :cljlib/ordered-set - :cljlib/hash-set :cljlib/hash-set - _ false)) +;;;Tests and predicates -(defn core.nil? - "Test if `x' is nil." +(defn nil? + "Test if `x` is nil." ([] true) ([x] (= x nil))) -(defn core.zero? - "Test if `x' is equal to zero." +(defn zero? + "Test if `x` is equal to zero." [x] (= x 0)) -(defn core.pos? - "Test if `x' is greater than zero." +(defn pos? + "Test if `x` is greater than zero." [x] (> x 0)) -(defn core.neg? - "Test if `x' is less than zero." +(defn neg? + "Test if `x` is less than zero." [x] (< x 0)) -(defn core.even? - "Test if `x' is even." +(defn even? + "Test if `x` is even." [x] (= (% x 2) 0)) -(defn core.odd? - "Test if `x' is odd." +(defn odd? + "Test if `x` is odd." [x] (not (even? x))) -(defn core.string? - "Test if `x' is a string." +(defn string? + "Test if `x` is a string." [x] (= (type x) :string)) -(defn core.boolean? - "Test if `x' is a Boolean" +(defn boolean? + "Test if `x` is a Boolean" [x] (= (type x) :boolean)) -(defn core.true? - "Test if `x' is `true'" +(defn true? + "Test if `x` is `true`" [x] (= x true)) -(defn core.false? - "Test if `x' is `false'" +(defn false? + "Test if `x` is `false`" [x] (= x false)) -(defn core.int? - "Test if `x' is a number without floating point data. +(defn int? + "Test if `x` is a number without floating point data. -Number is rounded with `math.floor' and compared with original number." +Number is rounded with `math.floor` and compared with original number." [x] (and (= (type x) :number) (= x (math.floor x)))) -(defn core.pos-int? - "Test if `x' is a positive integer." +(defn pos-int? + "Test if `x` is a positive integer." [x] (and (int? x) (pos? x))) -(defn core.neg-int? - "Test if `x' is a negative integer." +(defn neg-int? + "Test if `x` is a negative integer." [x] (and (int? x) (neg? x))) -(defn core.double? - "Test if `x' is a number with floating point data." +(defn double? + "Test if `x` is a number with floating point data." [x] (and (= (type x) :number) (not= x (math.floor x)))) -(defn core.empty? +(defn empty? "Check if collection is empty." [x] (match (type x) - :table (= (next x) nil) + :table + (match (getmetatable x) + {:cljlib/type :seq} + (nil? (core.seq x)) + (where (or nil {:cljlib/type nil})) + (let [(next*) (pairs* x)] + (= (next* x) nil))) :string (= x "") + :nil true _ (error "empty?: unsupported collection"))) -(defn core.not-empty - "If `x' is empty, returns `nil', otherwise `x'." +(defn 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]) +(defn map? + "Check whether `x` is an associative table. + +Non-empty tables are tested by calling `next`. If the length of the +table is greater than zero, the last integer key is passed to the +`next`, and if `next` returns a key, the table is considered +associative. If the length is zero, `next` is called with what `paris` +returns for the table, and if the key is returned, table is considered +associative. + +Empty tables can't be analyzed with this method, and `map?` will +always return `false`. If you need this test pass for empty table, +see `hash-map` for creating tables that have additional metadata +attached for this test to work. + +# Examples +Non empty map: + +``` fennel +(assert-is (map? {:a 1 :b 2})) +``` + +Empty tables don't pass the test: + +``` fennel +(assert-not (map? {})) +``` + +Empty tables created with `hash-map` will pass the test: +``` fennel +(assert-is (map? (hash-map))) +```" + [x] + (if (= :table (type x)) + (match (getmetatable x) + {:cljlib/type :hash-map} true + {:cljlib/type :sorted-map} true + (where (or nil {:cljlib/type nil})) + (let [len (length* x) + (nxt t k) (pairs* x)] + (not= nil (nxt t (if (= len 0) k len)))) + _ false) + false)) + +(defn vector? + "Check whether `tbl` is an sequential table. -;;;;;;;;;;;;;;;;;;;;;; Sequence manipulation functions ;;;;;;;;;;;;;;;;;;;;;;;;; +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`. -(defn core.vector +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` for creating tables that have additional +metadata attached for this test to work. + +# Examples +Non empty vector: + +``` fennel +(assert-is (vector? [1 2 3 4])) +``` + +Empty tables don't pass the test: + +``` fennel +(assert-not (vector? [])) +``` + +Empty tables created with `vector` will pass the test: + +``` fennel +(assert-is (vector? (vector))) +```" + [x] + (if (= :table (type x)) + (match (getmetatable x) + {:cljlib/type :vector} true + (where (or nil {:cljlib/type nil})) + (let [len (length* x) + (nxt t k) (pairs* x)] + (if (not= nil (nxt t (if (= len 0) k len))) false + (> len 0) true + false)) + _ false) + false)) + +(defn set? + "Check if object is a set." + [x] + (match (getmetatable x) + {:cljlib/type :hash-set} true + _ false)) + +(defn seq? + "Check if object is a sequence." + [x] + (lazy.seq? x)) + +(defn some? + "Returns true if x is not nil, false otherwise." + [x] + (not= x nil)) + +;;; Vector + +(fn vec->transient [immutable] + (fn [vec] + (var len (length vec)) + (->> {:__index (fn [_ i] + (if (<= i len) + (. vec i))) + :__len #len + :cljlib/type :transient + :cljlib/conj #(error "can't `conj` onto transient vector, use `conj!`") + :cljlib/assoc #(error "can't `assoc` onto transient vector, use `assoc!`") + :cljlib/dissoc #(error "can't `dissoc` onto transient vector, use `dissoc!`") + :cljlib/conj! (fn [tvec v] + (set len (+ len 1)) + (doto tvec (tset len v))) + :cljlib/assoc! (fn [tvec ...] + (let [len (length tvec)] + (for [i 1 (select "#" ...) 2] + (let [(k v) (select i ...)] + (if (<= 1 i len) + (tset tvec i v) + (error (.. "index " i " is out of bounds")))))) + tvec) + :cljlib/pop! (fn [tvec] + (if (= len 0) + (error "transient vector is empty" 2) + (let [val (table.remove tvec)] + (set len (- len 1)) + tvec))) + :cljlib/dissoc! #(error "can't `dissoc!` with a transient vector") + :cljlib/persistent! (fn [tvec] + (let [v (fcollect [i 1 len] (. tvec i))] + (while (> len 0) + (table.remove tvec) + (set len (- len 1))) + (setmetatable tvec + {:__index #(error "attempt to use transient after it was persistet") + :__newindex #(error "attempt to use transient after it was persistet")}) + (immutable (itable v))))} + (setmetatable {})))) + +(fn vec* [v] + (match (getmetatable v) + mt (doto mt + (tset :cljlib/type :vector) + (tset :cljlib/editable true) + (tset :cljlib/conj + (fn [t v] (vec* (itable.insert t v)))) + (tset :cljlib/empty + (fn [] (vec* (itable [])))) + (tset :cljlib/transient (vec->transient vec*)) + (tset :__fennelview (fn [coll view inspector indent] + (if (empty? coll) + "[]" + (let [lines (icollect [_ v (ipairs coll)] + (.. " " (view v inspector indent)))] + (tset lines 1 (.. "[" (string.gsub (or (. lines 1) "") "^%s+" ""))) + (tset lines (length lines) (.. (. lines (length lines)) "]")) + lines))))) + nil (vec* (setmetatable v {}))) + v) + +(defn vec + "Coerce collection `coll` to a vector." + [coll] + (cond (empty? coll) (vec* (itable [])) + (vector? coll) (vec* (itable coll)) + :else (-> coll + core.seq + lazy.pack + (doto (tset :n nil)) + itable + vec*))) + +(defn vector "Constructs sequential table out of it's arguments. -Sets additional metadata for function `vector?' to work. +Sets additional metadata for function `vector?` to work. # Examples ``` fennel -(local v (vector 1 2 3 4)) +(def :private v (vector 1 2 3 4)) (assert-eq v [1 2 3 4]) ```" [& args] - (setmetatable args {:cljlib/type :seq})) + (vec args)) + +(defn nth + "Returns the value at the `index`. `get` returns `nil` if `index` out +of bounds, `nth` raises an error unless `not-found` is supplied. +`nth` also works for strings and sequences." + ([coll i] + (if (vector? coll) + (if (or (< i 1) (< (length* coll) i)) + (error (string.format "index %d is out of bounds" i)) + (. coll i)) + (string? coll) + (nth (vec coll) i) + (seq? coll) + (nth (vec coll) i) + :else + (error "expected an indexed collection"))) + ([coll i not-found] + (assert (int? i) "expected an integer key") + (if (vector? coll) + (or (. coll i) not-found) + (string? coll) + (nth (vec coll) i not-found) + (seq? coll) + (nth (vec coll) i not-found) + :else + (error "expected an indexed collection")))) -(defn core.seq - "Create sequential table. +;;; Sequences -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. If -`col' is string, return sequential table of its codepoints. +(defn- seq* + "Add cljlib sequence meta-info." + [x] + (match (getmetatable x) + mt (doto mt + (tset :cljlib/type :seq) + (tset :cljlib/conj + (fn [s v] (core.cons v s))) + (tset :cljlib/empty #(core.list)))) + x) + +(defn seq + "Construct a sequnce from the given collection `coll`. If `coll` is an +associative table, returns sequence of vectors with key and +value. If `col` is sequential table, returns its shallow copy. If +`col` is string, return sequential table of its codepoints. # Examples -Sequential tables remain as is: +Sequential tables are transformed to sequences: ``` fennel -(seq [1 2 3 4]) -;; [1 2 3 4] +(seq [1 2 3 4]) ;; @seq(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]] -``` +(seq {:a 1 :b 2 :c 3}) ;; @seq([:b 2] [:a 1] [:c 3]) +```" + [coll] + (seq* (match (getmetatable coll) + {:cljlib/seq f} (f coll) + _ (cond (lazy.seq? coll) (lazy.seq coll) + (map? coll) (lazy.map vec coll) + :else (lazy.seq coll))))) + +(defn rseq + "Returns, in possibly-constant time, a seq of the items in `rev` in reverse order. +Input must be traversable with `ipairs`. Doesn't work in constant +time if `rev` implements a linear-time `__len` metamethod, or invoking +Lua `#` operator on `rev` takes linar time. If `t` is empty returns +`nil`. -See `into' macros for transforming this back to associative table. -Additionally you can use `conj' and `apply' with -`hash-map': +# Examples ``` fennel -(apply conj (hash-map) [:c 3] [[:a 1] [:b 2]]) -;; => {:a 1 :b 2 :c 3} +(def :private v [1 2 3]) +(def :private r (rseq v)) + +(assert-eq (reverse v) r) ```" - [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 (if _G.utf8 - (let [char _G.utf8.char] - (each [_ b (_G.utf8.codes col)] - (insert res (char b))) - res) - (do (io.stderr:write - "WARNING: utf8 module unavailable, seq function will not work for non-unicode strings\n") - (each [b (col:gmatch ".")] - (insert res b)) - res)) - :nil nil - _ (error (.. "expected table, string or nil, got " (type col)) 2)))) - -(defn core.kvseq - "Transforms any table `col' to key-value sequence." - [col] - (let [res (empty [])] - (match (type col) - :table (let [m (or (getmetatable col) {})] - (when-some [_ ((or m.cljlib/next next) col)] - (each [k v (pairs col)] - (insert res [k v])) - res)) - :string (if _G.utf8 - (let [char _G.utf8.char] - (each [i b (_G.utf8.codes col)] - (insert res [i (char b)])) - res) - (do (io.stderr:write - "WARNING: utf8 module unavailable, seq function will not work for non-unicode strings\n") - (for [i 1 (length col)] - (insert res [i (col:sub i i)])) - res)) - :nil nil - _ (error (.. "expected table, string or nil, got " (type col)) 2)))) - -(defn core.first - "Return first element of a table. Calls `seq' on its argument." - [col] - (when-some [col (seq col)] - (. col 1))) - -(defn 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 []))) - -(defn 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)) - -(defn 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))) - -(defn 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?' test, -insert `[key value]` pair into the table. + [rev] + (seq* (lazy.rseq rev))) + +(defn lazy-seq + "Create lazy sequence from the result of calling a function `f`. +Delays execution of `f` until sequence is consumed. `f` must return a +sequence or a vector." + [f] + (seq* (lazy.lazy-seq f))) -Mutates `tbl'. +(defn first + "Return first element of a `coll`. Calls `seq` on its argument." + [coll] + (lazy.first (seq coll))) + +(defn rest + "Returns a sequence of all elements of a `coll` but the first one. +Calls `seq` on its argument." + [coll] + (seq* (lazy.rest (seq coll)))) + +(defn- next* + "Return the tail of a sequence. + +If the sequence is empty, returns nil." + [s] + (seq* (lazy.next s))) + +(doto core (tset :next next*)) ; luajit doesn't like next redefinition + +(defn count + "Count amount of elements in the sequence." + [s] + (lazy.count s)) + +(defn cons + "Construct a cons cell. +Prepends new `head` to a `tail`, which must be either a table, +sequence, or nil. # 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] -``` +(assert-eq [0 1] (cons 0 [1])) +(assert-eq (list 0 1 2 3) (cons 0 (cons 1 (list 2 3)))) +```" + [head tail] + (seq* (lazy.cons head tail))) -Adding to associative tables: +(fn list + [...] + "Create eager sequence of provided values. + +# Examples ``` fennel -(conj {:a 1} [:b 2] [:c 3]) -;; => {:a 1 :b 2 :c 3} +(local l (list 1 2 3 4 5)) +(assert-eq [1 2 3 4 5] l) +```" + (seq* (lazy.list ...))) + +(set core.list list) + +(defn list* + "Creates a new sequence containing the items prepended to the rest, +the last of which will be treated as a sequence. + +# Examples + +``` fennel +(local l (list* 1 2 3 [4 5])) +(assert-eq [1 2 3 4 5] l) +```" + [& args] + (seq* (apply lazy.list* args))) + +(defn last + "Returns the last element of a `coll`. Calls `seq` on its argument." + [coll] + (match (next* coll) + coll* (last coll*) + _ (first coll))) + +(defn butlast + "Returns everything but the last element of the `coll` as a new + sequence. Calls `seq` on its argument." + [coll] + (seq (lazy.drop-last coll))) + +(defn map + "Returns a lazy sequence consisting of the result of applying `f` to +the set of first items of each `coll`, followed by applying `f` to the +set of second items in each `coll`, until any one of the `colls` is +exhausted. Any remaining items in other `colls` are ignored. Function +`f` should accept number-of-colls arguments. Returns a transducer when +no collection is provided. + +# Examples + +```fennel +(map #(+ $ 1) [1 2 3]) ;; => @seq(2 3 4) +(map #(+ $1 $2) [1 2 3] [4 5 6]) ;; => @seq(5 7 9) +(def :private res (map #(+ $ 1) [:a :b :c])) ;; will raise an error only when realized +```" + ([f] + (fn* [rf] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (rf result (f input))) + ([result input & inputs] + (rf result (apply f input inputs)))))) + ([f coll] + (seq* (lazy.map f coll))) + ([f coll & colls] + (seq* (apply lazy.map f coll colls)))) + +(defn mapv + "Returns a vector consisting of the result of applying `f` to the +set of first items of each `coll`, followed by applying `f` to the set +of second items in each coll, until any one of the `colls` is exhausted. +Any remaining items in other colls are ignored. Function `f` should +accept number-of-colls arguments." + ([f coll] + (->> coll + (core.transduce (map f) + core.conj! + (core.transient (vector))) + core.persistent!)) + ([f coll & colls] (vec (apply map f coll colls)))) + +(defn map-indexed + "Returns a lazy sequence consisting of the result of applying `f` to 1 +and the first item of `coll`, followed by applying `f` to 2 and the +second item in `coll`, etc, until `coll` is exhausted. Returns a +transducer when no collection is provided." + ([f] + (fn* [rf] + (var i -1) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (set i (+ i 1)) + (rf result (f i input)))))) + ([f coll] + (seq* (lazy.map-indexed f coll)))) + +(defn mapcat + "Apply `concat` to the result of calling `map` with `f` and +collections `colls`. Returns a transducer when no collection is +provided." + ([f] + (comp (map f) core.cat)) + ([f & colls] + (seq* (apply lazy.mapcat f colls)))) + +(defn filter + "Returns a lazy sequence of the items in `coll` for which +`pred` returns logical true. Returns a transducer when no collection +is provided." + ([pred] + (fn* [rf] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (pred input) + (rf result input) + result))))) + ([pred coll] + (seq* (lazy.filter pred coll)))) + +(defn filterv + "Returns a vector of the items in `coll` for which +`pred` returns logical true." + [pred coll] + (vec (filter pred coll))) + +(defn every? + "Test if every item in `coll` satisfies the `pred`." + [pred coll] + (lazy.every? pred coll)) + +(defn some + "Test if any item in `coll` satisfies the `pred`." + [pred coll] + (lazy.some? pred coll)) + +(defn not-any? + "Test if no item in `coll` satisfy the `pred`." + [pred coll] + (some #(not (pred $)) coll)) + +(defn range + "Returns lazy sequence of of numbers from `lower` to `upper` with optional `step`." + ([] (seq* (lazy.range))) + ([upper] (seq* (lazy.range upper))) + ([lower upper] (seq* (lazy.range lower upper))) + ([lower upper step] (seq* (lazy.range lower upper step)))) + +(defn concat + "Return a lazy sequence of concatenated `colls`." + [& colls] + (seq* (apply lazy.concat colls))) + +(defn reverse + "Returns a lazy sequnce with same items as in `coll` but in reverse order." + [coll] + (seq* (lazy.reverse coll))) + +(defn take + "Returns a lazy sequence of the first `n` items in `coll`, or all items if +there are fewer than `n`." + ([n] + (fn* [rf] + (var n n) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [result (if (< 0 n) + (rf result input) + result)] + (set n (- n 1)) + (if (not (< 0 n)) + (core.ensure-reduced result) + result)))))) + ([n coll] + (seq* (lazy.take n coll)))) + +(defn take-while + "Take the elements from the collection `coll` until `pred` returns logical +false for any of the elemnts. Returns a lazy sequence. Returns a +transducer when no collection is provided." + ([pred] + (fn* [rf] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (pred input) + (rf result input) + (core.reduced result)))))) + ([pred coll] + (seq* (lazy.take-while pred coll)))) + +(defn drop + "Drop `n` elements from collection `coll`, returning a lazy sequence +of remaining elements. Returns a transducer when no collection is +provided." + ([n] + (fn* [rf] + (var nv n) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [n nv] + (set nv (- nv 1)) + (if (pos? n) + result + (rf result input))))))) + ([n coll] + (seq* (lazy.drop n coll)))) + +(defn drop-while + "Drop the elements from the collection `coll` until `pred` returns logical +false for any of the elemnts. Returns a lazy sequence. Returns a +transducer when no collection is provided." + ([pred] + (fn* [rf] + (var dv true) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [drop? dv] + (if (and drop? (pred input)) + result + (do + (set dv nil) + (rf result input)))))))) + ([pred coll] + (seq* (lazy.drop-while pred coll)))) + +(defn drop-last + "Return a lazy sequence from `coll` without last `n` elements." + ([] (seq* (lazy.drop-last))) + ([coll] (seq* (lazy.drop-last coll))) + ([n coll] (seq* (lazy.drop-last n coll)))) + +(defn take-last + "Return a sequence of last `n` elements of the `coll`." + [n coll] + (seq* (lazy.take-last n coll))) + +(defn take-nth + "Return a lazy sequence of every `n` item in `coll`. Returns a +transducer when no collection is provided." + ([n] + (fn* [rf] + (var iv -1) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (set iv (+ iv 1)) + (if (= 0 (% iv n)) + (rf result input) + result))))) + ([n coll] + (seq* (lazy.take-nth n coll)))) + +(defn split-at + "Return a table with sequence `coll` being split at `n`" + [n coll] + (vec (lazy.split-at n coll))) + +(defn split-with + "Return a table with sequence `coll` being split with `pred`" + [pred coll] + (vec (lazy.split-with pred coll))) + +(defn nthrest + "Returns the nth rest of `coll`, `coll` when `n` is 0. + +# Examples + +``` fennel +(assert-eq (nthrest [1 2 3 4] 3) [4]) +(assert-eq (nthrest [1 2 3 4] 2) [3 4]) +(assert-eq (nthrest [1 2 3 4] 1) [2 3 4]) +(assert-eq (nthrest [1 2 3 4] 0) [1 2 3 4]) ``` +" + [coll n] + (seq* (lazy.nthrest coll n))) + +(defn nthnext + "Returns the nth next of `coll`, (seq coll) when `n` is 0." + [coll n] + (lazy.nthnext coll n)) + +(defn keep + "Returns a lazy sequence of the non-nil results of calling `f` on the +items of the `coll`. Returns a transducer when no collection is +provided." + ([f] + (fn* [rf] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [v (f input)] + (if (nil? v) + result + (rf result v))))))) + ([f coll] + (seq* (lazy.keep f coll)))) + +(defn keep-indexed + "Returns a lazy sequence of the non-nil results of (f index item) in +the `coll`. Note, this means false return values will be included. +`f` must be free of side-effects. Returns a transducer when no +collection is provided." + ([f] + (fn* [rf] + (var iv -1) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (set iv (+ iv 1)) + (let [v (f iv input)] + (if (nil? v) + result + (rf result v))))))) + ([f coll] + (seq* (lazy.keep-indexed f coll)))) + +(defn partition + "Given a collection `coll`, returns a lazy sequence of lists of `n` +items each, at offsets `step` apart. If `step` is not supplied, +defaults to `n`, i.e. the partitions do not overlap. If a `pad` +collection is supplied, use its elements as necessary to complete last +partition upto `n` items. In case there are not enough padding +elements, return a partition with less than `n` items." + ([n coll] (map seq* (lazy.partition n coll))) + ([n step coll] (map seq* (lazy.partition n step coll))) + ([n step pad coll] (map seq* (lazy.partition n step pad coll)))) + +(fn array [] + (var len 0) + (->> {:__len #len + :__index {:clear (fn [self] + (while (not= 0 len) + (tset self len nil) + (set len (- len 1)) + self)) + :add (fn [self val] + (set len (+ len 1)) + (tset self len val) + self)}} + (setmetatable []))) + +(defn partition-by + "Applies `f` to each value in `coll`, splitting it each time `f` +returns a new value. Returns a lazy seq of partitions. Returns a +transducer, if collection is not supplied." + ([f] + (fn* [rf] + (let [a (array) + none {}] + (var pv none) + (fn* + ([] (rf)) + ([result] + (rf (if (empty? a) + result + (let [v (vec a)] + (a:clear) + (core.unreduced (rf result v)))))) + ([result input] + (let [pval pv + val (f input)] + (set pv val) + (if (or (= pval none) + (= val pval)) + (do + (a:add input) + result) + (let [v (vec a)] + (a:clear) + (let [ret (rf result v)] + (when (not (core.reduced? ret)) + (a:add input)) + ret))))))))) + ([f coll] + (map seq* (lazy.partition-by f coll)))) + +(defn partition-all + "Given a collection `coll`, returns a lazy sequence of lists like +`partition`, but may include partitions with fewer than n items at the +end. Accepts addiitonal `step` argument, similarly to `partition`. +Returns a transducer, if collection is not supplied." + ([n] + (fn* [rf] + (let [a (array)] + (fn* + ([] (rf)) + ([result] + (rf (if (= 0 (length a)) + result + (let [v (vec a)] + (a:clear) + (core.unreduced (rf result v)))))) + ([result input] + (a:add input) + (if (= n (length a)) + (let [v (vec a)] + (a:clear) + (rf result v)) + result)))))) + ([n coll] + (map seq* (lazy.partition-all n coll))) + ([n step coll] + (map seq* (lazy.partition-all n step coll)))) + +(defn reductions + "Returns a lazy seq of the intermediate values of the reduction (as +per reduce) of `coll` by `f`, starting with `init`." + ([f coll] (seq* (lazy.reductions f coll))) + ([f init coll] (seq* (lazy.reductions f init coll)))) + +(defn contains? + "Test if `elt` is in the `coll`. May be a linear search depending on the type of the collection." + [coll elt] + (lazy.contains? coll elt)) + +(defn distinct + "Returns a lazy sequence of the elements of the `coll` without +duplicates. Comparison is done by equality. Returns a transducer when +no collection is provided." + ([] + (fn* [rf] + (let [seen (setmetatable {} {:__index deep-index})] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (if (. seen input) + result + (do + (tset seen input true) + (rf result input)))))))) + ([coll] + (seq* (lazy.distinct coll)))) + +(defn dedupe + "Returns a lazy sequence removing consecutive duplicates in coll. +Returns a transducer when no collection is provided." + ([] + (fn* [rf] + (let [none {}] + (var pv none) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (let [prior pv] + (set pv input) + (if (= prior input) + result + (rf result input)))))))) + ([coll] (core.sequence (dedupe) coll))) + +(defn random-sample + "Returns items from coll with random probability of prob (0.0 - +1.0). Returns a transducer when no collection is provided." + ([prob] + (filter (fn [] (< (math.random) prob)))) + ([prob coll] + (filter (fn [] (< (math.random) prob)) coll))) + +(defn doall + "Realize whole lazy sequence `seq`. + +Walks whole sequence, realizing each cell. Use at your own risk on +infinite sequences." + [seq] + (seq* (lazy.doall seq))) + +(defn dorun + "Realize whole sequence `seq` for side effects. + +Walks whole sequence, realizing each cell. Use at your own risk on +infinite sequences." + [seq] + (lazy.dorun seq)) + +(defn line-seq + "Accepts a `file` handle, and creates a lazy sequence of lines using +`lines` metamethod. -Note, that passing literal empty associative table `{}` will not work: +# Examples + +Lazy sequence of file lines may seem similar to an iterator over a +file, but the main difference is that sequence can be shared onve +realized, and iterator can't. Lazy sequence can be consumed in +iterator style with the `doseq` macro. + +Bear in mind, that since the sequence is lazy it should be realized or +truncated before the file is closed: + +```fennel +(let [lines (with-open [f (io.open \"init.fnl\" :r)] + (line-seq f))] + ;; this errors because only first line was realized, but the file + ;; was closed before the rest of lines were cached + (assert-not (pcall next lines))) +``` + +Sequence is realized with `doall` before file was closed and can be shared: ``` fennel -(conj {} [:a 1] [:b 2]) -;; => [[:a 1] [:b 2]] -(conj (hash-map) [:a 1] [:b 2]) -;; => {:a 1 :b 2} +(let [lines (with-open [f (io.open \"init.fnl\" :r)] + (doall (line-seq f)))] + (assert-is (pcall next lines))) ``` -See `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)) - (tset tbl (+ 1 (length tbl)) x)))) - tbl) - ([tbl x & xs] - (apply conj (conj tbl x) xs))) - -(defn 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))))) - -(defn core.cons - "Insert `x' to `tbl' at the front. Calls `seq' on `tbl'." - [x tbl] - (if-some [x x] - (doto (or (seq tbl) (empty [])) - (insert 1 x)) - tbl)) - -(defn 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))) - -(defn 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' -function. +Infinite files can't be fully realized, but can be partially realized +with `take`: + +``` fennel +(let [lines (with-open [f (io.open \"/dev/urandom\" :r)] + (doall (take 3 (line-seq f))))] + (assert-is (pcall next lines))) +```" + [file] + (seq* (lazy.line-seq file))) + +(defn iterate + "Returns an infinete lazy sequence of x, (f x), (f (f x)) etc." + [f x] + (seq* (lazy.iterate f x))) + +(defn remove + "Returns a lazy sequence of the items in the `coll` without elements +for wich `pred` returns logical true. Returns a transducer when no +collection is provided." + ([pred] + (filter (complement pred))) + ([pred coll] + (seq* (lazy.remove pred coll)))) + +(defn cycle + "Create a lazy infinite sequence of repetitions of the items in the +`coll`." + [coll] + (seq* (lazy.cycle coll))) + +(defn repeat + "Takes a value `x` and returns an infinite lazy sequence of this value. # Examples -Reduce sequence of numbers with `add' ``` fennel -(reduce add [1 2 3 4]) -;; => 10 -(reduce add 10 [1 2 3 4]) -;; => 20 +(assert-eq 10 (accumulate [res 0 + _ x (pairs (take 10 (repeat 1)))] + (+ res x))) ```" - ([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] - (let [m (getmetatable val)] - (if (and m - m.cljlib/reduced - (= m.cljlib/reduced.status :ready)) - m.cljlib/reduced.val - (let [col (or (seq col) (empty []))] - (let [[x & xs] col] - (if (nil? x) - val - (reduce f (f val x) xs)))))))) - -(defn core.reduced - "Wraps `x' in such a way so `reduce' will terminate early -with this value. + [x] + (seq* (lazy.repeat x))) + +(defn repeatedly + "Takes a function `f` and returns an infinite lazy sequence of +function applications. Rest arguments are passed to the function." + [f & args] + (seq* (apply lazy.repeatedly f args))) + +(defn tree-seq + "Returns a lazy sequence of the nodes in a tree, via a depth-first walk. + +`branch?` must be a function of one arg that returns true if passed a +node that can have children (but may not). `children` must be a +function of one arg that returns a sequence of the children. Will +only be called on nodes for which `branch?` returns true. `root` is +the root node of the tree. # Examples -Stop reduction is result is higher than `10`: + +For the given tree `[\"A\" [\"B\" [\"D\"] [\"E\"]] [\"C\" [\"F\"]]]`: + + A + / \\ + B C + / \\ \\ + D E F + +Calling `tree-seq` with `next` as the `branch?` and `rest` as the +`children` returns a flat representation of a tree: ``` 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 -``` +(assert-eq (map first (tree-seq next rest [\"A\" [\"B\" [\"D\"] [\"E\"]] [\"C\" [\"F\"]]])) + [\"A\" \"B\" \"D\" \"E\" \"C\" \"F\"]) +```" + [branch? children root] + (seq* (lazy.tree-seq branch? children root))) + +(defn interleave + "Returns a lazy sequence of the first item in each sequence, then the +second one, until any sequence exhausts." + ([] (seq* (lazy.interleave))) + ([s] (seq* (lazy.interleave s))) + ([s1 s2] (seq* (lazy.interleave s1 s2))) + ([s1 s2 & ss] (seq* (apply lazy.interleave s1 s2 ss)))) + +(defn interpose + "Returns a lazy sequence of the elements of `coll` separated by +`separator`. Returns a transducer when no collection is provided." + ([sep] + (fn* [rf] + (var started false) + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (if started + (let [sepr (rf result sep)] + (if (core.reduced? sepr) + sepr + (rf sepr input))) + (do + (set started true) + (rf result input))))))) + ([separator coll] + (seq* (lazy.interpose separator coll)))) + +(defn halt-when + "Returns a transducer that ends transduction when `pred` returns `true` +for an input. When `retf` is supplied it must be a `fn` of 2 arguments +- it will be passed the (completed) result so far and the input that +triggered the predicate, and its return value (if it does not throw an +exception) will be the return value of the transducer. If `retf` is +not supplied, the input that triggered the predicate will be +returned. If the predicate never returns `true` the transduction is +unaffected." + ([pred] + (halt-when pred nil)) + ([pred retf] + (fn* [rf] + (let [halt (setmetatable {} {:__fennelview #"#<halt>"})] + (fn* + ([] (rf)) + ([result] + (if (and (map? result) (contains? result halt)) + result.value + (rf result))) + ([result input] + (if (pred input) + (core.reduced {halt true :value (if retf (retf (rf result) input) input)}) + (rf result input)))))))) + +(defn realized? + "Check if sequence's first element is realized." + [s] + (lazy.realized? s)) + +(defn keys + "Returns a sequence of the map's keys, in the same order as `seq`." + [coll] + (assert (or (map? coll) (empty? coll)) "expected a map") + (if (empty? coll) + (lazy.list) + (lazy.keys coll))) + +(defn vals + "Returns a sequence of the table's values, in the same order as `seq`." + [coll] + (assert (or (map? coll) (empty? coll)) "expected a map") + (if (empty? coll) + (lazy.list) + (lazy.vals coll))) + +(defn find + "Returns the map entry for `key`, or `nil` if key not present in `coll`." + [coll key] + (assert (or (map? coll) (empty? coll)) "expected a map") + (match (. coll key) + v [key v])) + +(defn sort + "Returns a sorted sequence of the items in `coll`. If no `comparator` +is supplied, uses `<`." + ([coll] + (match (seq coll) + s (seq (itable.sort (vec s))) + _ (list))) + ([comparator coll] + (match (seq coll) + s (seq (itable.sort (vec s) comparator)) + _ (list)))) + +;;; Reduce + +(defn reduce + "`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. Early termination is supported via `reduced`. + +# Examples + +``` fennel +(defn- add + ([] 0) + ([a] a) + ([a b] (+ a b)) + ([a b & cs] (apply add (+ a b) cs))) +;; no initial value +(assert-eq 10 (reduce add [1 2 3 4])) +;; initial value +(assert-eq 10 (reduce add 1 [2 3 4])) +;; empty collection - function is called with 0 args +(assert-eq 0 (reduce add [])) +(assert-eq 10.3 (reduce math.floor 10.3 [])) +;; collection with a single element doesn't call a function unless the +;; initial value is supplied +(assert-eq 10.3 (reduce math.floor [10.3])) +(assert-eq 7 (reduce add 3 [4])) +```" + ([f coll] (lazy.reduce f (seq coll))) + ([f val coll] (lazy.reduce f val (seq coll)))) + +(defn reduced + "Terminates the `reduce` early with a given `value`. -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." +# Examples + +``` fennel +(assert-eq :NaN + (reduce (fn [acc x] + (if (not= :number (type x)) + (reduced :NaN) + (+ acc x))) + [1 2 :3 4 5])) +```" + [value] + (doto (lazy.reduced value) + (-> getmetatable (tset :cljlib/deref #$.value)))) + +(defn reduced? + "Returns true if `x` is the result of a call to reduced" [x] - (setmetatable - {} {:cljlib/reduced {:status :ready - :val x}})) + (lazy.reduced? x)) -(defn core.reduce-kv - "Reduces an associative table using function `f' and initial value `val'. +(defn unreduced + [x] + (if (reduced? x) (deref x) x)) -`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 +(defn ensure-reduced + "If x is already reduced?, returns it, else returns (reduced x)" + [x] + (if (reduced? x) + x + (reduced x))) + +(defn- preserving-reduced [rf] + (fn* [a b] + (let [ret (rf a b)] + (if (reduced? ret) + (reduced ret) + ret)))) + +(defn cat + "A transducer which concatenates the contents of each input, which must be a + collection, into the reduction." + [rf] + (let [rrf (preserving-reduced rf)] + (fn* + ([] (rf)) + ([result] (rf result)) + ([result input] + (reduce rrf result input))))) + +(defn 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' +Early termination is possible with the use of `reduced` function. # Examples @@ -693,7 +1532,7 @@ Reduce associative table by adding values from all keys: ;; => 8 ``` -Reduce table by adding values from keys that start with letter `a': +Reduce table by adding values from keys that start with letter `a`: ``` fennel (local t {:a1 1 @@ -705,432 +1544,638 @@ Reduce table by adding values from keys that start with letter `a': 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) - -(defn 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. + [f val s] + (if (map? s) + (reduce (fn [res [k v]] (f res k v)) val (seq s)) + (reduce (fn [res [k v]] (f res k v)) val (map vector (drop 1 (range)) (seq s))))) + +(defn completing + "Takes a reducing function `f` of 2 args and returns a function +suitable for transduce by adding an arity-1 signature that calls +`cf` (default - `identity`) on the result argument." + ([f] (completing f identity)) + ([f cf] + (fn* + ([] (f)) + ([x] (cf x)) + ([x y] (f x y))))) + +(defn transduce + "`reduce` with a transformation of `f` (`xform`). If `init` is not +supplied, `f` will be called to produce it. f should be a reducing +step function that accepts both 1 and 2 arguments, if it accepts only +2 you can add the arity-1 with `completing`. Returns the result of +applying (the transformed) `xform` to `init` and the first item in +`coll`, then applying `xform` to that result and the 2nd item, etc. If +`coll` contains no items, returns `init` and `f` is not called. Note +that certain transforms may inject or skip items." + ([xform f coll] (transduce xform f (f) coll)) + ([xform f init coll] + (let [f (xform f)] + (f (reduce f init (seq coll)))))) + +(defn sequence + "Coerces coll to a (possibly empty) sequence, if it is not already +one. Will not force a lazy seq. `(sequence nil)` yields an empty list, +When a transducer is supplied, returns a lazy sequence of applications +of the transform to the items in `coll`, i.e. to the set of first +items of each `coll`, followed by the set of second items in each +`coll`, until any one of the `colls` is exhausted. Any remaining +items in other `colls` are ignored. The transform should accept +number-of-colls arguments" + ([coll] + (if (seq? coll) coll + (or (seq coll) (list)))) + ([xform coll] + (let [f (xform (completing #(cons $2 $1)))] + (or ((fn step [coll] + (if-some [s (seq coll)] + (let [res (f nil (first s))] + (cond (reduced? res) (f (deref res)) + (seq? res) (concat res (lazy-seq #(step (rest s)))) + :else (step (rest s)))) + (f nil))) + coll) + (list)))) + ([xform coll & colls] + (let [f (xform (completing #(cons $2 $1)))] + (or ((fn step [colls] + (if (every? seq colls) + (let [res (apply f nil (map first colls))] + (cond (reduced? res) (f (deref res)) + (seq? res) (concat res (lazy-seq #(step (map rest colls)))) + :else (step (map rest colls)))) + (f nil))) + (cons coll colls)) + (list))))) + +;;; Hash map + +(fn map->transient [immutable] + (fn [map] + (let [removed (setmetatable {} {:__index deep-index})] + (->> {:__index (fn [_ k] + (if (not (. removed k)) + (. map k))) + :cljlib/type :transient + :cljlib/conj #(error "can't `conj` onto transient map, use `conj!`") + :cljlib/assoc #(error "can't `assoc` onto transient map, use `assoc!`") + :cljlib/dissoc #(error "can't `dissoc` onto transient map, use `dissoc!`") + :cljlib/conj! (fn [tmap [k v]] + (if (= nil v) + (tset removed k true) + (tset removed k nil)) + (doto tmap (tset k v))) + :cljlib/assoc! (fn [tmap ...] + (for [i 1 (select "#" ...) 2] + (let [(k v) (select i ...)] + (tset tmap k v) + (if (= nil v) + (tset removed k true) + (tset removed k nil)))) + tmap) + :cljlib/dissoc! (fn [tmap ...] + (for [i 1 (select "#" ...)] + (let [k (select i ...)] + (tset tmap k nil) + (tset removed k true))) + tmap) + :cljlib/persistent! (fn [tmap] + (let [t (collect [k v (pairs tmap) + :into (collect [k v (pairs map)] + (values k v))] + (values k v))] + (each [k (pairs removed)] + (tset t k nil)) + (each [_ k (ipairs (icollect [k (pairs* tmap)] k))] + (tset tmap k nil)) + (setmetatable tmap + {:__index #(error "attempt to use transient after it was persistet") + :__newindex #(error "attempt to use transient after it was persistet")}) + (immutable (itable t))))} + (setmetatable {}))))) + +(fn hash-map* [x] + "Add cljlib hash-map meta-info." + (match (getmetatable x) + mt (doto mt + (tset :cljlib/type :hash-map) + (tset :cljlib/editable true) + (tset :cljlib/conj + (fn [t [k v] ...] + (apply core.assoc + t k v + (accumulate [kvs [] _ [k v] (ipairs* [...])] + (doto kvs + (table.insert k) + (table.insert v)))))) + (tset :cljlib/transient (map->transient hash-map*)) + (tset :cljlib/empty #(hash-map* (itable {})))) + _ (hash-map* (setmetatable x {}))) + x) + +(defn assoc + "Associate `val` under a `key`. +Accepts extra keys and values. # Examples -Map `string.upcase' over the string: ``` fennel -(mapv string.upper \"string\") -;; => [\"S\" \"T\" \"R\" \"I\" \"N\" \"G\"] -``` +(assert-eq {:a 1 :b 2} (assoc {:a 1} :b 2)) +(assert-eq {:a 1 :b 2} (assoc {:a 1 :b 1} :b 2)) +(assert-eq {:a 1 :b 2 :c 3} (assoc {:a 1 :b 1} :b 2 :c 3)) +```" + ([tbl] + (hash-map* (itable {}))) + ([tbl k v] + (assert (or (nil? tbl) (map? tbl) (empty? tbl)) "expected a map") + (assert (not (nil? k)) "attempt to use nil as key") + (hash-map* (itable.assoc (or tbl {}) k v))) + ([tbl k v & kvs] + (assert (or (nil? tbl) (map? tbl) (empty? tbl)) "expected a map") + (assert (not (nil? k)) "attempt to use nil as key") + (hash-map* (apply itable.assoc (or tbl {}) k v kvs)))) + +(defn assoc-in + "Associate `val` into set of immutable nested tables `t`, via given `key-seq`. +Returns a new immutable table. Returns a new immutable table. + +# Examples -Map `mul' over two tables: +Replace value under nested keys: ``` fennel -(mapv mul [1 2 3 4] [1 0 -1]) -;; => [1 0 -3] +(assert-eq + {:a {:b {:c 1}}} + (assoc-in {:a {:b {:c 0}}} [:a :b :c] 1)) ``` -Basic `zipmap' implementation: +Create new entries as you go: ``` fennel -(import-macros {: into} :init-macros) -(fn zipmap [keys vals] - (into {} (mapv vector keys vals))) - -(zipmap [:a :b :c] [1 2 3 4]) -;; => {:a 1 :b 2 :c 3} +(assert-eq + {:a {:b {:c 1}} :e 2} + (assoc-in {:e 2} [:a :b :c] 1)) ```" - ([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))) - -(defn 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 []))) - -(defn 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)) + [tbl key-seq val] + (assert (or (nil? tbl) (map? tbl) (empty? tbl)) "expected a map or nil") + (hash-map* (itable.assoc-in tbl key-seq val))) -(defn 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)])))) - -(defn core.not-any? - "Test if no item in `tbl' satisfy the `pred'." - [pred tbl] - (some #(not (pred $)) tbl)) - -(defn 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))) - -(defn core.reverse - "Returns table with same items as in `tbl' but in reverse order." - [tbl] - (when-some [tbl (seq tbl)] - (reduce consj (empty []) tbl))) - -(defn core.take - "Returns a sequence of the first `n' items in `col', or all items if -there are fewer than `n'." - [n col] - (if (= n 0) - [] - (pos-int? n) - (if-let [s (seq col)] - (cons (first s) (take (dec n) (rest s))) - nil) - (error "expected positive integer as first argument" 2))) - -(defn core.nthrest - "Returns the nth rest of `col', `col' when `n' is 0. +(defn update + "Update table value stored under `key` by calling a function `f` on +that value. `f` must take one argument, which will be a value stored +under the key in the table. # Examples +Same as `assoc` but accepts function to produce new value based on key value. + ``` fennel -(assert-eq (nthrest [1 2 3 4] 3) [4]) -(assert-eq (nthrest [1 2 3 4] 2) [3 4]) -(assert-eq (nthrest [1 2 3 4] 1) [2 3 4]) -(assert-eq (nthrest [1 2 3 4] 0) [1 2 3 4]) -``` -" - [col n] - [(_unpack col (inc n))]) +(assert-eq + {:data \"THIS SHOULD BE UPPERCASE\"} + (update {:data \"this should be uppercase\"} :data string.upper)) +```" + [tbl key f] + (assert (or (nil? tbl) (map? tbl) (empty? tbl)) "expected a map") + (hash-map* (itable.update tbl key f))) -(defn core.partition - "Returns a sequence of sequences of `n' items each, at offsets step -apart. If `step' is not supplied, defaults to `n', i.e. the partitions -do not overlap. If a `pad' collection is supplied, use its elements as -necessary to complete last partition up to `n' items. In case there -are not enough padding elements, return a partition with less than `n' -items. -# Examples -Partition sequence into sub-sequences of size 3: +(defn update-in + "Update table value stored under set of immutable nested tables, via +given `key-seq` by calling a function `f` on the value stored under the +last key. `f` must take one argument, which will be a value stored +under the key in the table. Returns a new immutable table. -``` fennel -(assert-eq (partition 3 [1 2 3 4 5 6]) [[1 2 3] [4 5 6]]) -``` +# Examples -When collection doesn't have enough elements, partition will not include those: +Same as `assoc-in` but accepts function to produce new value based on key value. ``` fennel -(assert-eq (partition 3 [1 2 3 4]) [[1 2 3]]) -``` +(fn capitalize-words [s] + (pick-values 1 + (s:gsub \"(%a)([%w_`]*)\" #(.. ($1:upper) ($2:lower))))) -Partitions can overlap if step is supplied: +(assert-eq + {:user {:name \"John Doe\"}} + (update-in {:user {:name \"john doe\"}} [:user :name] capitalize-words)) +```" + [tbl key-seq f] + (assert (or (nil? tbl) (map? tbl) (empty? tbl)) "expected a map or nil") + (hash-map* (itable.update-in tbl key-seq f))) -``` fennel -(assert-eq (partition 2 1 [1 2 3 4]) [[1 2] [2 3] [3 4]]) -``` +(defn hash-map + "Create associative table from `kvs` represented as sequence of keys +and values" + [& kvs] + (apply assoc {} kvs)) -Additional padding can be used to supply insufficient elements: +(defn 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] + (assert (or (map? tbl) (empty? tbl)) "expected a map") + (or (. tbl key) not-found))) -``` fennel -(assert-eq (partition 3 3 [3 2 1] [1 2 3 4]) [[1 2 3] [4 3 2]]) -```" - ([n col] - (partition n n col)) - ([n step col] - (if-let [s (seq col)] - (let [p (take n s)] - (if (= n (length p)) - (cons p (partition n step (nthrest s step))) - nil)) - nil)) - ([n step pad col] - (if-let [s (seq col)] - (let [p (take n s)] - (if (= n (length p)) - (cons p (partition n step pad (nthrest s step))) - [(take n (concat p pad))])) - nil))) - -(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 :take - :nthrest :partition]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Equality ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(var eq nil) +(defn 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] + (assert (or (map? tbl) (empty? tbl)) "expected a map") + (var (res t done) (values tbl tbl nil)) + (each [_ k (ipairs* keys) :until done] + (match (. t k) + v (set (res t) (values v v)) + _ (set (res done) (values not-found true)))) + res)) -(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) +(defn dissoc + "Remove `key` from table `tbl`. Optionally takes more `keys`." + ([tbl] tbl) + ([tbl key] + (assert (or (map? tbl) (empty? tbl)) "expected a map") + (hash-map* (doto tbl (tset key nil)))) + ([tbl key & keys] + (apply dissoc (dissoc tbl key) keys))) -(defn _eq - "Deep compare values. +(defn merge + "Merge `maps` rght to left into a single hash-map." + [& maps] + (when (some identity maps) + (->> maps + (reduce (fn [a b] (collect [k v (pairs* b) :into a] + (values k v))) + {}) + itable + hash-map*))) + +(defn frequencies + "Return a table of unique entries from table `t` associated to amount +of their appearances. # Examples -`eq' can compare both primitive types, tables, and user defined types -that have `__eq` metamethod. +Count each entry of a random letter: ``` fennel -(assert-is (eq 42 42)) -(assert-is (eq [1 2 3] [1 2 3])) -(assert-is (eq (hash-set :a :b :c) (hash-set :a :b :c))) -(assert-is (eq (hash-set :a :b :c) (ordered-set :c :b :a))) -``` +(let [fruits [:banana :banana :apple :strawberry :apple :banana]] + (assert-eq (frequencies fruits) + {:banana 3 + :apple 2 + :strawberry 1})) +```" + [t] + (hash-map* (itable.frequencies t))) -Deep comparison is used for tables which use tables as keys: +(defn group-by + "Group table items in an associative table under the keys that are +results of calling `f` on each element of sequential table `t`. +Elements that the function call resulted in `nil` returned in a +separate table. + +# Examples + +Group rows by their date: ``` fennel -(assert-is (eq {[1 2 3] {:a [1 2 3]} {:a 1} {:b 2}} - {{:a 1} {:b 2} [1 2 3] {:a [1 2 3]}})) -(assert-is (eq {{{:a 1} {:b 1}} {{:c 3} {:d 4}} [[1] [2 [3]]] {:a 2}} - {[[1] [2 [3]]] {:a 2} {{:a 1} {:b 1}} {{:c 3} {:d 4}}})) +(local rows + [{:date \"2007-03-03\" :product \"pineapple\"} + {:date \"2007-03-04\" :product \"pizza\"} + {:date \"2007-03-04\" :product \"pineapple pizza\"} + {:date \"2007-03-05\" :product \"bananas\"}]) + +(assert-eq (group-by #(. $ :date) rows) + {\"2007-03-03\" + [{:date \"2007-03-03\" :product \"pineapple\"}] + \"2007-03-04\" + [{:date \"2007-03-04\" :product \"pizza\"} + {:date \"2007-03-04\" :product \"pineapple pizza\"}] + \"2007-03-05\" + [{:date \"2007-03-05\" :product \"bananas\"}]}) ```" - ([x] true) - ([x y] - (if (= x y) - true - (and (= (type x) :table) (= (type y) :table)) - (do (var [res count-a count-b] [true 0 0]) - (each [k v (pairs x)] - (set res (eq v (deep-index 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))) - res) - :else - false)) - ([x y & xs] - (and (eq x y) (apply eq x xs)))) + [f t] + (hash-map* (pick-values 1 (itable.group-by f t)))) + +(defn zipmap + "Return an associative table with the `keys` mapped to the +corresponding `vals`." + [keys vals] + (hash-map* (itable (lazy.zipmap keys vals)))) + +(defn replace + "Given a map of replacement pairs and a vector/collection `coll`, +returns a vector/seq with any elements `=` a key in `smap` replaced +with the corresponding `val` in `smap`. Returns a transducer when no +collection is provided." + ([smap] + (map #(if-let [e (find smap $)] (. e 2) $))) + ([smap coll] + (if (vector? coll) + (->> coll + (reduce (fn [res v] + (if-let [e (find smap v)] + (doto res (table.insert (. e 2))) + (doto res (table.insert v)))) + []) + itable + vec*) + (map #(if-let [e (find smap $)] (. e 2) $) coll)))) + +;;; Conj + +(defn 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?` test, +insert `[key value]` pair into the table. -(set eq _eq) -(set core.eq _eq) +Mutates `tbl`. -;;;;;;;;;;;;;;;;;;;;;; Function manipulation functions ;;;;;;;;;;;;;;;;;;;;;;;;; +# Examples +Adding to sequential tables: -(defn core.identity "Returns its argument." [x] x) +``` fennel +(conj [] 1 2 3 4) +;; => [1 2 3 4] +(conj [1 2 3] 4 5) +;; => [1 2 3 4 5] +``` -(defn core.comp - "Compose functions." - ([] identity) - ([f] f) - ([f g] - (defn - ([] (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)))) +Adding to associative tables: -(defn 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] - (defn - ([] (not (f))) - ([a] (not (f a))) - ([a b] (not (f a b))) - ([a b & cs] (not (apply f a b cs))))) +``` fennel +(conj {:a 1} [:b 2] [:c 3]) +;; => {:a 1 :b 2 :c 3} +``` -(defn core.constantly - "Returns a function that takes any number of arguments and returns `x'." - [x] - (fn [] x)) +Note, that passing literal empty associative table `{}` will not work: -(defn 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 deep-index})] - (fn [...] - (let [args [...]] - (if-some [res (. memo args)] - res - (let [res (f ...)] - (tset memo args res) - res)))))) +``` fennel +(conj {} [:a 1] [:b 2]) +;; => [[:a 1] [:b 2]] +(conj (hash-map) [:a 1] [:b 2]) +;; => {:a 1 :b 2} +``` -(local function-manipulation-doc-order - [:identity :comp :complement :constantly :memoize]) +See `hash-map` for creating empty associative tables." + ([] (vector)) + ([s] s) + ([s x] + (match (getmetatable s) + {:cljlib/conj f} (f s x) + _ (if (vector? s) (vec* (itable.insert s x)) + (map? s) (apply assoc s x) + (nil? s) (cons x s) + (empty? s) (vector x) + (error "expected collection, got" (type s))))) + ([s x & xs] + (apply conj (conj s x) xs))) + +(defn disj + "Returns a new set type, that does not contain the +specified `key` or `keys`." + ([Set] Set) + ([Set key] + (match (getmetatable Set) + {:cljlib/type :hash-set :cljlib/disj f} (f Set key) + _ (error (.. "disj is not supported on " (class Set)) 2))) + ([Set key & keys] + (match (getmetatable Set) + {:cljlib/type :hash-set :cljlib/disj f} (apply f Set key keys) + _ (error (.. "disj is not supported on " (class Set)) 2)))) + +;;; Transients + +(defn transient + "Returns a new, transient version of the collection." + [coll] + (match (getmetatable coll) + {:cljlib/editable true :cljlib/transient f} (f coll) + _ (error "expected editable collection" 2))) + +(defn conj! + "Adds `x` to the transient collection, and return `coll`." + ([] (transient (vec* []))) + ([coll] coll) + ([coll x] + (match (getmetatable coll) + {:cljlib/type :transient :cljlib/conj! f} (f coll x) + {:cljlib/type :transient} (error "unsupported transient operation" 2) + _ (error "expected transient collection" 2)) + coll)) + +(defn assoc! + "Remove `k`from transient map, and return `map`." + [map k & ks] + (match (getmetatable map) + {:cljlib/type :transient :cljlib/dissoc! f} (apply f map k ks) + {:cljlib/type :transient} (error "unsupported transient operation" 2) + _ (error "expected transient collection" 2)) + map) + +(defn dissoc! + "Remove `k`from transient map, and return `map`." + [map k & ks] + (match (getmetatable map) + {:cljlib/type :transient :cljlib/dissoc! f} (apply f map k ks) + {:cljlib/type :transient} (error "unsupported transient operation" 2) + _ (error "expected transient collection" 2)) + map) + +(defn disj! + "disj[oin]. Returns a transient set of the same type, that does not +contain `key`." + ([Set] Set) + ([Set key & ks] + (match (getmetatable Set) + {:cljlib/type :transient :cljlib/disj! f} (apply f Set key ks) + {:cljlib/type :transient} (error "unsupported transient operation" 2) + _ (error "expected transient collection" 2)))) + +(defn pop! + "Removes the last item from a transient vector. If the collection is +empty, raises an error Returns coll" + [coll] + (match (getmetatable coll) + {:cljlib/type :transient :cljlib/pop! f} (f coll) + {:cljlib/type :transient} (error "unsupported transient operation" 2) + _ (error "expected transient collection" 2))) + +(defn persistent! + "Returns a new, persistent version of the transient collection. The +transient collection cannot be used after this call, any such use will +raise an error." + [coll] + (match (getmetatable coll) + {:cljlib/type :transient :cljlib/persistent! f} (f coll) + _ (error "expected transient collection" 2))) + +;;; Into + +(defn into + "Returns a new coll consisting of to-coll with all of the items of + from-coll conjoined. A transducer may be supplied. +# Examples -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hash table extras ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +Thransofmr a hash-map into a sequence of key-value pairs: -(defn core.assoc - "Associate key `k' with value `v' in `tbl'." - ([tbl k v] - (assert (not (nil? k)) "attempt to use nil as key") - (setmetatable - (doto tbl (tset k v)) - {:cljlib/type :table})) - ([tbl k v & kvs] - (when (not= (% (length kvs) 2) 0) - (.. "no value supplied for key " (tostring (. kvs (length kvs))))) - (assert (not (nil? k)) "attempt to use nil as key") - (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}))) - -(defn core.hash-map - "Create associative table from `kvs' represented as sequence of keys -and values" - ([] (empty {})) - ([& kvs] (apply assoc {} kvs))) +```fennel +(assert-eq [[:a 1]] (into (vector) {:a 1})) +``` -(defn 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))) + Construct a hash-map from a sequence of key-value pairs: -(defn 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)) +```fennel +(assert-eq {:a 1 :b 2 :c 3} + (into (hash-map) [[:a 1] [:b 2] [:c 3]])) +```" + ([] (vector)) + ([to] to) + ([to from] + (match (getmetatable to) + {:cljlib/editable true} + (persistent! (reduce conj! (transient to) from)) + _ (reduce conj to from))) + ([to xform from] + (match (getmetatable to) + {:cljlib/editable true} + (persistent! (transduce xform conj! (transient to) from)) + _ (transduce xform conj to from)))) + +;;; Hash Set -(defn core.keys - "Returns a sequence of the table's keys, in the same order as `seq'." - [tbl] - (let [res []] - (each [k _ (pairs tbl)] - (insert res k)) - res)) - -(defn core.vals - "Returns a sequence of the table's values, in the same order as `seq'." - [tbl] - (let [res []] - (each [_ v (pairs tbl)] - (insert res v)) - res)) - -(defn core.find - "Returns the map entry for `key', or `nil' if key not present in `tbl'." - [tbl key] - (when-some [v (. tbl key)] - [key v])) - -(defn core.dissoc - "Remove `key' from table `tbl'. Optionally takes more `keys`." - ([tbl] tbl) - ([tbl key] - (doto tbl (tset key nil))) - ([tbl key & keys] - (apply dissoc (dissoc tbl key) keys))) +(fn viewset [Set view inspector indent] + (if (. inspector.seen Set) + (.. "@set" (. inspector.seen Set) "{...}") + (let [prefix (.. "@set" + (if (inspector.visible-cycle? Set) + (. inspector.seen Set) "") + "{") + set-indent (length prefix) + indent-str (string.rep " " set-indent) + lines (icollect [v (pairs* Set)] + (.. indent-str + (view v inspector (+ indent set-indent) true)))] + (tset lines 1 (.. prefix (string.gsub (or (. lines 1) "") "^%s+" ""))) + (tset lines (length lines) (.. (. lines (length lines)) "}")) + lines))) -(local hash-table-doc-order - [:assoc :hash-map :get :get-in :keys :vals :find :dissoc]) +(fn hash-set->transient [immutable] + (fn [hset] + (let [removed (setmetatable {} {:__index deep-index})] + (->> {:__index (fn [_ k] + (if (not (. removed k)) (. hset k))) + :cljlib/type :transient + :cljlib/conj #(error "can't `conj` onto transient set, use `conj!`") + :cljlib/disj #(error "can't `disj` a transient set, use `disj!`") + :cljlib/assoc #(error "can't `assoc` onto transient set, use `assoc!`") + :cljlib/dissoc #(error "can't `dissoc` onto transient set, use `dissoc!`") + :cljlib/conj! (fn [thset v] + (if (= nil v) + (tset removed v true) + (tset removed v nil)) + (doto thset (tset v v))) + :cljlib/assoc! #(error "can't `assoc!` onto transient set") + :cljlib/assoc! #(error "can't `dissoc!` a transient set") + :cljlib/disj! (fn [thset ...] + (for [i 1 (select "#" ...)] + (let [k (select i ...)] + (tset thset k nil) + (tset removed k true))) + thset) + :cljlib/persistent! (fn [thset] + (let [t (collect [k v (pairs thset) + :into (collect [k v (pairs hset)] + (values k v))] + (values k v))] + (each [k (pairs removed)] + (tset t k nil)) + (each [_ k (ipairs (icollect [k (pairs* thset)] k))] + (tset thset k nil)) + (setmetatable thset + {:__index #(error "attempt to use transient after it was persistet") + :__newindex #(error "attempt to use transient after it was persistet")}) + (immutable (itable t))))} + (setmetatable {}))))) + +(fn hash-set* [x] + (match (getmetatable x) + mt (doto mt + (tset :cljlib/type :hash-set) + (tset :cljlib/conj + (fn [s v ...] + (hash-set* + (itable.assoc + s v v + (unpack* (let [res []] + (each [ _ v (ipairs [...])] + (table.insert res v) + (table.insert res v)) + res)))))) + (tset :cljlib/disj + (fn [s k ...] + (let [to-remove + (collect [_ k (ipairs [...]) + :into (->> {:__index deep-index} + (setmetatable {k true}))] + k true)] + (hash-set* + (itable.assoc {} + (unpack* + (let [res []] + (each [_ v (pairs s)] + (when (not (. to-remove v)) + (table.insert res v) + (table.insert res v))) + res))))))) + (tset :cljlib/empty #(hash-set* (itable {}))) + (tset :cljlib/editable true) + (tset :cljlib/transient (hash-set->transient hash-set*)) + (tset :cljlib/seq (fn [s] (map #(if (vector? $) (. $ 1) $) s))) + (tset :__fennelview viewset) + (tset :__fennelrest (fn [s i] + (var j 1) + (let [vals []] + (each [v (pairs* s)] + (if (>= j i) + (table.insert vals v) + (set j (+ j 1)))) + (core.hash-set (unpack* vals)))))) + _ (hash-set* (setmetatable x {}))) + x) + +(defn 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." + [& xs] + (let [Set (collect [_ val (pairs* xs) + :into (->> {:__newindex deep-newindex} + (setmetatable {}))] + (values val val))] + (hash-set* (itable Set)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Multimethods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Multimethods -(defn core.remove-method +(defn multifn? + "Test if `mf' is an instance of `multifn'. + +`multifn' is a special kind of table, created with `defmulti' macros +from `macros.fnl'." + [mf] + (match (getmetatable mf) + {:cljlib/type :multifn} true + _ false)) + +(defn remove-method "Remove method from `multimethod' for given `dispatch-value'." [multimethod dispatch-value] (if (multifn? multimethod) @@ -1138,7 +2183,7 @@ found in the table." (error (.. (tostring multimethod) " is not a multifn") 2)) multimethod) -(defn core.remove-all-methods +(defn remove-all-methods "Removes all of the methods of `multimethod'" [multimethod] (if (multifn? multimethod) @@ -1147,7 +2192,7 @@ found in the table." (error (.. (tostring multimethod) " is not a multifn") 2)) multimethod) -(defn core.methods +(defn methods "Given a `multimethod', returns a map of dispatch values -> dispatch fns" [multimethod] (if (multifn? multimethod) @@ -1157,7 +2202,7 @@ found in the table." m) (error (.. (tostring multimethod) " is not a multifn") 2))) -(defn core.get-method +(defn 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." @@ -1167,260 +2212,8 @@ default." (. multimethod :default)) (error (.. (tostring multimethod) " is not a multifn") 2))) -(local multimethods-doc-order - [:remove-method :remove-all-methods :methods :get-method]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Sets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +core -(fn viewset [Set view inspector indent] - (if (. inspector.seen Set) - (.. "@set" (. inspector.seen Set) "{...}") - (let [prefix (.. "@set" - (if (inspector.visible-cycle? Set) - (. inspector.seen Set) "") - "{") - set-indent (length prefix) - indent-str (string.rep " " set-indent) - lines (icollect [v (pairs Set)] - (.. indent-str - (view v inspector (+ indent set-indent) true)))] - (tset lines 1 (.. prefix (string.gsub (or (. lines 1) "") "^%s+" ""))) - (tset lines (length lines) (.. (. lines (length lines)) "}")) - lines))) - -(fn ordered-set-newindex [Set] - "`__newindex` metamethod for ordered-set. - -Updates order of all items when some key removed from 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 set->iseq [Set] - (collect [v k (pairs Set)] - (values k v))) - -(fn ordered-set-pairs [Set] - "Returns stateless `ipairs' iterator for ordered sets." - (fn [] - (var i 0) - (var iseq nil) - (fn set-next [t _] - (when (not iseq) - (set iseq (set->iseq Set))) - (set i (+ i 1)) - (let [v (. iseq i)] - (values v v))) - (values set-next Set nil))) - -(fn hash-set-pairs [Set] - "Returns stateful `ipairs' iterator for hashed sets." - (fn [] - (fn iter [t k] - (let [v (next t k)] - (values v v))) - (values iter Set nil))) - -(fn into-set [Set tbl] - "Transform `tbl' into `Set`" - (each [_ v (pairs (or (seq tbl) []))] - (conj Set v)) - Set) - -;; Sets are bootstrapped upon previous functions. - -(defn 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'. To add element to the ordered set use -`tset' or `conj'. Both operations modify the set. - -**Note**: Hash set prints as `@set{a b c}`, but this construct is not -supported by the Fennel reader, so you can't create sets with this -syntax. Use `ordered-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) -;; => @set{} -(ordered-set :a :c :b) -;; => @set{:a :c :b} -``` - -Duplicate items are not added: - -``` fennel -(ordered-set :a :c :a :a :a :a :c :b) -;; => @set{: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' or `tset' - -``` fennel -(local oset (ordered-set :a :b :c)) -(conj oset :d :e) -;; => @set{:a :b :c :d :e} -``` - -### Remove items from the set: -To add element to the set use `disj' or `tset' - -``` fennel -(local oset (ordered-set :a :b :c)) -(disj oset :b) -;; => @set{:a :c} -(tset oset :a nil) -oset -;; => @set{:c} -``` - -## Equality semantics -Both `ordered-set' and `hash-set' implement `__eq` metamethod, -and are compared for having the same keys without particular order and -same size: - -``` fennel -(assert-eq (ordered-set :a :b) (ordered-set :b :a)) -(assert-ne (ordered-set :a :b) (ordered-set :b :a :c)) -(assert-eq (ordered-set :a :b) (hash-set :a :b)) -```" - [& xs] - (let [Set (setmetatable {} {:__index deep-index}) - set-pairs (ordered-set-pairs 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) - :cljlib/into into-set - :cljlib/empty #(ordered-set) - :__eq set-eq - :__call #(if (. Set $2) $2 nil) - :__len (set-length Set) - :__index #(if (. Set $2) $2 nil) - :__newindex (ordered-set-newindex Set) - :__pairs set-pairs - :__name "ordered set" - :__fennelview viewset}))) - -(defn 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' or `tset' functions, and items can be removed -with `disj' or `tset' functions. Rest semantics are the same -as for `ordered-set' - -**Note**: Hash set prints as `@set{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-pairs (hash-set-pairs Set)] - (each [_ val (ipairs xs)] - (when (not (. Set val)) - (tset Set val true))) - (setmetatable {} - {:cljlib/type :cljlib/hash-set - :cljlib/next #(next Set $2) - :cljlib/into into-set - :cljlib/empty #(hash-set) - :__eq set-eq - :__call #(if (. Set $2) $2 nil) - :__len (set-length Set) - :__index #(if (. Set $2) $2 nil) - :__newindex (hash-set-newindex Set) - :__pairs set-pairs - :__name "hash set" - :__fennelview viewset}))) - -(local set-doc-order - [:ordered-set :hash-set]) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; Module info and export ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(set module-info._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)) - -(setmetatable core {:__index module-info}) - - -;; 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 Andrey -;; LocalWords: Orst codepoints Listopadov metamethods nums multifn -;; LocalWords: stateful LuaJIT +;; Local Variables: +;; eval: (add-to-list 'imenu-generic-expression `(nil "\\s(\\(?:defn-?\\|fn\\*\\)[[:space:]]+\\(\\(?:\\sw\\|\\s_\\|-\\|_\\)+\\)" 1)) +;; End: |