From 270beed0505ef47159d94fb162ff4840958f3ce5 Mon Sep 17 00:00:00 2001 From: Andrey Orst Date: Tue, 19 Jan 2021 16:46:00 +0000 Subject: fix: Fennel 0.8.0 enhancements Changelog: - fixed bug in try - reworked pretty printing for sets - handle cycles in sets - use new fennel.view format - reorganized library to make requiring it easier --- .depend.mk | 8 +- .dir-locals.el | 23 +- .gitlab-ci.yml | 38 +- CODE_OF_CONDUCT.md | 5 + CODE_OF_CONDUCT.org | 5 - CONTRIBUTING.md | 85 ++++ CONTRIBUTING.org | 94 ---- Makefile | 15 +- README.md | 40 ++ README.org | 14 - cljlib-macros.fnl | 1155 ------------------------------------------- cljlib.fnl | 1286 ------------------------------------------------ doc/cljlib-macros.md | 581 ---------------------- doc/cljlib.md | 251 ++++------ doc/macros.md | 588 ++++++++++++++++++++++ doc/tests/test.md | 2 +- init.fnl | 1333 ++++++++++++++++++++++++++++++++++++++++++++++++++ macros.fnl | 1190 ++++++++++++++++++++++++++++++++++++++++++++ tests/core.fnl | 1039 +++++++++++++++++++-------------------- tests/fn.fnl | 27 +- tests/macros.fnl | 20 +- tests/test.fnl | 44 +- 22 files changed, 3972 insertions(+), 3871 deletions(-) create mode 100644 CODE_OF_CONDUCT.md delete mode 100644 CODE_OF_CONDUCT.org create mode 100644 CONTRIBUTING.md delete mode 100644 CONTRIBUTING.org create mode 100644 README.md delete mode 100644 README.org delete mode 100644 cljlib-macros.fnl delete mode 100644 cljlib.fnl delete mode 100644 doc/cljlib-macros.md create mode 100644 doc/macros.md create mode 100644 init.fnl create mode 100644 macros.fnl diff --git a/.depend.mk b/.depend.mk index 1c09089..a93e35b 100644 --- a/.depend.mk +++ b/.depend.mk @@ -1,4 +1,4 @@ -cljlib.lua: cljlib.fnl cljlib-macros.fnl -tests/core.lua: tests/core.fnl cljlib-macros.fnl tests/test.fnl cljlib.fnl -tests/macros.lua: tests/macros.fnl cljlib-macros.fnl tests/test.fnl -tests/fn.lua: tests/fn.fnl cljlib-macros.fnl tests/test.fnl +init.lua: init.fnl macros.fnl +tests/core.lua: tests/core.fnl macros.fnl tests/test.fnl init.fnl +tests/macros.lua: tests/macros.fnl macros.fnl tests/test.fnl +tests/fn.lua: tests/fn.fnl macros.fnl tests/test.fnl diff --git a/.dir-locals.el b/.dir-locals.el index 6036615..bf3fb90 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,7 +1,28 @@ ;;; Directory Local Variables ;;; For more information see (info "(emacs) Directory Variables") -((fennel-mode . ((eval . (put 'when-meta 'fennel-indent-function 'defun)) +((fennel-mode . ((eval . (font-lock-add-keywords + 'fennel-mode + `((,(rx word-start + (group (or "fn*" + "try" + "if-let" + "if-some" + "when-let" + "when-some" + "empty" + "into" + "when-meta" + "with-meta" + "meta" + "meta" + "def" + "defmulti" + "defmethod" + "defonce")) + word-end) + 1 'font-lock-keyword-face)))) + (eval . (put 'when-meta 'fennel-indent-function 'defun)) (eval . (put 'defmethod 'fennel-indent-function 'defun)) (eval . (put 'defmulti 'bfennel-indent-function 'defun)) (eval . (put 'deftest 'fennel-indent-function 'defun)) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fd30085..a49ff33 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -4,34 +4,42 @@ stages: - test - coverage -Lua 5.3: - image: alpine:3.12.1 +Lua: + image: alpine:edge stage: test before_script: - - apk add lua5.3 luarocks5.3 make - - luarocks-5.3 install fennel + - apk add -q lua5.2 lua5.3 lua5.4 git make + - git clone https://git.sr.ht/~technomancy/fennel + - (cd fennel; LUA=lua5.3 make install) script: - - LUA=lua5.3 make test + - LUA_EXECUTABLES="lua5.2 lua5.3 lua5.4" make testall >/dev/null -Lua 5.4: - image: ubuntu:20.10 +# Luajit actually is an impostor in Alpine, as the package actually +# uses Moonjit implementation, which is different from what I'm +# working with, so Fedora 33 image is used, which as of this moment +# has latest Luajit available +Luajit: + image: fedora:33 stage: test before_script: - - ln -snf /usr/share/zoneinfo/Europe/Moscow /etc/localtime - - echo Europe/Moscow > /etc/timezone - - apt-get update && apt-get install -y lua5.4 luarocks make >/dev/null - - luarocks install fennel + - dnf install -y -q lua luajit git make + - git clone https://git.sr.ht/~technomancy/fennel + - (cd fennel; make install) script: - - LUA=lua5.4 make test + - LUA=luajit make test +# We install fennel via luarocks by making local rockspect because I +# don't want to figure out how to install luacov without luarocks Coverage: image: alpine:3.12.1 stage: coverage before_script: - - apk add lua5.3 lua5.3-dev gcc musl-dev luarocks5.3 make - - luarocks-5.3 install fennel + - apk add -q lua5.3 lua5.3-dev gcc musl-dev luarocks5.3 git make + - (cd $HOME; git clone https://git.sr.ht/~technomancy/fennel) + - export LUA=lua5.3 + - (cd $HOME/fennel; luarocks-5.3 make rockspecs/fennel-scm-2.rockspec) - luarocks-5.3 install luacov - luarocks-5.3 install luacov-console script: - - LUA=lua5.3 make luacov-console + - make luacov-console >/dev/null - luacov-console --no-colored -s diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md new file mode 100644 index 0000000..ca3f99e --- /dev/null +++ b/CODE_OF_CONDUCT.md @@ -0,0 +1,5 @@ +Only **code quality** does matter. + +Everything else is up to your personal taste. + +However, this doesn't mean that we will be tolerant to *any* kind of antics. diff --git a/CODE_OF_CONDUCT.org b/CODE_OF_CONDUCT.org deleted file mode 100644 index ad2e2da..0000000 --- a/CODE_OF_CONDUCT.org +++ /dev/null @@ -1,5 +0,0 @@ -Only *code quality* does matter. - -Everything else is up to your personal taste. - -However, this doesn't mean that we will be tolerant to /any/ kind of antics. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..901239b --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,85 @@ +Please read the following document to make collaborating on the project easier for both sides. + +# Reporting bugs + +If you've encountered a bug, do the following: + +- Check if the documentation has information about the problem you have. + Maybe this isn't a bug, but a desired behavior. +- Check issue tracker, maybe someone had reported your problem already. + If there's no issue, describing your problem, or there is, but it is closed, please create new issue, and link all closed issues that relate to this problem, if any. +- Tag issue with a `BUG:` at the beginning of the issue name. + +# Suggesting features and/or changes + +Before suggesting a feature, please check if this feature wasn't requested before. +You can do that in the issues, by filtering issues by `FEATURE:`. +If no feature found, please file new issue, and tag it with a `FEATURE:` at the beginning of the issue name. + +# Contributing changes + +Please do. + +When deciding to contribute a large amount of changes, first consider opening a `DISCUSSION:` type issue, so we could first decide if such dramatic changes are in the scope of the project. +This will save your time, in case such changes are out of the project's scope. + +If you're contributing a bug-fix, please open a `BUG:` labeled issue first, unless someone already did that. +All bug related merge requests must have a linked issues with a meaningful explanation and steps of reproducing a bug. +Small fixes are also welcome, and doesn't require filing an issue, although you may be asked to do so. + +## Writing code + +When writing code, consider following the existing style without applying dramatic changes to formatting unless really necessary. +For this particular project, please follow rules as described in [Clojure Style Guide](https://github.com/bbatsov/clojure-style-guide). +If you see any inconsistencies with the style guide in the code, feel free to change these in a non-breaking way. +If you're using Emacs, some indentation rules are predefined in `.dir-locals.el` file, so when adding new macro please add a meaningful indentation spec to that file as well. + +If you've added new functions, each must be covered with a set of tests. +For that purpose this project has special `test.fnl` module, that defines such macros as `assert-is`, `assert-not`, `assert-eq`, `assert-ne`, `deftest`, and `testing`. +Related tests should be grouped with the `deftest` macro, which defines a meaningful name for the test, and test itself must be defined within `testing` macros. +All assertions in tests must be one with one of `assert-eq`, `assert-ne`, `assert-not`, or `assert-is` macros, as these provide human readable output in the log. + +When changing existing functions make sure that all tests pass. +If some tests do not pass, make sure that these tests are written to test this particular function. +If the breakage was expected (e.g. when contributing a breaking change), make sure to update the tests. +If neither from above applies, then, perhaps, you've broke something horribly. + +Before committing changes you must run tests with `make test`, and all of the tests must pass without errors. +Consider checking test coverage with `make luacov` and rendering it with your preferred reporter. +Makefile also has `luacov-console` target, which can be used to see coverage of Lua code directly in the terminal with [luacov-console](https://github.com/spacewander/luacov-console). +Coverage should not drop too much, and huge drops usually mean that tests should cover more input variants. + +## Writing documentation + +If you've added new code, make sure it is covered not only by tests but also with documentation. +This includes writing documentation strings directly in the code, by using docstring feature of the language. +Documentation files are auto-generated with [Fenneldoc](https://gitlab.com/andreyorst/fenneldoc), so please refer to its documentation for available features. + +General notes on writing documentation: + +- Please consider using spell checking. + If you find a word not known by the dictionary, please add it to the `LocalWords` section at the bottom of the document. +- If you're writing markdown by hand, please consider using one sentence per line approach. + This makes it easier to reason about text in patches, and Markdown ignores single newlines in sentences. +- If you're writing documentation for function, consider splitting lines at column 80. + +## Working with Git + +Check out new branch from project's main development branch. +If you've cloned this project some time ago, consider checking if your branch has all recent changes from upstream. + +Each commit must have a type, which is one of `feature`, `fix`, followed by optional scope, and a must have description after `:` colon. +For example: + + fix(core macros): fix #42 + feature(tests): add more strict tests + +- `feature` must be used when adding new code. +- `fix` must be used when working with existing code. + +When creating merge request consider squashing your commits at merge. +You may do this manually, or use Gitlab's "Squash commits" button. +Either way please tag squash commit with `fix` or `feature`, depending on what you're willing to merge. + + diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org deleted file mode 100644 index 9acb924..0000000 --- a/CONTRIBUTING.org +++ /dev/null @@ -1,94 +0,0 @@ -#+title: Contributing guidelines -#+author: Andrey Orst -#+email: andreyorst@gmail.com -#+date: 2020-10-24 - -Please read the following document to make collaborating on the project easier for both sides. - -* Reporting bugs -If you've encountered a bug, do the following: - -- Check if the documentation has information about the problem you have. - Maybe this isn't a bug, but a desired behavior. -- Check past and current issues, maybe someone had reported your problem already. - If there's no issue, describing your problem, or there is, but it is closed, please create new issue, and link all closed issues that relate to this problem, if any. -- Tag issue with a =BUG:= at the beginning of the issue name. - - -* Suggesting features and/or changes -Before suggesting a feature, please check if this feature wasn't requested before. -You can do that in the issues, by filtering issues by =FEATURE:=. -If no feature found, please file new issue, and tag it with a =FEATURE:= at the beginning of the issue name. - - -* Contributing changes -Please do. - -When deciding to contribute a large amount of changes, first consider opening a =DISCUSSION:= type issue, so we could first decide if such dramatic changes are in the scope of the project. -This will save your time, in case such changes are out of the project's scope. - -If you're contributing a bugfix, please open an =BUG:= issue first, unless someone already did that. -All bug related merge requests must have a linked issues with a meaningful explanation and steps of reproducing a bug. -Small fixes are also welcome, and doesn't require filing an issue, although we may ask you to do so. - -** Writing code -When writing code, consider following the existing style without applying dramatic changes to formatting unless really necessary. -For this particular project, please follow rules as described in [[https://github.com/bbatsov/clojure-style-guide][Clojure Style Guide]]. -If you see any inconsistencies with the style guide in the code, feel free to change these in a non-breaking way. - -If you've added new functions, each one must be covered with a set of tests. -For that purpose this project has special =test.fnl= module, that defines such macros as =assert-is=, =assert-not=, =assert-eq=, =assert-ne=, =deftest=, and =testing=. -Related tests should be grouped with the =deftest= macro, which defines a meaningful name for the test, and test itself must be defined within =testing= macros. -All assertions in tests must be one with one of =assert-eq=, =assert-ne=, =assert-not=, or =assert-is= macros, as these provide human readable output in the log. - -When changing existing functions make sure that all tests pass. -If some tests do not pass, make sure that these tests are written to test this function. -If not, then, perhaps, you've broke something horribly. - -Before comitting changes you must run tests with =make test=, and all of the tests must pass without errors. -Consider checking test coverage with =make luacov= and rendering it with your preferred reporter. -Makefile also has =luacov-console= target, which can be used to see coverage of lua code directly in the terminal with [[https://github.com/spacewander/luacov-console][luacov-console]]. - -** Writing documentation -If you've added new code, make sure it is covered not only by tests but also with documentation. -This includes writing documentation strings directly in the code, either by using docstring feature of the language, or by adding comments which begin with =DOC:= - -Documentation files use Org Mode format because it is easy to convert it to all kinds of formats. -Please make sure to follow existing style of documentation, which can be shortly describing as: - -- One sentence per line. - This makes easier to see changes while browsing history. -- No indentation of text after headings. - This makes little sense with one sentence per line approach anyway. -- No empty lines after headings. -- Amount of empty lines in text should be: - - Single empty lines between paragraphs. - - Double empty lines before top level headings. - - Single empty lines before other headings. -- Consider using spell checking. - If you find a word not known by the dictionary, please add it to the =LocalWords= section at the bottom of the document. - -If you're not using Emacs, there are plugins for other editors of varying completeness that provide support for Org file formats. -Here are some popular ones: Atom [[https://atom.io/packages/org-mode][package]], VSCode [[https://github.com/vscode-org-mode/vscode-org-mode][plugin]], SublimeText [[https://packagecontrol.io/packages/orgmode][plugin]]. -Even without the plugin it is not hard to edit such Org files, as it is just plain text. - -** Working with Git -Check out new branch from project's main development branch. -If you've cloned this project some time ago, consider checking if your branch has all recent changes from upstream. - -Each commit must have a type, which is one of =feature=, =fix=, followed by optional scope, and a must have description after =:= colon. -For example: - -#+begin_example -fix(core macros): fix #42 -feature(tests): add more strict tests -#+end_example - -- =feature= must be used when adding new code. -- =fix= must be used when fixing existing code. - -When creating merge request consider squashing your commits at merge. -You may do this manually, or use Gitlab's "Squash commits" button. - -# LocalWords: bugfix docstring comitting VSCode SublimeText -# LocalWords: Gitlab's LocalWords diff --git a/Makefile b/Makefile index 6a313b8..83f78f7 100644 --- a/Makefile +++ b/Makefile @@ -1,11 +1,12 @@ LUA ?= lua FENNEL ?= fennel -FNLSOURCES = cljlib.fnl +FNLSOURCES = init.fnl LUASOURCES = $(FNLSOURCES:.fnl=.lua) FNLTESTS = tests/fn.fnl tests/macros.fnl tests/core.fnl LUATESTS = $(FNLTESTS:.fnl=.lua) +LUA_EXECUTABLES ?= lua luajit -.PHONY: build clean distclean help test luacov luacov-console fenneldoc +.PHONY: build clean distclean help test luacov luacov-console fenneldoc $(LUA_EXECUTABLES) build: $(LUASOURCES) @@ -21,10 +22,14 @@ distclean: clean rm -f luacov* test: $(FNLTESTS) - @true$(foreach test, $?, && $(FENNEL) --lua $(LUA) --metadata $(test)) + @echo "Testing on" $$($(LUA) -v) >&2 + @$(foreach test,$?,$(FENNEL) --lua $(LUA) --metadata $(test) || exit;) + +testall: $(LUA_EXECUTABLES) + @$(foreach lua,$?,LUA=$(lua) make test || exit;) luacov: build $(LUATESTS) - @true$(foreach test, $(LUATESTS), && $(LUA) -lluarocks.loader -lluacov $(test)) + @$(foreach test,$(LUATESTS),$(LUA) -lluarocks.loader -lluacov $(test) || exit;) luacov luacov-console: luacov @@ -33,7 +38,7 @@ luacov-console: luacov @$(foreach test, $(LUATESTS), mv $(test).tmp $(test);) fenneldoc: - fenneldoc cljlib.fnl cljlib-macros.fnl tests/test.fnl + fenneldoc init.fnl macros.fnl tests/test.fnl help: @echo "make -- run tests and create lua library" >&2 diff --git a/README.md b/README.md new file mode 100644 index 0000000..6b213a5 --- /dev/null +++ b/README.md @@ -0,0 +1,40 @@ +# Fennel Cljlib + +[![img](https://gitlab.com/andreyorst/fennel-cljlib/badges/master/pipeline.svg)](https://gitlab.com/andreyorst/fennel-cljlib/-/commits/master) +[![img](https://gitlab.com/andreyorst/fennel-cljlib/badges/master/coverage.svg)](https://gitlab.com/andreyorst/fennel-cljlib/-/commits/master) + +Experimental library for [Fennel](https://fennel-lang.org/) language, that adds many functions from [Clojure](https://clojure.org/)'s standard library. +This is not a one to one port of Clojure `core`, because many Clojure functions require certain guarantees, like immutability and laziness, which are hard to efficiently implement on top of Lua. +Some semantics like concurrency, or dynamic scope is not supported by Lua runtime at all. +Therefore certain functions were altered to better suit the domain. + +## Installation + +Clone library into your project or put it as a git submodule: + + $ git clone https://gitlab.com/andreyorst/fennel-cljlib cljlib + +Now you can require `:cljlib` from Fennel: + +``` clojure +(local clj (require :cljlib)) +(import-macros cljm :cljlib.macros) +``` + +Optionally precompile the library to make it load slightly faster: + + $ cd cljlib; make + +This will compile `init.fnl` into `init.lua`, so `require` should honor Lua files over Fennel files. +It is also possible to use this library from Lua this way. + +## Documentation + +Documentation is auto-generated with [Fenneldoc](https://gitlab.com/andreyorst/fenneldoc) and can be found [here](https://gitlab.com/andreyorst/fennel-cljlib/-/tree/master/doc). + +# Contributing + +Please make sure you've read [contribution guidelines](https://gitlab.com/andreyorst/fennel-cljlib/-/tree/master/CONTRIBUTING.md). + + diff --git a/README.org b/README.org deleted file mode 100644 index e30d62c..0000000 --- a/README.org +++ /dev/null @@ -1,14 +0,0 @@ -#+title: Fennel Cljlib -[[https://gitlab.com/andreyorst/fennel-cljlib/-/commits/master][https://gitlab.com/andreyorst/fennel-cljlib/badges/master/pipeline.svg]] [[https://gitlab.com/andreyorst/fennel-cljlib/-/commits/master][https://gitlab.com/andreyorst/fennel-cljlib/badges/master/coverage.svg]] - -Experimental library for [[https://fennel-lang.org/][Fennel]] language, that adds many functions from [[https://clojure.org/][Clojure]]'s standard library. -This is not a one to one port of Clojure =core=, because many Clojure functions require certain guarantees, like immutability of the underlying data structures, or laziness. -Therefore some names were changed, but they should be still recognizable, and certain functions were altered to better suit the domain. - -Even though it is project is experimental, the goals of this project are: - -- Have a self contained library, with no dependencies, that provides a set of useful functions from Clojure =core=, -- Be close to the platform, e.g. implement functions in a way that is efficient to use in Lua VM, -- Be well documented library, with good test coverage. - -Documentation is autogenerated with [[https://gitlab.com/andreyorst/fenneldoc][Fenneldoc]] and can be found [[https://gitlab.com/andreyorst/fennel-cljlib/-/tree/master/doc][here]]. diff --git a/cljlib-macros.fnl b/cljlib-macros.fnl deleted file mode 100644 index 19b0107..0000000 --- a/cljlib-macros.fnl +++ /dev/null @@ -1,1155 +0,0 @@ -(local fennel (require :fennel)) - - -;;;;;;;;;; compile time check that `--metadata` feature was enabled ;;;;;;;;;;;; - -(local meta-enabled (pcall _SCOPE.specials.doc - (list (sym :doc) (sym :doc)) - _SCOPE _CHUNK)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn first [tbl] - (. tbl 1)) - -(fn rest [tbl] - [((or table.unpack _G.unpack) tbl 2)]) - -(fn string? [x] - (= (type x) :string)) - -(fn multisym->sym [s] - ;; Strip multisym part from symbol and return new symbol and - ;; indication that sym was transformed. Non-multisym symbols returned as - ;; is. - ;; - ;; ``` fennel - ;; (multisym->sym a.b) ;; => (a true) - ;; (multisym->sym a.b.c) ;; => (c true) - ;; (multisym->sym a) ;; => (a false) - ;; ``` - (values (sym (string.match (tostring s) "[^.]+$")) - (multi-sym? s))) - -(fn contains? [tbl x] - ;; Checks if `x` is stored in `tbl` in linear time. - (var res false) - (each [i v (ipairs tbl)] - (if (= v x) - (do (set res i) - (lua :break)))) - res) - -(fn check-two-binding-vec [bindings] - ;; Test if `bindings` is a `sequence` that holds two forms, first of - ;; which is a `sym`, `table` or `sequence`. - (and (assert-compile (sequence? bindings) - "expected binding table" []) - (assert-compile (= (length bindings) 2) - "expected exactly two forms in binding vector." bindings) - (assert-compile (or (sym? (first bindings)) - (sequence? (first bindings)) - (table? (first bindings))) - "expected symbol, sequence or table as binding." bindings))) - -(fn attach-meta [value meta] - (each [k v (pairs meta)] - (fennel.metadata:set value k v))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;; Runtime function builers ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; This code should be shared with `cljlib.fnl` however it seems -;; impossible to actually do that right now, mainly because there's no -;; way of doing relative loading of macro modules. - -(fn eq-fn [] - ;; Returns recursive equality function. - ;; - ;; This function is able to compare tables of any depth, even if one of - ;; the tables uses tables as keys. - `(fn eq# [left# right#] - (if (and (= (type left#) :table) (= (type right#) :table)) - (let [oldmeta# (getmetatable right#)] - ;; In case if we'll get something like - ;; `(eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}})` - ;; we have to do even deeper search - (setmetatable right# {:__index (fn [tbl# key#] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#)}) - (var [res# count-a# count-b#] [true 0 0]) - (each [k# v# (pairs left#)] - (set res# (eq# v# (. right# k#))) - (set count-a# (+ count-a# 1)) - (when (not res#) (lua :break))) - (when res# - (each [_# _# (pairs right#)] - (set count-b# (+ count-b# 1))) - (set res# (= count-a# count-b#))) - (setmetatable right# oldmeta#) - res#) - (= left# right#)))) - -(fn seq-fn [] - ;; Returns function that transforms tables and strings into sequences. - ;; - ;; Sequential tables `[1 2 3 4]` are shallowly copied. - ;; - ;; Associative tables `{:a 1 :b 2}` are transformed into `[[:a 1] [:b 2]]` - ;; with non deterministic order. - ;; - ;; Strings are transformed into a sequence of letters. - `(fn [col#] - (let [type# (type col#) - res# (setmetatable {} {:cljlib/type :seq}) - insert# table.insert] - (if (= type# :table) - (do (var assoc?# false) - (let [assoc-res# (setmetatable {} {:cljlib/type :seq})] - (each [k# v# (pairs col#)] - (if (and (not assoc?#) - (not (= (type k#) :number))) - (set assoc?# true)) - (insert# res# v#) - (insert# assoc-res# [k# v#])) - (if assoc?# assoc-res# res#))) - (= type# :string) - (let [char# utf8.char] - (each [_# b# (utf8.codes col#)] - (insert# res# (char# b#))) - res#) - (= type# :nil) nil - (error "expected table, string or nil" 2))))) - -(fn table-type-fn [] - `(fn [tbl#] - (let [t# (type tbl#)] - (if (= t# :table) - (let [meta# (getmetatable tbl#) - table-type# (and meta# (. meta# :cljlib/type))] - (if table-type# table-type# - (let [(k# _#) (next tbl#)] - (if (and (= (type k#) :number) (= k# 1)) :seq - (= k# nil) :empty - :table)))) - (= t# :nil) :nil - (= t# :string) :string - :else)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn when-meta [...] - "Wrapper that compiles away if metadata support was not enabled. What -this effectively means, is that everything that is wrapped with this -macro will disappear from the resulting Lua code if metadata is not -enabled when compiling with `fennel --compile` without `--metadata` -switch." - (when meta-enabled - `(do ,...))) - -(attach-meta when-meta {:fnl/arglist ["[& body]"]}) - -(fn meta [value] - "Get `value` metadata. If value has no metadata, or metadata -feature is not enabled returns `nil`. - -# Example - -``` fennel ->> (meta (with-meta {} {:meta \"data\"})) -;; => {:meta \"data\"} -``` - -# Note -There are several important gotchas about using metadata. - -First, note that this works only when used with Fennel, and only when -`(require fennel)` works. For compiled Lua library this feature is -turned off. - -Second, try to avoid using metadata with anything else than tables and -functions. When storing function or table as a key into metatable, -its address is used, while when storing string of number, the value is -used. This, for example, may cause documentation collision, when -you've set some variable holding a number value to have certain -docstring, and later you've defined another variable with the same -value, but different docstring. While this isn't a major breakage, it -may confuse if someone will explore your code in the REPL with `doc`. - -Lastly, note that prior to Fennel 0.7.1 `import-macros` wasn't -respecting `--metadata` switch. So if you're using Fennel < 0.7.1 -this stuff will only work if you use `require-macros` instead of -`import-macros`." - (when-meta - `(let [(res# fennel#) (pcall require :fennel)] - (if res# (. fennel#.metadata ,value))))) - -(fn with-meta [value meta] - "Attach metadata to a value. When metadata feature is not enabled, -returns the value without additional metadata. - -``` fennel ->> (local foo (with-meta (fn [...] (let [[x y z] [...]] (+ x y z))) - {:fnl/arglist [\"x\" \"y\" \"z\" \"...\"] - :fnl/docstring \"sum first three values\"})) ->> (doc foo) -(foo x y z ...) - sum first three values -```" - (if (not meta-enabled) value - `(let [value# ,value - (res# fennel#) (pcall require :fennel)] - (if res# - (each [k# v# (pairs ,meta)] - (fennel#.metadata:set value# k# v#))) - value#))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn* ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn gen-arglist-doc [args] - ;; Construct vector of arguments represented as strings from AST. - (if (list? (. args 1)) - (let [arglist [] - opener (if (> (length args) 1) "\n (" "(")] - (each [i v (ipairs args)] - (let [arglist-doc (gen-arglist-doc v)] - (when (next arglist-doc) - (table.insert - arglist - (.. opener (table.concat arglist-doc " ") ")"))))) - arglist) - - (sequence? (. args 1)) - (let [arglist [] - args (. args 1) - len (length args)] - (each [i v (ipairs args)] - (table.insert arglist - (match i - (1 ? (= len 1)) (.. "[" (tostring v) "]") - 1 (.. "[" (tostring v)) - len (.. (tostring v) "]") - _ (tostring v)))) - arglist))) - -(fn multisym->sym [s] - (if (multi-sym? s) - (values (sym (string.gsub (tostring s) ".*[.]" "")) true) - (values s false))) - -(fn has-amp? [args] - ;; Check if arglist has `&` and return its position of `false`. Performs - ;; additional checks for `&` and `...` usage in arglist. - (var res false) - (each [i s (ipairs args)] - (if (= (tostring s) "&") - (if res (assert-compile false "only one `&' can be specified in arglist." args) - (set res i)) - (= (tostring s) "...") - (assert-compile false "use of `...' in `fn*' is not permitted. Use `&' if you want a vararg." args) - (and res (> i (+ res 1))) - (assert-compile false "only one `more' argument can be supplied after `&' in arglist." args))) - res) - -(fn gen-arity [[args & body]] - ;; Forms three values, representing data needed to create dispatcher: - ;; - ;; - the length of arglist; - ;; - the body of the function we generate; - ;; - position of `&` in the arglist if any. - (assert-compile (sequence? args) "fn*: expected parameters table. - -* Try adding function parameters as a list of identifiers in brackets." args) - (values (length args) - (list 'let [args ['...]] (list 'do ((or table.unpack _G.unpack) body))) - (has-amp? args))) - -(fn grows-by-one-or-equal? [tbl] - ;; Checks if table consists of integers that grow by one or equal to - ;; eachother when sorted. Used for checking if we supplied all arities - ;; for dispatching, and there's no need in the error handling. - ;; - ;; ``` fennel - ;; (grows-by-one-or-equal? [1 3 2]) => true, because [1 2 3] - ;; (grows-by-one-or-equal? [1 4 2]) => true, because 3 is missing - ;; (grows-by-one-or-equal? [1 3 2 3]) => true, because equal values are allowed. - ;; ``` - (let [t []] - (each [_ v (ipairs tbl)] (table.insert t v)) - (table.sort t) - (var prev nil) - (each [_ cur (ipairs t)] - (if prev - (when (and (not= (+ prev 1) cur) - (not= prev cur)) - (lua "return false"))) - (set prev cur)) - prev)) - -(fn arity-dispatcher [len fixed body& name] - ;; Forms an `if` expression with all fixed arities first, then `&` arity, - ;; if present, and default error message as last arity. - ;; - ;; `len` is a symbol, that represents the length of the current argument - ;; list, and is computed at runtime. - ;; - ;; `fixed` is a table of arities with fixed amount of arguments. These - ;; are put in this `if` as: `(= len fixed-len)`, where `fixed-len` is the - ;; length of current arity arglist, computed with `gen-arity`. - ;; - ;; `body&` stores size of fixed part of arglist, that is, everything up - ;; until `&`, and the body itself. When `body&` provided, the `(>= len - ;; more-len)` is added to the resulting `if` expression. - ;; - ;; Lastly the catchall branch is added to `if` expression, which ensures - ;; that only valid amount of arguments were passed to function, which are - ;; defined by previous branches. - (let [bodies '(if) - lengths []] - (var max nil) - (each [fixed-len body (pairs (doto fixed))] - (when (or (not max) (> fixed-len max)) - (set max fixed-len)) - (table.insert lengths fixed-len) - (table.insert bodies (list '= len fixed-len)) - (table.insert bodies body)) - (when body& - (let [[more-len body arity] body&] - (assert-compile (not (and max (<= more-len max))) "fn*: arity with `&' must have more arguments than maximum arity without `&'. - -* Try adding more arguments before `&'" arity) - (table.insert lengths (- more-len 1)) - (table.insert bodies (list '>= len (- more-len 1))) - (table.insert bodies body))) - (if (not (and (grows-by-one-or-equal? lengths) - (contains? lengths 0) - body&)) - (table.insert bodies (list 'error - (.. "wrong argument amount" - (if name (.. " for " name) "")) 2))) - bodies)) - -(fn single-arity-body [args fname] - ;; Produces arglist and body for single-arity function. - ;; For more info check `gen-arity' documentation. - (let [[args & body] args - (arity body amp) (gen-arity [args ((or table.unpack _G.unpack) body)])] - `(let [len# (select :# ...)] - ,(arity-dispatcher - 'len# - (if amp {} {arity body}) - (if amp [amp body]) - fname)))) - -(fn multi-arity-body [args fname] - ;; Produces arglist and all body forms for multi-arity function. - ;; For more info check `gen-arity' documentation. - (let [bodies {} ;; bodies of fixed arity - bodies& []] ;; bodies where arglist contains `&' - (each [_ arity (ipairs args)] - (let [(n body amp) (gen-arity arity)] - (if amp - (table.insert bodies& [amp body arity]) - (tset bodies n body)))) - (assert-compile (<= (length bodies&) 1) - "fn* must have only one arity with `&':" - (. bodies& (length bodies&))) - `(let [len# (select :# ...)] - ,(arity-dispatcher - 'len# - bodies - (if (not= (next bodies&) nil) - (. bodies& 1)) - fname)))) - -(fn fn* [name doc? ...] - "Create (anonymous) function of fixed arity. -Supports multiple arities by defining bodies as lists: - -# Examples -Named function of fixed arity 2: - -``` fennel -(fn* f [a b] (+ a b)) -``` - -Function of fixed arities 1 and 2: - -``` fennel -(fn* ([x] x) - ([x y] (+ x y))) -``` - -Named function of 2 arities, one of which accepts 0 arguments, and the -other one or more arguments: - -``` fennel -(fn* f - ([] nil) - ([x & xs] - (print x) - (f (unpack xs)))) -``` - -Note, that this function is recursive, and calls itself with less and -less amount of arguments until there's no arguments, and terminates -when the zero-arity body is called. - -Named functions accept additional documentation string before the -argument list: - -``` fennel -(fn* cube - \"raise `x` to power of 3\" - [x] - (^ x 3)) - -(fn* greet - \"greet a `person`, optionally specifying default `greeting`.\" - ([person] (print (.. \"Hello, \" person \"!\"))) - ([greeting person] (print (.. greeting \", \" person \"!\")))) -``` - -Argument lists follow the same destruction rules as per `let`. -Variadic arguments with `...` are not supported use `& rest` instead. -Note that only one arity with `&` is supported. - -### Namespaces -If function name contains namespace part, defines local variable -without namespace part, then creates function with this name, sets -this function to the namespace, and returns it. - -This roughly means, that instead of writing this: - -``` fennel -(local ns {}) - -(fn f [x] ;; we have to define `f` without `ns` - (if (> x 0) (f (- x 1)))) ;; because we're going to use it in `g` - -(set ns.f f) - -(fn ns.g [x] (f (* x 100))) ;; `g` can be defined as `ns.g` as it is only exported - -ns -``` - -It is possible to write: - -``` fennel -(local ns {}) - -(fn* ns.f [x] - (if (> x 0) (f (- x 1)))) - -(fn* ns.g [x] (f (* x 100))) ;; we can use `f` here no problem - -ns -``` - -It is still possible to call `f` and `g` in current scope without `ns` -part, so functions can be reused inside the module, and `ns` will hold -both functions, so it can be exported from the module. - -Note that `fn` will not create the `ns` for you, hence this is just a -syntax sugar. Functions deeply nested in namespaces require exising -namespace tables: - -``` fennel -(local ns {:strings {} - :tables {}}) - -(fn* ns.strings.join - ([s1 s2] (.. s1 s2)) - ([s1 s2 & strings] - (join (join s1 s2) (unpack strings)))) ;; call `join` resolves to ns.strings.join - -(fn* ns.tables.join - ([t1 t2] - (let [res []] - (each [_ v (ipairs t1)] (table.insert res v)) - (each [_ v (ipairs t2)] (table.insert res v)) - res)) - ([t1 t2 & tables] - (join (join t1 t2) (unpack tables)))) ;; call to `join` resolves to ns.tables.join -``` - -Note that this creates a collision and local `join` overrides `join` -from `ns.strings`, so the latter must be fully qualified -`ns.strings.join` when called outside of the function: - -``` fennel -(ns.strings.join \"a\" \"b\" \"c\") -;; => abc -(join [\"a\"] [\"b\"] [\"c\"] [\"d\" \"e\"]) -;; => [\"a\" \"b\" \"c\" \"d\" \"e\"] -(join \"a\" \"b\" \"c\") -;; {} -```" - (assert-compile (not (string? name)) "fn* expects symbol, vector, or list as first argument" name) - (let [docstring (if (string? doc?) doc? nil) - (name-wo-namespace namespaced?) (multisym->sym name) - fname (if (sym? name-wo-namespace) (tostring name-wo-namespace)) - args (if (sym? name-wo-namespace) - (if (string? doc?) [...] [doc? ...]) - [name-wo-namespace doc? ...]) - arglist-doc (gen-arglist-doc args) - [x] args - - body (if (sequence? x) (single-arity-body args fname) - (list? x) (multi-arity-body args fname) - (assert-compile false "fn*: expected parameters table. - -* Try adding function parameters as a list of identifiers in brackets." x))] - (if (sym? name-wo-namespace) - (if namespaced? - `(local ,name-wo-namespace - (do - (fn ,name-wo-namespace [...] ,docstring ,body) - (set ,name ,name-wo-namespace) - ,(with-meta name-wo-namespace `{:fnl/arglist ,arglist-doc}))) - `(local ,name ,(with-meta `(fn ,name [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc}))) - (with-meta `(fn [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc})))) - -(attach-meta fn* {:fnl/arglist ["name docstring? ([arglist*] body)*"]}) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; let variants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Fennel indeed has more advanced macro `match` which can be used in -;; place of any of the following macros, however it is sometimes more -;; convenient to convey intentions by explicitly saying `when-some` -;; implying that we're interested in non-nil value and only single branch -;; of execution. The `match` macro on the other hand does not convey -;; such intention - -(fn if-let [...] - (let [[bindings then else] (match (select :# ...) - 2 [...] - 3 [...] - _ (error "wrong argument amount for if-some" 2))] - (check-two-binding-vec bindings) - (let [[form test] bindings] - `(let [tmp# ,test] - (if tmp# - (let [,form tmp#] - ,then) - ,else))))) - -(attach-meta if-let {:fnl/arglist ["[binding test]" "then-branch" "else-branch"] - :fnl/docstring "If test is logical true, -evaluates `then-branch` with binding-form bound to the value of test, -if not, yields `else-branch`."}) - - -(fn when-let [...] - (let [[bindings & body] (if (> (select :# ...) 0) [...] - (error "wrong argument amount for when-let" 2))] - (check-two-binding-vec bindings) - (let [[form test] bindings] - `(let [tmp# ,test] - (if tmp# - (let [,form tmp#] - ,((or table.unpack _G.unpack) body))))))) - -(attach-meta when-let {:fnl/arglist ["[binding test]" "& body"] - :fnl/docstring "If test is logical true, -evaluates `body` in implicit `do`."}) - - -(fn if-some [...] - (let [[bindings then else] (match (select :# ...) - 2 [...] - 3 [...] - _ (error "wrong argument amount for if-some" 2))] - (check-two-binding-vec bindings) - (let [[form test] bindings] - `(let [tmp# ,test] - (if (= tmp# nil) - ,else - (let [,form tmp#] - ,then)))))) - -(attach-meta if-some {:fnl/arglist ["[binding test]" "then-branch" "else-branch"] - :fnl/docstring "If test is non-`nil`, evaluates -`then-branch` with binding-form bound to the value of test, if not, -yields `else-branch`."}) - - -(fn when-some [...] - (let [[bindings & body] (if (> (select :# ...) 0) [...] - (error "wrong argument amount for when-some" 2))] - (check-two-binding-vec bindings) - (let [[form test] bindings] - `(let [tmp# ,test] - (if (= tmp# nil) - nil - (let [,form tmp#] - ,((or table.unpack _G.unpack) body))))))) - -(attach-meta when-some {:fnl/arglist ["[binding test]" "& body"] - :fnl/docstring "If test is non-`nil`, -evaluates `body` in implicit `do`."}) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; into ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn table-type [tbl] - (if (sequence? tbl) :seq - (table? tbl) :table - :else)) - -(fn into [to from] - "Transform one table into another. Mutates first table. - -Transformation happens in runtime, but type deduction happens in -compile time if possible. This means, that if literal values passed -to `into` this will have different effects for associative tables and -vectors: - -``` fennel -(into [1 2 3] [4 5 6]) ;; => [1 2 3 4 5 6] -(into {:a 1 :c 2} {:a 0 :b 1}) ;; => {:a 0 :b 1 :c 2} -``` - -Conversion between different table types is also supported: - -``` fennel -(into [] {:a 1 :b 2 :c 3}) ;; => [[:a 1] [:b 2] [:c 3]] -(into {} [[:a 1] [:b 2]]) ;; => {:a 1 :b 2} -``` - -Same rules apply to runtime detection of table type, except that this -will not work for empty tables: - -``` fennel -(local empty-table {}) -(into empty-table {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] -``` fennel - -If table is empty, `into` defaults to sequential table, because it -allows safe conversion from both sequential and associative tables. - -Type for non empty tables hidden in variables can be deduced at -runtime, and this works as expected: - -``` fennel -(local t1 [1 2 3]) -(local t2 {:a 10 :c 3}) -(into t1 {:a 1 :b 2}) ;; => [1 2 3 [:a 1] [:b 2]] -(into t2 {:a 1 :b 2}) ;; => {:a 1 :b 2 :c 3} -``` - -`cljlib.fnl` module provides two additional functions `vector` and -`hash-map`, that can create empty tables, which can be distinguished -at runtime: - -``` fennel -(into (vector) {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] -(into (hash-map) [[:a 1 :b 2]]) ;; => {:a 1 :b 2} -```" - (assert-compile (and to from) "into: expected two arguments") - (let [to-type (table-type to) - from-type (table-type from)] - (if (and (= to-type :seq) (= from-type :seq)) - `(let [to# (or ,to []) - insert# table.insert] - (each [_# v# (ipairs (or ,from []))] - (insert# to# v#)) - (setmetatable to# {:cljlib/type :seq})) - (= to-type :seq) - `(let [to# (or ,to []) - seq# ,(seq-fn) - insert# table.insert] - (each [_# v# (ipairs (seq# (or ,from [])))] - (insert# to# v#)) - (setmetatable to# {:cljlib/type :seq})) - (and (= to-type :table) (= from-type :seq)) - `(let [to# (or ,to [])] - (each [_# [k# v#] (ipairs (or ,from []))] - (tset to# k# v#)) - (setmetatable to# {:cljlib/type :table})) - (and (= to-type :table) (= from-type :table)) - `(let [to# (or ,to []) - from# (or ,from [])] - (each [k# v# (pairs from#)] - (tset to# k# v#)) - (setmetatable to# {:cljlib/type :table})) - (= to-type :table) - `(let [to# (or ,to []) - from# (or ,from [])] - (match (,(table-type-fn) from#) - :seq (each [_# [k# v#] (ipairs from#)] - (tset to# k# v#)) - :table (each [k# v# (pairs from#)] - (tset to# k# v#)) - :else (error "expected table as second argument" 2)) - (setmetatable to# {:cljlib/type :table})) - ;; runtime branch - `(let [to# ,to - from# ,from - insert# table.insert - table-type# ,(table-type-fn) - seq# ,(seq-fn) - to-type# (table-type# to#) - to# (or to# []) ;; secure nil - res# (match to-type# - ;; Sequence or empty table - (seq1# ? (or (= seq1# :seq) (= seq1# :empty))) - (do (each [_# v# (ipairs (seq# (or from# [])))] - (insert# to# v#)) - to#) - ;; associative table - :table (match (table-type# from#) - (seq2# ? (or (= seq2# :seq) (= seq2# :string))) - (do (each [_# [k# v#] (ipairs (or from# []))] - (tset to# k# v#)) - to#) - :table (do (each [k# v# (pairs (or from# []))] - (tset to# k# v#)) - to#) - :empty to# - :else (error "expected table as second argument" 2)) - ;; set both ordered set and hash set - (Set# ? (or (= Set# :cljlib/ordered-set) (= Set# :cljlib/hash-set))) - (do (each [_# v# (ipairs (seq# (or from# [])))] - (tset to# v# v#)) - to#) - ;; sometimes it is handy to pass nil too - :nil (match (table-type# from#) - :nil nil - :empty to# - :seq (do (each [k# v# (pairs (or from# []))] - (tset to# k# v#)) - to#) - :table (do (each [k# v# (pairs (or from# []))] - (tset to# k# v#)) - to#) - :else (error "expected table as second argument" 2)) - :else (error "expected table as first argument" 2))] - (if res# - (let [m# (or (getmetatable res#) {})] - (set m#.cljlib/type (match to-type# - :seq :seq - :empty :seq - :table :table - t# t#)) - (setmetatable res# m#))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; empty ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn empty [x] - "Return empty table of the same kind as input table `x`, with -additional metadata indicating its type. - -# Example -Creating a generic `map` function, that will work on any table type, -and return result of the same type: - -``` fennel -(fn map [f tbl] - (let [res []] - (each [_ v (ipairs (into [] tbl))] - (table.insert res (f v))) - (into (empty tbl) res))) - -(map (fn [[k v]] [(string.upper k) v]) {:a 1 :b 2 :c 3}) -;; => {:A 1 :B 2 :C 3} -(map #(* $ $) [1 2 3 4]) -;; [1 4 9 16] -``` -See [`into`](#into) for more info on how conversion is done." - (match (table-type x) - :seq `(setmetatable {} {:cljlib/type :seq}) - :table `(setmetatable {} {:cljlib/type :table}) - _ `(let [x# ,x] - (match (,(table-type-fn) x#) - :cljlib/ordered-set (: x# :cljlib/empty) - :cljlib/hash-set (: x# :cljlib/empty) - t# (setmetatable {} {:cljlib/type t#}))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; multimethods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn seq->table [seq] - (let [tbl {}] - (for [i 1 (length seq) 2] - (tset tbl (. seq i) (. seq (+ i 1)))) - tbl)) - -(fn defmulti [...] - (let [[name & options] (if (> (select :# ...) 0) [...] - (error "wrong argument amount for defmulti")) - docstring (if (string? (first options)) (first options)) - options (if docstring (rest options) options) - dispatch-fn (first options) - options (rest options)] - (assert (= (% (length options) 2) 0) "wrong argument amount for defmulti") - (let [options (seq->table options)] - (if (in-scope? name) - `nil - `(local ,name - (setmetatable - ,(with-meta {} {:fnl/docstring docstring}) - {:__index - (fn [tbl# key#] - (let [eq# ,(eq-fn)] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#)) - :__call - (fn [t# ...] - ,docstring - (let [dispatch-value# (,dispatch-fn ...) - (res# view#) (pcall require :fennelview) - tostr# (if res# view# tostring)] - ((or (. t# dispatch-value#) - (. t# (or (. ,options :default) :default)) - (error (.. "No method in multimethod '" - ,(tostring name) - "' for dispatch value: " - (tostr# dispatch-value#)) - 2)) ...))) - :__name (.. "multifn " ,(tostring name)) - :__fennelview tostring - :cljlib/type :multifn})))))) - -(attach-meta defmulti {:fnl/arglist [:name :docstring? :dispatch-fn :attr-map?] - :fnl/docstring "Create multifunction with -runtime dispatching based on results from `dispatch-fn`. Returns an -empty table with `__call` metamethod, that calls `dispatch-fn` on its -arguments. Amount of arguments passed, should be the same as accepted -by `dispatch-fn`. Looks for multimethod based on result from -`dispatch-fn`. - -By default, multifunction has no multimethods, see -[`multimethod`](#multimethod) on how to add one."}) - - -(fn defmethod [multifn dispatch-val ...] - (when (= (select :# ...) 0) (error "wrong argument amount for defmethod")) - `(doto ,multifn (tset ,dispatch-val (do (fn* f# ,...) f#)))) - -(attach-meta defmethod {:fnl/arglist [:multifn :dispatch-val :fnspec] - :fnl/docstring "Attach new method to multi-function dispatch value. accepts the `multi-fn` -as its first argument, the dispatch value as second, and function tail -starting from argument list, followed by function body as in -[`fn*`](#fn). - -# Examples -Here are some examples how multimethods can be used. - -## Factorial example -Key idea here is that multimethods can call itself with different -values, and will dispatch correctly. Here, `fac` recursively calls -itself with less and less number until it reaches `0` and dispatches -to another multimethod: - -``` fennel -(defmulti fac (fn [x] x)) - -(defmethod fac 0 [_] 1) -(defmethod fac :default [x] (* x (fac (- x 1)))) - -(fac 4) ;; => 24 -``` - -`:default` is a special method which gets called when no other methods -were found for given dispatch value. - -## Multi-arity dispatching -Multi-arity function tails are also supported: - -``` fennel -(defmulti foo (fn* ([x] [x]) ([x y] [x y]))) - -(defmethod foo [10] [_] (print \"I've knew I'll get 10\")) -(defmethod foo [10 20] [_ _] (print \"I've knew I'll get both 10 and 20\")) -(defmethod foo :default ([x] (print (.. \"Umm, got\" x))) - ([x y] (print (.. \"Umm, got both \" x \" and \" y)))) -``` - -Calling `(foo 10)` will print `\"I've knew I'll get 10\"`, and calling -`(foo 10 20)` will print `\"I've knew I'll get both 10 and 20\"`. -However, calling `foo` with any other numbers will default either to -`\"Umm, got x\"` message, when called with single value, and `\"Umm, got -both x and y\"` when calling with two values. - -## Dispatching on object's type -We can dispatch based on types the same way we dispatch on values. -For example, here's a naive conversion from Fennel's notation for -tables to Lua's one: - -``` fennel -(defmulti to-lua-str (fn [x] (type x))) - -(defmethod to-lua-str :number [x] (tostring x)) -(defmethod to-lua-str :table [x] (let [res []] - (each [k v (pairs x)] - (table.insert res (.. \"[\" (to-lua-str k) \"] = \" (to-lua-str v)))) - (.. \"{\" (table.concat res \", \") \"}\"))) -(defmethod to-lua-str :string [x] (.. \"\\\"\" x \"\\\"\")) -(defmethod to-lua-str :default [x] (tostring x)) -``` - -And if we call it on some table, we'll get a valid Lua table: - -``` fennel -(print (to-lua-str {:a {:b 10}})) -;; prints {[\"a\"] = {[\"b\"] = 10}} - -(print (to-lua-str [:a :b :c [:d {:e :f}]])) -;; prints {[1] = \"a\", [2] = \"b\", [3] = \"c\", [4] = {[1] = \"d\", [2] = {[\"e\"] = \"f\"}}} -``` - -Which we can then reformat as we want and use in Lua if we want."}) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; def and defonce ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn def [...] - (let [[attr-map name expr] (match (select :# ...) - 2 [{} ...] - 3 [...] - _ (error "wrong argument amount for def" 2)) - attr-map (if (table? attr-map) attr-map - (string? attr-map) {attr-map true} - (error "def: expected keyword or literal table as first argument" 2)) - (s multi) (multisym->sym name) - docstring (or (. attr-map :doc) - (. attr-map :fnl/docstring)) - f (if (. attr-map :mutable) 'var 'local)] - (if multi - `(,f ,s (do (,f ,s ,expr) - (set ,name ,s) - ,(with-meta s {:fnl/docstring docstring}))) - `(,f ,name ,(with-meta expr {:fnl/docstring docstring}))))) - -(attach-meta def {:fnl/arglist [:attr-map? :name :expr] - :fnl/docstring "Wrapper around `local` which can -declare variables inside namespace, and as local at the same time -similarly to [`fn*`](#fn*): - -``` fennel -(def ns {}) -(def a 10) ;; binds `a` to `10` - -(def ns.b 20) ;; binds `ns.b` and `b` to `20` -``` - -`a` is a `local`, and both `ns.b` and `b` refer to the same value. - -Additionally metadata can be attached to values, by providing -attribute map or keyword as first parameter. Only one keyword is -supported, which is `:mutable`, which allows mutating variable with -`set` later on: - -``` fennel -;; Bad, will override existing documentation for 299792458 (if any) -(def {:doc \"speed of light in m/s\"} c 299792458) -(set c 0) ;; => error, can't mutate `c` - -(def :mutable address \"Lua St.\") ;; same as (def {:mutable true} address \"Lua St.\") -(set address \"Lisp St.\") ;; can mutate `address` -``` - -However, attaching documentation metadata to anything other than -tables and functions considered bad practice, due to how Lua -works. More info can be found in [`with-meta`](#with-meta) -description."}) - -(fn defonce [...] - (let [[attr-map name expr] (match (select :# ...) - 2 [{} ...] - 3 [...] - _ (error "wrong argument amount for def" 2))] - (if (in-scope? name) - nil - (def attr-map name expr)))) - -(attach-meta defonce {:fnl/arglist [:attr-map? :name :expr] - :fnl/docstring "Works the same as [`def`](#def), but ensures that later `defonce` -calls will not override existing bindings: - -``` fennel -(defonce a 10) -(defonce a 20) -(print a) ;; => prints 10 -```"}) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; try ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(fn catch? [[fun]] - (= (tostring fun) :catch)) - -(fn finally? [[fun]] - (= (tostring fun) :finally)) - -(fn add-finally [finally form] - "Stores `form` as body of `finally`, which will be injected into -`match` branches at places appropriate for it to run. - -Checks if there already was `finally` clause met, which can be only -one." - (assert-compile (= (length finally) 0) - "Only one finally clause can exist in try expression" - []) - (table.insert finally (list 'do ((or table.unpack _G.unpack) form 2)))) - -(fn add-catch [finally catches form] - "Appends `catch` body to a sequence of catch bodies that will later -be used in `make-catch-clauses` to produce AST. - -Checks if there already was `finally` clause met." - (assert-compile (= (length finally) 0) - "finally clause must be last in try expression" - []) - (table.insert catches (list 'do ((or table.unpack _G.unpack) form 2)))) - -(fn make-catch-clauses [catches finally] - "Generates AST of error branches for `match` macro." - (let [clauses []] - (var add-catchall? true) - (each [_ [_ binding-or-val & body] (ipairs catches)] - (when (sym? binding-or-val) - (set add-catchall? false)) - (table.insert clauses `(false ,binding-or-val)) - (table.insert clauses `(let [res# (do ,((or table.unpack _G.unpack) body))] - ,(. finally 1) - res#))) - (when add-catchall? - ;; implicit catchall which retrows error further is added only - ;; if there were no catch clause that used symbol as catch value - (table.insert clauses `(false _#)) - (table.insert clauses `(do ,(. finally 1) (error _#)))) - ((or table.unpack _G.unpack) clauses))) - -(fn add-to-try [finally catches try form] - "Append form to the try body. There must be no `catch` of `finally` -clauses when we push body epression." - (assert-compile (and (= (length finally) 0) - (= (length catches) 0)) - "Only catch or finally clause can follow catch in try expression" - []) - (table.insert try form)) - -(fn try [...] - (let [try '(fn []) - catches [] - finally []] - (each [_ form (ipairs [...])] - (if (list? form) - (if (catch? form) (add-catch finally catches form) - (finally? form) (add-finally finally form) - (add-to-try finally catches try form)) - (add-to-try finally catches try form))) - `(match (pcall ,try) - (true _#) (do ,(. finally 1) _#) - ,(make-catch-clauses catches finally)))) - -(attach-meta try {:fnl/arglist [:body* :catch-clause* :finally-clause?] - :fnl/docstring "General purpose try/catch/finally macro. -Wraps its body in `pcall` and checks the return value with `match` -macro. - -Catch clause is written either as (catch symbol body*), thus acting as -catch-all, or (catch value body*) for catching specific errors. It is -possible to have several `catch` clauses. If no `catch` clauses -specified, an implicit catch-all clause is created. - -Finally clause is optional, and written as (finally body*). If -present, it must be the last clause in the `try` form, and the only -`finally` clause. Note that `finally` clause is for side effects -only, and runs either after succesful run of `try` body, or after any -`catch` clause body, before returning the result. If no `catch` -clause is provided `finally` runs in implicit catch-all clause, and -trows error to upper scope using `error` function. - -To throw error from `try` to catch it with `catch` clause use `error` -or `assert` functions. - -# Examples -Catch all errors, ignore those and return fallback value: - -``` fennel -(fn add [x y] - (try - (+ x y) - (catch _ 0))) - -(add nil 1) ;; => 0 -``` - -Catch error and do cleanup: - -``` fennel ->> (let [tbl []] - (try - (table.insert tbl \"a\") - (table.insert tbl \"b\" \"c\") - (catch _ - (each [k _ (pairs tbl)] - (tset tbl k nil)))) - tbl) -{} -``` - -Always run some side effect action: - -``` fennel ->> (local res (try 10 (finally (print \"side-effect!\"))) -side-effect! -nil ->> res -10 ->> (local res (try (error 10) (catch 10 nil) (finally (print \"side-effect!\"))) -side-effect! -nil ->> res -nil -``` -"}) - - -{: fn* - : try - : if-let - : when-let - : if-some - : when-some - : empty - : into - : when-meta - : with-meta - : meta - : defmulti - : defmethod - : def - : defonce - :_VERSION #"0.3.0" - :_LICENSE #"[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)" - :_COPYRIGHT #"Copyright (C) 2020 Andrey Orst" - :_DOC_ORDER #[:fn* - :try - :def :defonce :defmulti :defmethod - :into :empty - :when-meta :with-meta :meta - :if-let :when-let :if-some :when-some] - :_DESCRIPTION #"Macros for Cljlib that implement various facilities from Clojure."} - -;; LocalWords: arglist fn runtime arities arity multi destructuring -;; LocalWords: docstring Variadic LocalWords multisym sym tbl eq Lua -;; LocalWords: defonce metadata metatable fac defmulti Umm defmethod -;; LocalWords: multimethods multimethod multifn REPL fnl AST Lua's -;; LocalWords: lua tostring str concat namespace ns Cljlib Clojure 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 diff --git a/doc/cljlib-macros.md b/doc/cljlib-macros.md deleted file mode 100644 index a29fb0f..0000000 --- a/doc/cljlib-macros.md +++ /dev/null @@ -1,581 +0,0 @@ -# Cljlib-macros.fnl (0.3.0) -Macros for Cljlib that implement various facilities from Clojure. - -**Table of contents** - -- [`fn*`](#fn*) -- [`try`](#try) -- [`def`](#def) -- [`defonce`](#defonce) -- [`defmulti`](#defmulti) -- [`defmethod`](#defmethod) -- [`into`](#into) -- [`empty`](#empty) -- [`when-meta`](#when-meta) -- [`with-meta`](#with-meta) -- [`meta`](#meta) -- [`if-let`](#if-let) -- [`when-let`](#when-let) -- [`if-some`](#if-some) -- [`when-some`](#when-some) - -## `fn*` -Function signature: - -``` -(fn* name docstring? ([arglist*] body)*) -``` - -Create (anonymous) function of fixed arity. -Supports multiple arities by defining bodies as lists: - -### Examples -Named function of fixed arity 2: - -``` fennel -(fn* f [a b] (+ a b)) -``` - -Function of fixed arities 1 and 2: - -``` fennel -(fn* ([x] x) - ([x y] (+ x y))) -``` - -Named function of 2 arities, one of which accepts 0 arguments, and the -other one or more arguments: - -``` fennel -(fn* f - ([] nil) - ([x & xs] - (print x) - (f (unpack xs)))) -``` - -Note, that this function is recursive, and calls itself with less and -less amount of arguments until there's no arguments, and terminates -when the zero-arity body is called. - -Named functions accept additional documentation string before the -argument list: - -``` fennel -(fn* cube - "raise `x` to power of 3" - [x] - (^ x 3)) - -(fn* greet - "greet a `person`, optionally specifying default `greeting`." - ([person] (print (.. "Hello, " person "!"))) - ([greeting person] (print (.. greeting ", " person "!")))) -``` - -Argument lists follow the same destruction rules as per `let`. -Variadic arguments with `...` are not supported use `& rest` instead. -Note that only one arity with `&` is supported. - -##### Namespaces -If function name contains namespace part, defines local variable -without namespace part, then creates function with this name, sets -this function to the namespace, and returns it. - -This roughly means, that instead of writing this: - -``` fennel -(local ns {}) - -(fn f [x] ;; we have to define `f` without `ns` - (if (> x 0) (f (- x 1)))) ;; because we're going to use it in `g` - -(set ns.f f) - -(fn ns.g [x] (f (* x 100))) ;; `g` can be defined as `ns.g` as it is only exported - -ns -``` - -It is possible to write: - -``` fennel -(local ns {}) - -(fn* ns.f [x] - (if (> x 0) (f (- x 1)))) - -(fn* ns.g [x] (f (* x 100))) ;; we can use `f` here no problem - -ns -``` - -It is still possible to call `f` and `g` in current scope without `ns` -part, so functions can be reused inside the module, and `ns` will hold -both functions, so it can be exported from the module. - -Note that `fn` will not create the `ns` for you, hence this is just a -syntax sugar. Functions deeply nested in namespaces require exising -namespace tables: - -``` fennel -(local ns {:strings {} - :tables {}}) - -(fn* ns.strings.join - ([s1 s2] (.. s1 s2)) - ([s1 s2 & strings] - (join (join s1 s2) (unpack strings)))) ;; call `join` resolves to ns.strings.join - -(fn* ns.tables.join - ([t1 t2] - (let [res []] - (each [_ v (ipairs t1)] (table.insert res v)) - (each [_ v (ipairs t2)] (table.insert res v)) - res)) - ([t1 t2 & tables] - (join (join t1 t2) (unpack tables)))) ;; call to `join` resolves to ns.tables.join -``` - -Note that this creates a collision and local `join` overrides `join` -from `ns.strings`, so the latter must be fully qualified -`ns.strings.join` when called outside of the function: - -``` fennel -(ns.strings.join "a" "b" "c") -;; => abc -(join ["a"] ["b"] ["c"] ["d" "e"]) -;; => ["a" "b" "c" "d" "e"] -(join "a" "b" "c") -;; {} -``` - -## `try` -Function signature: - -``` -(try body* catch-clause* finally-clause?) -``` - -General purpose try/catch/finally macro. - -(try expression* catch-clause* finally-clause?) - -Wraps its body in `pcall` and checks the return value with `match` -macro. - -Catch-clause is written either as (catch symbol body*), thus acting as -catch-all, or (catch value body*) for catching specific errors. It is -possible to have several `catch` clauses. If no `catch` clauses -specified, an implicit catch-all clause is created. - -Finally-clause is optional, and written as (finally body*). If -present, it must be the last clause in the `try` form, and the only -`finally` clause. Note that `finally` clause is for side effects -only, and runs either after succesful run of `try` body, or after any -`catch` clause body, before returning the result. If no `catch` -clause is provided `finally` runs in implicit catch-all clause, and -trows error to upper scope using `error` function. - -To throw error from `try` to catch it with `catch` clause use `error` -or `assert` functions. - -### Examples -Catch all errors, ignore those and return fallback value: - -``` fennel -(fn add [x y] - (try - (+ x y) - (catch _ 0))) - -(add nil 1) ;; => 0 -``` - -Catch error and do cleanup: - -``` fennel ->> (let [tbl []] - (try - (table.insert tbl "a") - (table.insert tbl "b" "c") - (catch _ - (each [k _ (pairs tbl)] - (tset tbl k nil)))) - tbl) -{} -``` - -Always run some side effect action: - -``` fennel ->> (local res (try 10 (finally (print "side-effect!"))) -side-effect! -nil ->> rese0 ->> (local res (try (error 10) (catch 10 nil) (finally (print "side-effect!"))) -side-effect! -nil ->> res -nil -``` - - -## `def` -Function signature: - -``` -(def attr-map? name expr) -``` - -Wrapper around `local` which can -declare variables inside namespace, and as local at the same time -similarly to [`fn*`](#fn*): - -``` fennel -(def ns {}) -(def a 10) ;; binds `a` to `10` - -(def ns.b 20) ;; binds `ns.b` and `b` to `20` -``` - -`a` is a `local`, and both `ns.b` and `b` refer to the same value. - -Additionally metadata can be attached to values, by providing -attribute map or keyword as first parameter. Only one keyword is -supported, which is `:mutable`, which allows mutating variable with -`set` later on: - -``` fennel -;; Bad, will override existing documentation for 299792458 (if any) -(def {:doc "speed of light in m/s"} c 299792458) -(set c 0) ;; => error, can't mutate `c` - -(def :mutable address "Lua St.") ;; same as (def {:mutable true} address "Lua St.") -(set address "Lisp St.") ;; can mutate `address` -``` - -However, attaching documentation metadata to anything other than -tables and functions considered bad practice, due to how Lua -works. More info can be found in [`with-meta`](#with-meta) -description. - -## `defonce` -Function signature: - -``` -(defonce attr-map? name expr) -``` - -Works the same as [`def`](#def), but ensures that later `defonce` -calls will not override existing bindings: - -``` fennel -(defonce a 10) -(defonce a 20) -(print a) ;; => prints 10 -``` - -## `defmulti` -Function signature: - -``` -(defmulti name docstring? dispatch-fn attr-map?) -``` - -Create multifunction with -runtime dispatching based on results from `dispatch-fn`. Returns an -empty table with `__call` metamethod, that calls `dispatch-fn` on its -arguments. Amount of arguments passed, should be the same as accepted -by `dispatch-fn`. Looks for multimethod based on result from -`dispatch-fn`. - -By default, multifunction has no multimethods, see -[`multimethod`](#multimethod) on how to add one. - -## `defmethod` -Function signature: - -``` -(defmethod multifn dispatch-val fnspec) -``` - -Attach new method to multi-function dispatch value. accepts the `multi-fn` -as its first argument, the dispatch value as second, and function tail -starting from argument list, followed by function body as in -[`fn*`](#fn). - -### Examples -Here are some examples how multimethods can be used. - -#### Factorial example -Key idea here is that multimethods can call itself with different -values, and will dispatch correctly. Here, `fac` recursively calls -itself with less and less number until it reaches `0` and dispatches -to another multimethod: - -``` fennel -(defmulti fac (fn [x] x)) - -(defmethod fac 0 [_] 1) -(defmethod fac :default [x] (* x (fac (- x 1)))) - -(fac 4) ;; => 24 -``` - -`:default` is a special method which gets called when no other methods -were found for given dispatch value. - -#### Multi-arity dispatching -Multi-arity function tails are also supported: - -``` fennel -(defmulti foo (fn* ([x] [x]) ([x y] [x y]))) - -(defmethod foo [10] [_] (print "I've knew I'll get 10")) -(defmethod foo [10 20] [_ _] (print "I've knew I'll get both 10 and 20")) -(defmethod foo :default ([x] (print (.. "Umm, got" x))) - ([x y] (print (.. "Umm, got both " x " and " y)))) -``` - -Calling `(foo 10)` will print `"I've knew I'll get 10"`, and calling -`(foo 10 20)` will print `"I've knew I'll get both 10 and 20"`. -However, calling `foo` with any other numbers will default either to -`"Umm, got x"` message, when called with single value, and `"Umm, got -both x and y"` when calling with two values. - -#### Dispatching on object's type -We can dispatch based on types the same way we dispatch on values. -For example, here's a naive conversion from Fennel's notation for -tables to Lua's one: - -``` fennel -(defmulti to-lua-str (fn [x] (type x))) - -(defmethod to-lua-str :number [x] (tostring x)) -(defmethod to-lua-str :table [x] (let [res []] - (each [k v (pairs x)] - (table.insert res (.. "[" (to-lua-str k) "] = " (to-lua-str v)))) - (.. "{" (table.concat res ", ") "}"))) -(defmethod to-lua-str :string [x] (.. "\"" x "\"")) -(defmethod to-lua-str :default [x] (tostring x)) -``` - -And if we call it on some table, we'll get a valid Lua table: - -``` fennel -(print (to-lua-str {:a {:b 10}})) -;; prints {["a"] = {["b"] = 10}} - -(print (to-lua-str [:a :b :c [:d {:e :f}]])) -;; prints {[1] = "a", [2] = "b", [3] = "c", [4] = {[1] = "d", [2] = {["e"] = "f"}}} -``` - -Which we can then reformat as we want and use in Lua if we want. - -## `into` -Function signature: - -``` -(into to from) -``` - -Transform one table into another. Mutates first table. - -Transformation happens in runtime, but type deduction happens in -compile time if possible. This means, that if literal values passed -to `into` this will have different effects for associative tables and -vectors: - -``` fennel -(into [1 2 3] [4 5 6]) ;; => [1 2 3 4 5 6] -(into {:a 1 :c 2} {:a 0 :b 1}) ;; => {:a 0 :b 1 :c 2} -``` - -Conversion between different table types is also supported: - -``` fennel -(into [] {:a 1 :b 2 :c 3}) ;; => [[:a 1] [:b 2] [:c 3]] -(into {} [[:a 1] [:b 2]]) ;; => {:a 1 :b 2} -``` - -Same rules apply to runtime detection of table type, except that this -will not work for empty tables: - -``` fennel -(local empty-table {}) -(into empty-table {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] -``` fennel - -If table is empty, `into` defaults to sequential table, because it -allows safe conversion from both sequential and associative tables. - -Type for non empty tables hidden in variables can be deduced at -runtime, and this works as expected: - -``` fennel -(local t1 [1 2 3]) -(local t2 {:a 10 :c 3}) -(into t1 {:a 1 :b 2}) ;; => [1 2 3 [:a 1] [:b 2]] -(into t2 {:a 1 :b 2}) ;; => {:a 1 :b 2 :c 3} -``` - -`cljlib.fnl` module provides two additional functions `vector` and -`hash-map`, that can create empty tables, which can be distinguished -at runtime: - -``` fennel -(into (vector) {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] -(into (hash-map) [[:a 1 :b 2]]) ;; => {:a 1 :b 2} -``` - -## `empty` -Function signature: - -``` -(empty x) -``` - -Return empty table of the same kind as input table `x`, with -additional metadata indicating its type. - -### Example -Creating a generic `map` function, that will work on any table type, -and return result of the same type: - -``` fennel -(fn map [f tbl] - (let [res []] - (each [_ v (ipairs (into [] tbl))] - (table.insert res (f v))) - (into (empty tbl) res))) - -(map (fn [[k v]] [(string.upper k) v]) {:a 1 :b 2 :c 3}) -;; => {:A 1 :B 2 :C 3} -(map #(* $ $) [1 2 3 4]) -;; [1 4 9 16] -``` -See [`into`](#into) for more info on how conversion is done. - -## `when-meta` -Function signature: - -``` -(when-meta [& body]) -``` - -Wrapper that compiles away if metadata support was not enabled. What -this effectively means, is that everything that is wrapped with this -macro will disappear from the resulting Lua code if metadata is not -enabled when compiling with `fennel --compile` without `--metadata` -switch. - -## `with-meta` -Function signature: - -``` -(with-meta value meta) -``` - -Attach metadata to a value. When metadata feature is not enabled, -returns the value without additional metadata. - -``` fennel ->> (local foo (with-meta (fn [...] (let [[x y z] [...]] (+ x y z))) - {:fnl/arglist ["x" "y" "z" "..."] - :fnl/docstring "sum first three values"})) ->> (doc foo) -(foo x y z ...) - sum first three values -``` - -## `meta` -Function signature: - -``` -(meta value) -``` - -Get `value` metadata. If value has no metadata, or metadata -feature is not enabled returns `nil`. - -### Example - -``` fennel ->> (meta (with-meta {} {:meta "data"})) -;; => {:meta "data"} -``` - -### Note -There are several important gotchas about using metadata. - -First, note that this works only when used with Fennel, and only when -`(require fennel)` works. For compiled Lua library this feature is -turned off. - -Second, try to avoid using metadata with anything else than tables and -functions. When storing function or table as a key into metatable, -its address is used, while when storing string of number, the value is -used. This, for example, may cause documentation collision, when -you've set some variable holding a number value to have certain -docstring, and later you've defined another variable with the same -value, but different docstring. While this isn't a major breakage, it -may confuse if someone will explore your code in the REPL with `doc`. - -Lastly, note that prior to Fennel 0.7.1 `import-macros` wasn't -respecting `--metadata` switch. So if you're using Fennel < 0.7.1 -this stuff will only work if you use `require-macros` instead of -`import-macros`. - -## `if-let` -Function signature: - -``` -(if-let [binding test] then-branch else-branch) -``` - -If test is logical true, -evaluates `then-branch` with binding-form bound to the value of test, -if not, yields `else-branch`. - -## `when-let` -Function signature: - -``` -(when-let [binding test] & body) -``` - -If test is logical true, -evaluates `body` in implicit `do`. - -## `if-some` -Function signature: - -``` -(if-some [binding test] then-branch else-branch) -``` - -If test is non-`nil`, evaluates -`then-branch` with binding-form bound to the value of test, if not, -yields `else-branch`. - -## `when-some` -Function signature: - -``` -(when-some [binding test] & body) -``` - -If test is non-`nil`, -evaluates `body` in implicit `do`. - - ---- - -Copyright (C) 2020 Andrey Orst - -License: [MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE) - - - diff --git a/doc/cljlib.md b/doc/cljlib.md index ee686cf..54d8294 100644 --- a/doc/cljlib.md +++ b/doc/cljlib.md @@ -1,10 +1,10 @@ -# Cljlib.fnl (0.3.0) +# Cljlib (0.4.0) 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: +Fennel specific so it should work on Lua, e.g: ``` lua Lua 5.3.5 Copyright (C) 1994-2018 Lua.org, PUC-Rio @@ -35,6 +35,17 @@ 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. + **Table of contents** - [`apply`](#apply) @@ -142,12 +153,7 @@ Applying `print` to different arguments: Function signature: ``` -(add - ([a]) - ([a b]) - ([a b c]) - ([a b c d]) - ([a b c d & rest])) +(add ([]) ([a]) ([a b]) ([a b c]) ([a b c d]) ([a b c d & rest])) ``` Sum arbitrary amount of numbers. @@ -156,12 +162,7 @@ Sum arbitrary amount of numbers. Function signature: ``` -(sub - ([a]) - ([a b]) - ([a b c]) - ([a b c d]) - ([a b c d & rest])) +(sub ([]) ([a]) ([a b]) ([a b c]) ([a b c d]) ([a b c d & rest])) ``` Subtract arbitrary amount of numbers. @@ -170,12 +171,7 @@ Subtract arbitrary amount of numbers. Function signature: ``` -(mul - ([a]) - ([a b]) - ([a b c]) - ([a b c d]) - ([a b c d & rest])) +(mul ([]) ([a]) ([a b]) ([a b c]) ([a b c d]) ([a b c d & rest])) ``` Multiply arbitrary amount of numbers. @@ -184,12 +180,7 @@ Multiply arbitrary amount of numbers. Function signature: ``` -(div - ([a]) - ([a b]) - ([a b c]) - ([a b c d]) - ([a b c d & rest])) +(div ([a]) ([a b]) ([a b c]) ([a b c d]) ([a b c d & rest])) ``` Divide arbitrary amount of numbers. @@ -198,10 +189,7 @@ Divide arbitrary amount of numbers. Function signature: ``` -(le - ([x]) - ([x y]) - ([x y & more])) +(le ([x]) ([x y]) ([x y & more])) ``` Returns true if nums are in monotonically non-decreasing order @@ -210,10 +198,7 @@ Returns true if nums are in monotonically non-decreasing order Function signature: ``` -(lt - ([x]) - ([x y]) - ([x y & more])) +(lt ([x]) ([x y]) ([x y & more])) ``` Returns true if nums are in monotonically decreasing order @@ -222,10 +207,7 @@ Returns true if nums are in monotonically decreasing order Function signature: ``` -(ge - ([x]) - ([x y]) - ([x y & more])) +(ge ([x]) ([x y]) ([x y & more])) ``` Returns true if nums are in monotonically non-increasing order @@ -234,10 +216,7 @@ Returns true if nums are in monotonically non-increasing order Function signature: ``` -(gt - ([x]) - ([x y]) - ([x y & more])) +(gt ([x]) ([x y]) ([x y & more])) ``` Returns true if nums are in monotonically increasing order @@ -246,7 +225,7 @@ Returns true if nums are in monotonically increasing order Function signature: ``` -(inc [x]) +(inc ([x])) ``` Increase number by one @@ -255,7 +234,7 @@ Increase number by one Function signature: ``` -(dec [x]) +(dec ([x])) ``` Decrease number by one @@ -264,10 +243,7 @@ Decrease number by one Function signature: ``` -(eq - ([x]) - ([x y]) - ([x y & xs])) +(eq ([x]) ([x y]) ([x y & xs])) ``` Deep compare values. @@ -276,7 +252,7 @@ Deep compare values. Function signature: ``` -(map? [tbl]) +(map? ([tbl])) ``` Check whether `tbl` is an associative table. @@ -318,7 +294,7 @@ Empty tables created with [`hash-map`](#hash-map) will pass the test: Function signature: ``` -(vector? [tbl]) +(vector? ([tbl])) ``` Check whether `tbl` is an sequential table. @@ -360,7 +336,7 @@ Empty tables created with [`vector`](#vector) will pass the test: Function signature: ``` -(multifn? [mf]) +(multifn? ([mf])) ``` Test if `mf` is an instance of `multifn`. @@ -372,7 +348,7 @@ from `cljlib-macros.fnl`. Function signature: ``` -(set? [s]) +(set? ([s])) ``` @@ -381,8 +357,7 @@ Function signature: Function signature: ``` -(nil? - ([x])) +(nil? ([]) ([x])) ``` Test if value is nil. @@ -391,7 +366,7 @@ Test if value is nil. Function signature: ``` -(zero? [x]) +(zero? ([x])) ``` Test if value is equal to zero. @@ -400,7 +375,7 @@ Test if value is equal to zero. Function signature: ``` -(pos? [x]) +(pos? ([x])) ``` Test if `x` is greater than zero. @@ -409,7 +384,7 @@ Test if `x` is greater than zero. Function signature: ``` -(neg? [x]) +(neg? ([x])) ``` Test if `x` is less than zero. @@ -418,7 +393,7 @@ Test if `x` is less than zero. Function signature: ``` -(even? [x]) +(even? ([x])) ``` Test if value is even. @@ -427,7 +402,7 @@ Test if value is even. Function signature: ``` -(odd? [x]) +(odd? ([x])) ``` Test if value is odd. @@ -436,7 +411,7 @@ Test if value is odd. Function signature: ``` -(string? [x]) +(string? ([x])) ``` Test if `x` is a string. @@ -445,7 +420,7 @@ Test if `x` is a string. Function signature: ``` -(boolean? [x]) +(boolean? ([x])) ``` Test if `x` is a Boolean @@ -454,7 +429,7 @@ Test if `x` is a Boolean Function signature: ``` -(true? [x]) +(true? ([x])) ``` Test if `x` is `true` @@ -463,7 +438,7 @@ Test if `x` is `true` Function signature: ``` -(false? [x]) +(false? ([x])) ``` Test if `x` is `false` @@ -472,7 +447,7 @@ Test if `x` is `false` Function signature: ``` -(int? [x]) +(int? ([x])) ``` Test if `x` is a number without floating point data. @@ -483,7 +458,7 @@ Number is rounded with `math.floor` and compared with original number. Function signature: ``` -(pos-int? [x]) +(pos-int? ([x])) ``` Test if `x` is a positive integer. @@ -492,16 +467,16 @@ Test if `x` is a positive integer. Function signature: ``` -(neg-int? [x]) +(neg-int? ([x])) ``` -Test if `x` is a negetive integer. +Test if `x` is a negative integer. ## `double?` Function signature: ``` -(double? [x]) +(double? ([x])) ``` Test if `x` is a number with floating point data. @@ -510,7 +485,7 @@ Test if `x` is a number with floating point data. Function signature: ``` -(empty? [x]) +(empty? ([x])) ``` Check if collection is empty. @@ -519,7 +494,7 @@ Check if collection is empty. Function signature: ``` -(not-empty [x]) +(not-empty ([x])) ``` If `x` is empty, returns `nil`, otherwise `x`. @@ -528,7 +503,7 @@ If `x` is empty, returns `nil`, otherwise `x`. Function signature: ``` -(vector [& args]) +(vector ([& args])) ``` Constructs sequential table out of it's arguments. @@ -546,7 +521,7 @@ Sets additional metadata for function [`vector?`](#vector?) to work. Function signature: ``` -(seq [col]) +(seq ([col])) ``` Create sequential table. @@ -554,7 +529,8 @@ 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. +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: @@ -585,16 +561,16 @@ Additionally you can use [`conj`](#conj) and [`apply`](#apply) with Function signature: ``` -(kvseq [tbl]) +(kvseq ([col])) ``` -Transforms any table kind to key-value sequence. +Transforms any table to key-value sequence. ## `first` Function signature: ``` -(first [col]) +(first ([col])) ``` Return first element of a table. Calls `seq` on its argument. @@ -603,7 +579,7 @@ Return first element of a table. Calls `seq` on its argument. Function signature: ``` -(rest [col]) +(rest ([col])) ``` Returns table of all elements of a table but the first one. Calls @@ -613,7 +589,7 @@ Returns table of all elements of a table but the first one. Calls Function signature: ``` -(last [col]) +(last ([col])) ``` Returns the last element of a table. Calls `seq` on its argument. @@ -622,7 +598,7 @@ Returns the last element of a table. Calls `seq` on its argument. Function signature: ``` -(butlast [col]) +(butlast ([col])) ``` Returns everything but the last element of a table as a new @@ -632,10 +608,7 @@ Returns everything but the last element of a table as a new Function signature: ``` -(conj - ([tbl]) - ([tbl x]) - ([tbl x & xs])) +(conj ([]) ([tbl]) ([tbl x]) ([tbl x & xs])) ``` Insert `x` as a last element of a table `tbl`. @@ -680,10 +653,7 @@ See [`hash-map`](#hash-map) for creating empty associative tables. Function signature: ``` -(disj - ([s]) - ([s k]) - ([s k & ks])) +(disj ([s]) ([s k]) ([s k & ks])) ``` Remove key `k` from set `s`. @@ -692,7 +662,7 @@ Remove key `k` from set `s`. Function signature: ``` -(cons [x tbl]) +(cons ([x tbl])) ``` Insert `x` to `tbl` at the front. Calls [`seq`](#seq) on `tbl`. @@ -701,10 +671,7 @@ Insert `x` to `tbl` at the front. Calls [`seq`](#seq) on `tbl`. Function signature: ``` -(concat - ([x]) - ([x y]) - ([x y & xs])) +(concat ([]) ([x]) ([x y]) ([x y & xs])) ``` Concatenate tables. @@ -713,9 +680,7 @@ Concatenate tables. Function signature: ``` -(reduce - ([f col]) - ([f val col])) +(reduce ([f col]) ([f val col])) ``` Reduce collection `col` using function `f` and optional initial value `val`. @@ -747,7 +712,7 @@ Reduce sequence of numbers with [`add`](#add) Function signature: ``` -(reduced [x]) +(reduced ([x])) ``` Wraps `x` in such a way so [`reduce`](#reduce) will terminate early @@ -779,7 +744,7 @@ valid number, but we've terminated right before we've reached it. Function signature: ``` -(reduce-kv [f val tbl]) +(reduce-kv ([f val tbl])) ``` Reduces an associative table using function `f` and initial value `val`. @@ -869,7 +834,7 @@ Basic `zipmap` implementation: Function signature: ``` -(filter [pred col]) +(filter ([pred col])) ``` Returns a sequential table of the items in `col` for which `pred` @@ -879,7 +844,7 @@ Returns a sequential table of the items in `col` for which `pred` Function signature: ``` -(every? [pred tbl]) +(every? ([pred tbl])) ``` Test if every item in `tbl` satisfies the `pred`. @@ -888,7 +853,7 @@ Test if every item in `tbl` satisfies the `pred`. Function signature: ``` -(some [pred tbl]) +(some ([pred tbl])) ``` Test if any item in `tbl` satisfies the `pred`. @@ -897,7 +862,7 @@ Test if any item in `tbl` satisfies the `pred`. Function signature: ``` -(not-any? [pred tbl]) +(not-any? ([pred tbl])) ``` Test if no item in `tbl` satisfy the `pred`. @@ -906,10 +871,7 @@ Test if no item in `tbl` satisfy the `pred`. Function signature: ``` -(range - ([upper]) - ([lower upper]) - ([lower upper step])) +(range ([upper]) ([lower upper]) ([lower upper step])) ``` return range of of numbers from `lower` to `upper` with optional `step`. @@ -918,7 +880,7 @@ return range of of numbers from `lower` to `upper` with optional `step`. Function signature: ``` -(reverse [tbl]) +(reverse ([tbl])) ``` Returns table with same items as in `tbl` but in reverse order. @@ -927,7 +889,7 @@ Returns table with same items as in `tbl` but in reverse order. Function signature: ``` -(identity [x]) +(identity ([x])) ``` Returns its argument. @@ -936,10 +898,7 @@ Returns its argument. Function signature: ``` -(comp - ([f]) - ([f g]) - ([f g & fs])) +(comp ([]) ([f]) ([f g]) ([f g & fs])) ``` Compose functions. @@ -948,7 +907,7 @@ Compose functions. Function signature: ``` -(complement [f]) +(complement ([f])) ``` Takes a function `f` and returns the function that takes the same @@ -959,7 +918,7 @@ oppisite truth value. Function signature: ``` -(constantly [x]) +(constantly ([x])) ``` Returns a function that takes any number of arguments and returns `x`. @@ -968,7 +927,7 @@ Returns a function that takes any number of arguments and returns `x`. Function signature: ``` -(memoize [f]) +(memoize ([f])) ``` Returns a memoized version of a referentially transparent function. @@ -981,9 +940,7 @@ use. Function signature: ``` -(assoc - ([tbl k v]) - ([tbl k v & kvs])) +(assoc ([tbl k v]) ([tbl k v & kvs])) ``` Associate key `k` with value `v` in `tbl`. @@ -992,8 +949,7 @@ Associate key `k` with value `v` in `tbl`. Function signature: ``` -(hash-map - ([& kvs])) +(hash-map ([]) ([& kvs])) ``` Create associative table from keys and values @@ -1002,9 +958,7 @@ Create associative table from keys and values Function signature: ``` -(get - ([tbl key]) - ([tbl key not-found])) +(get ([tbl key]) ([tbl key not-found])) ``` Get value from the table by accessing it with a `key`. @@ -1015,9 +969,7 @@ found in the table. Function signature: ``` -(get-in - ([tbl keys]) - ([tbl keys not-found])) +(get-in ([tbl keys]) ([tbl keys not-found])) ``` Get value from nested set of tables by providing key sequence. @@ -1028,7 +980,7 @@ found in the table. Function signature: ``` -(keys [tbl]) +(keys ([tbl])) ``` Returns a sequence of the table's keys, in the same order as [`seq`](#seq). @@ -1037,7 +989,7 @@ Returns a sequence of the table's keys, in the same order as [`seq`](#seq). Function signature: ``` -(vals [tbl]) +(vals ([tbl])) ``` Returns a sequence of the table's values, in the same order as [`seq`](#seq). @@ -1046,7 +998,7 @@ Returns a sequence of the table's values, in the same order as [`seq`](#seq). Function signature: ``` -(find [tbl key]) +(find ([tbl key])) ``` Returns the map entry for `key`, or `nil` if key not present. @@ -1055,10 +1007,7 @@ Returns the map entry for `key`, or `nil` if key not present. Function signature: ``` -(dissoc - ([tbl]) - ([tbl key]) - ([tbl key & keys])) +(dissoc ([tbl]) ([tbl key]) ([tbl key & keys])) ``` Remove `key` from table `tbl`. @@ -1067,7 +1016,7 @@ Remove `key` from table `tbl`. Function signature: ``` -(remove-method [multifn dispatch-val]) +(remove-method ([multifn dispatch-val])) ``` Remove method from `multifn` for given `dispatch-val`. @@ -1076,7 +1025,7 @@ Remove method from `multifn` for given `dispatch-val`. Function signature: ``` -(remove-all-methods [multifn]) +(remove-all-methods ([multifn])) ``` Removes all of the methods of multimethod @@ -1085,7 +1034,7 @@ Removes all of the methods of multimethod Function signature: ``` -(methods [multifn]) +(methods ([multifn])) ``` Given a multimethod, returns a map of dispatch values -> dispatch fns @@ -1094,7 +1043,7 @@ Given a multimethod, returns a map of dispatch values -> dispatch fns Function signature: ``` -(get-method [multifn dispatch-val]) +(get-method ([multifn dispatch-val])) ``` Given a multimethod and a dispatch value, returns the dispatch `fn` @@ -1104,7 +1053,7 @@ that would apply to that value, or `nil` if none apply and no default. Function signature: ``` -(ordered-set [& xs]) +(ordered-set ([& xs])) ``` Create ordered set. @@ -1118,7 +1067,7 @@ 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 +**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. @@ -1130,18 +1079,16 @@ be in the set: ``` fennel >> (ordered-set) -#{} +@set{} >> (ordered-set :a :c :b) -#{"a" "c" "b"} +@set{:a :c :b} ``` Duplicate items are not added: ``` fennel ->> (ordered-set) -#{} >> (ordered-set :a :c :a :a :a :a :c :b) -#{"a" "c" "b"} +@set{:a :c :b} ``` #### Check if set contains desired value: @@ -1151,9 +1098,9 @@ 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] +["a" "b" "c"] >> (. oset :e) -:e +"e" >> (oset [:a :b :f]) nil ``` @@ -1164,8 +1111,7 @@ 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"} +@set{:a :b :c :d :e} ``` ##### Remove items from the set: @@ -1174,11 +1120,10 @@ 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"} +@set{:a :c} >> (tset oset :a nil) >> oset -#{"c"} +@set{:c} ``` #### Equality semantics @@ -1199,7 +1144,7 @@ true Function signature: ``` -(hash-set [& xs]) +(hash-set ([& xs])) ``` Create hash set. @@ -1213,7 +1158,7 @@ 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 +**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. @@ -1225,5 +1170,5 @@ Copyright (C) 2020 Andrey Orst License: [MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE) - diff --git a/doc/macros.md b/doc/macros.md new file mode 100644 index 0000000..e9cc517 --- /dev/null +++ b/doc/macros.md @@ -0,0 +1,588 @@ +# Macros.fnl (0.3.0) +Macros for Cljlib that implement various facilities from Clojure. + +**Table of contents** + +- [`fn*`](#fn*) +- [`try`](#try) +- [`def`](#def) +- [`defonce`](#defonce) +- [`defmulti`](#defmulti) +- [`defmethod`](#defmethod) +- [`into`](#into) +- [`empty`](#empty) +- [`when-meta`](#when-meta) +- [`with-meta`](#with-meta) +- [`meta`](#meta) +- [`if-let`](#if-let) +- [`when-let`](#when-let) +- [`if-some`](#if-some) +- [`when-some`](#when-some) +- [`deep-tostring`](#deep-tostring) + +## `fn*` +Function signature: + +``` +(fn* name docstring? ([arglist*] body)*) +``` + +Create (anonymous) function of fixed arity. +Supports multiple arities by defining bodies as lists. + +### Examples +Named function of fixed arity 2: + +``` fennel +(fn* f [a b] (+ a b)) +``` + +Function of fixed arities 1 and 2: + +``` fennel +(fn* ([x] x) + ([x y] (+ x y))) +``` + +Named function of 2 arities, one of which accepts 0 arguments, and the +other one or more arguments: + +``` fennel +(fn* f + ([] nil) + ([x & xs] + (print x) + (f (unpack xs)))) +``` + +Note, that this function is recursive, and calls itself with less and +less amount of arguments until there's no arguments, and terminates +when the zero-arity body is called. + +Named functions accept additional documentation string before the +argument list: + +``` fennel +(fn* cube + "raise `x` to power of 3" + [x] + (^ x 3)) + +(fn* greet + "greet a `person`, optionally specifying default `greeting`." + ([person] (print (.. "Hello, " person "!"))) + ([greeting person] (print (.. greeting ", " person "!")))) +``` + +Argument lists follow the same destruction rules as per `let`. +Variadic arguments with `...` are not supported use `& rest` instead. +Note that only one arity with `&` is supported. + +##### Namespaces +If function name contains namespace part, defines local variable +without namespace part, then creates function with this name, sets +this function to the namespace, and returns it. + +This roughly means, that instead of writing this: + +``` fennel +(local ns {}) + +(fn f [x] ;; we have to define `f` without `ns` + (if (> x 0) (f (- x 1)))) ;; because we're going to use it in `g` + +(set ns.f f) + +(fn ns.g [x] (f (* x 100))) ;; `g` can be defined as `ns.g` as it is only exported + +ns +``` + +It is possible to write: + +``` fennel +(local ns {}) + +(fn* ns.f [x] + (if (> x 0) (f (- x 1)))) + +(fn* ns.g [x] (f (* x 100))) ;; we can use `f` here no problem + +ns +``` + +It is still possible to call `f` and `g` in current scope without `ns` +part, so functions can be reused inside the module, and `ns` will hold +both functions, so it can be exported from the module. + +Note that `fn` will not create the `ns` for you, hence this is just a +syntax sugar. Functions deeply nested in namespaces require exising +namespace tables: + +``` fennel +(local ns {:strings {} + :tables {}}) + +(fn* ns.strings.join + ([s1 s2] (.. s1 s2)) + ([s1 s2 & strings] + (join (join s1 s2) (unpack strings)))) ;; call `join` resolves to ns.strings.join + +(fn* ns.tables.join + ([t1 t2] + (let [res []] + (each [_ v (ipairs t1)] (table.insert res v)) + (each [_ v (ipairs t2)] (table.insert res v)) + res)) + ([t1 t2 & tables] + (join (join t1 t2) (unpack tables)))) ;; call to `join` resolves to ns.tables.join +``` + +Note that this creates a collision and local `join` overrides `join` +from `ns.strings`, so the latter must be fully qualified +`ns.strings.join` when called outside of the function: + +``` fennel +(ns.strings.join "a" "b" "c") +;; => abc +(join ["a"] ["b"] ["c"] ["d" "e"]) +;; => ["a" "b" "c" "d" "e"] +(join "a" "b" "c") +;; {} +``` + +## `try` +Function signature: + +``` +(try body* catch-clause* finally-clause?) +``` + +General purpose try/catch/finally macro. +Wraps its body in `pcall` and checks the return value with `match` +macro. + +Catch clause is written either as (catch symbol body*), thus acting as +catch-all, or (catch value body*) for catching specific errors. It is +possible to have several `catch` clauses. If no `catch` clauses +specified, an implicit catch-all clause is created. + +Finally clause is optional, and written as (finally body*). If +present, it must be the last clause in the `try` form, and the only +`finally` clause. Note that `finally` clause is for side effects +only, and runs either after succesful run of `try` body, or after any +`catch` clause body, before returning the result. If no `catch` +clause is provided `finally` runs in implicit catch-all clause, and +trows error to upper scope using `error` function. + +To throw error from `try` to catch it with `catch` clause use `error` +or `assert` functions. + +### Examples +Catch all errors, ignore those and return fallback value: + +``` fennel +(fn add [x y] + (try + (+ x y) + (catch _ 0))) + +(add nil 1) ;; => 0 +``` + +Catch error and do cleanup: + +``` fennel +>> (let [tbl []] + (try + (table.insert tbl "a") + (table.insert tbl "b" "c") + (catch _ + (each [k _ (pairs tbl)] + (tset tbl k nil)))) + tbl) +{} +``` + +Always run some side effect action: + +``` fennel +>> (local res (try 10 (finally (print "side-effect!"))) +side-effect! +nil +>> rese0 +>> (local res (try (error 10) (catch 10 nil) (finally (print "side-effect!"))) +side-effect! +nil +>> res +nil +``` + + +## `def` +Function signature: + +``` +(def attr-map? name expr) +``` + +Wrapper around `local` which can +declare variables inside namespace, and as local at the same time +similarly to [`fn*`](#fn*): + +``` fennel +(def ns {}) +(def a 10) ;; binds `a` to `10` + +(def ns.b 20) ;; binds `ns.b` and `b` to `20` +``` + +`a` is a `local`, and both `ns.b` and `b` refer to the same value. + +Additionally metadata can be attached to values, by providing +attribute map or keyword as first parameter. Only one keyword is +supported, which is `:mutable`, which allows mutating variable with +`set` later on: + +``` fennel +;; Bad, will override existing documentation for 299792458 (if any) +(def {:doc "speed of light in m/s"} c 299792458) +(set c 0) ;; => error, can't mutate `c` + +(def :mutable address "Lua St.") ;; same as (def {:mutable true} address "Lua St.") +(set address "Lisp St.") ;; can mutate `address` +``` + +However, attaching documentation metadata to anything other than +tables and functions considered bad practice, due to how Lua +works. More info can be found in [`with-meta`](#with-meta) +description. + +## `defonce` +Function signature: + +``` +(defonce attr-map? name expr) +``` + +Works the same as [`def`](#def), but ensures that later `defonce` +calls will not override existing bindings: + +``` fennel +(defonce a 10) +(defonce a 20) +(print a) ;; => prints 10 +``` + +## `defmulti` +Function signature: + +``` +(defmulti name docstring? dispatch-fn attr-map?) +``` + +Create multifunction with +runtime dispatching based on results from `dispatch-fn`. Returns an +empty table with `__call` metamethod, that calls `dispatch-fn` on its +arguments. Amount of arguments passed, should be the same as accepted +by `dispatch-fn`. Looks for multimethod based on result from +`dispatch-fn`. + +By default, multifunction has no multimethods, see +[`multimethod`](#multimethod) on how to add one. + +## `defmethod` +Function signature: + +``` +(defmethod multifn dispatch-val fnspec) +``` + +Attach new method to multi-function dispatch value. accepts the `multi-fn` +as its first argument, the dispatch value as second, and function tail +starting from argument list, followed by function body as in +[`fn*`](#fn). + +### Examples +Here are some examples how multimethods can be used. + +#### Factorial example +Key idea here is that multimethods can call itself with different +values, and will dispatch correctly. Here, `fac` recursively calls +itself with less and less number until it reaches `0` and dispatches +to another multimethod: + +``` fennel +(defmulti fac (fn [x] x)) + +(defmethod fac 0 [_] 1) +(defmethod fac :default [x] (* x (fac (- x 1)))) + +(fac 4) ;; => 24 +``` + +`:default` is a special method which gets called when no other methods +were found for given dispatch value. + +#### Multi-arity dispatching +Multi-arity function tails are also supported: + +``` fennel +(defmulti foo (fn* ([x] [x]) ([x y] [x y]))) + +(defmethod foo [10] [_] (print "I've knew I'll get 10")) +(defmethod foo [10 20] [_ _] (print "I've knew I'll get both 10 and 20")) +(defmethod foo :default ([x] (print (.. "Umm, got" x))) + ([x y] (print (.. "Umm, got both " x " and " y)))) +``` + +Calling `(foo 10)` will print `"I've knew I'll get 10"`, and calling +`(foo 10 20)` will print `"I've knew I'll get both 10 and 20"`. +However, calling `foo` with any other numbers will default either to +`"Umm, got x"` message, when called with single value, and `"Umm, got +both x and y"` when calling with two values. + +#### Dispatching on object's type +We can dispatch based on types the same way we dispatch on values. +For example, here's a naive conversion from Fennel's notation for +tables to Lua's one: + +``` fennel +(defmulti to-lua-str (fn [x] (type x))) + +(defmethod to-lua-str :number [x] (tostring x)) +(defmethod to-lua-str :table [x] (let [res []] + (each [k v (pairs x)] + (table.insert res (.. "[" (to-lua-str k) "] = " (to-lua-str v)))) + (.. "{" (table.concat res ", ") "}"))) +(defmethod to-lua-str :string [x] (.. "\"" x "\"")) +(defmethod to-lua-str :default [x] (tostring x)) +``` + +And if we call it on some table, we'll get a valid Lua table: + +``` fennel +(print (to-lua-str {:a {:b 10}})) +;; prints {["a"] = {["b"] = 10}} + +(print (to-lua-str [:a :b :c [:d {:e :f}]])) +;; prints {[1] = "a", [2] = "b", [3] = "c", [4] = {[1] = "d", [2] = {["e"] = "f"}}} +``` + +Which we can then reformat as we want and use in Lua if we want. + +## `into` +Function signature: + +``` +(into to from) +``` + +Transform one table into another. Mutates first table. + +Transformation happens in runtime, but type deduction happens in +compile time if possible. This means, that if literal values passed +to `into` this will have different effects for associative tables and +vectors: + +``` fennel +(into [1 2 3] [4 5 6]) ;; => [1 2 3 4 5 6] +(into {:a 1 :c 2} {:a 0 :b 1}) ;; => {:a 0 :b 1 :c 2} +``` + +Conversion between different table types is also supported: + +``` fennel +(into [] {:a 1 :b 2 :c 3}) ;; => [[:a 1] [:b 2] [:c 3]] +(into {} [[:a 1] [:b 2]]) ;; => {:a 1 :b 2} +``` + +Same rules apply to runtime detection of table type, except that this +will not work for empty tables: + +``` fennel +(local empty-table {}) +(into empty-table {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] +``` fennel + +If table is empty, `into` defaults to sequential table, because it +allows safe conversion from both sequential and associative tables. + +Type for non empty tables hidden in variables can be deduced at +runtime, and this works as expected: + +``` fennel +(local t1 [1 2 3]) +(local t2 {:a 10 :c 3}) +(into t1 {:a 1 :b 2}) ;; => [1 2 3 [:a 1] [:b 2]] +(into t2 {:a 1 :b 2}) ;; => {:a 1 :b 2 :c 3} +``` + +`cljlib.fnl` module provides two additional functions `vector` and +`hash-map`, that can create empty tables, which can be distinguished +at runtime: + +``` fennel +(into (vector) {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] +(into (hash-map) [[:a 1 :b 2]]) ;; => {:a 1 :b 2} +``` + +## `empty` +Function signature: + +``` +(empty x) +``` + +Return empty table of the same kind as input table `x`, with +additional metadata indicating its type. + +### Example +Creating a generic `map` function, that will work on any table type, +and return result of the same type: + +``` fennel +(fn map [f tbl] + (let [res []] + (each [_ v (ipairs (into [] tbl))] + (table.insert res (f v))) + (into (empty tbl) res))) + +(map (fn [[k v]] [(string.upper k) v]) {:a 1 :b 2 :c 3}) +;; => {:A 1 :B 2 :C 3} +(map #(* $ $) [1 2 3 4]) +;; [1 4 9 16] +``` +See [`into`](#into) for more info on how conversion is done. + +## `when-meta` +Function signature: + +``` +(when-meta [& body]) +``` + +Wrapper that compiles away if metadata support was not enabled. What +this effectively means, is that everything that is wrapped with this +macro will disappear from the resulting Lua code if metadata is not +enabled when compiling with `fennel --compile` without `--metadata` +switch. + +## `with-meta` +Function signature: + +``` +(with-meta value meta) +``` + +Attach metadata to a value. When metadata feature is not enabled, +returns the value without additional metadata. + +``` fennel +>> (local foo (with-meta (fn [...] (let [[x y z] [...]] (+ x y z))) + {:fnl/arglist ["x" "y" "z" "..."] + :fnl/docstring "sum first three values"})) +>> (doc foo) +(foo x y z ...) + sum first three values +``` + +## `meta` +Function signature: + +``` +(meta value) +``` + +Get `value` metadata. If value has no metadata, or metadata +feature is not enabled returns `nil`. + +### Example + +``` fennel +>> (meta (with-meta {} {:meta "data"})) +;; => {:meta "data"} +``` + +### Note +There are several important gotchas about using metadata. + +First, note that this works only when used with Fennel, and only when +`(require fennel)` works. For compiled Lua library this feature is +turned off. + +Second, try to avoid using metadata with anything else than tables and +functions. When storing function or table as a key into metatable, +its address is used, while when storing string of number, the value is +used. This, for example, may cause documentation collision, when +you've set some variable holding a number value to have certain +docstring, and later you've defined another variable with the same +value, but different docstring. While this isn't a major breakage, it +may confuse if someone will explore your code in the REPL with `doc`. + +Lastly, note that prior to Fennel 0.7.1 `import-macros` wasn't +respecting `--metadata` switch. So if you're using Fennel < 0.7.1 +this stuff will only work if you use `require-macros` instead of +`import-macros`. + +## `if-let` +Function signature: + +``` +(if-let [binding test] then-branch else-branch) +``` + +If test is logical true, +evaluates `then-branch` with binding-form bound to the value of test, +if not, yields `else-branch`. + +## `when-let` +Function signature: + +``` +(when-let [binding test] & body) +``` + +If test is logical true, +evaluates `body` in implicit `do`. + +## `if-some` +Function signature: + +``` +(if-some [binding test] then-branch else-branch) +``` + +If test is non-`nil`, evaluates +`then-branch` with binding-form bound to the value of test, if not, +yields `else-branch`. + +## `when-some` +Function signature: + +``` +(when-some [binding test] & body) +``` + +If test is non-`nil`, +evaluates `body` in implicit `do`. + +## `deep-tostring` +Function signature: + +``` +(deep-tostring data key?) +``` + +**Undocumented** + + +--- + +Copyright (C) 2020 Andrey Orst + +License: [MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE) + + + diff --git a/doc/tests/test.md b/doc/tests/test.md index c338561..8a6c7e5 100644 --- a/doc/tests/test.md +++ b/doc/tests/test.md @@ -94,5 +94,5 @@ Function signature: Assert for not truth. Works the same as [`assert-is`](#assert-is). - diff --git a/init.fnl b/init.fnl new file mode 100644 index 0000000..623120d --- /dev/null +++ b/init.fnl @@ -0,0 +1,1333 @@ +(local core {:_VERSION "0.4.0" + :_LICENSE "[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)" + :_COPYRIGHT "Copyright (C) 2020 Andrey Orst" + :_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](./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). + +## 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 insert table.insert) +(local _unpack (or table.unpack _G.unpack)) +(import-macros {: fn* : into : empty : with-meta + : when-let : if-let : when-some : if-some} + (.. (if (and ... (not= ... :init)) (.. ... ".") "") :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 negative 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 manipulation 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. If +`col` is string, return sequential table of its codepoints. + +# 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 (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)))) + +(fn* core.kvseq + "Transforms any table 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)))) + +(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)) + (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 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 [i v (pairs Set)] + (.. (if (= i 1) "" indent-str) + (view v inspector (+ indent set-indent) true)))] + (tset lines 1 (.. prefix (or (. lines 1) ""))) + (tset lines (length lines) (.. (. lines (length lines)) "}")) + (values lines (> (length lines) inspector.sequential-length))))) + +(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))) + +(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. + +(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 `@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. + +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`](#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`](#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`](#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) + :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) + :__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 `@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-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) + :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) + :__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 Andrey +;; LocalWords: Orst codepoints diff --git a/macros.fnl b/macros.fnl new file mode 100644 index 0000000..52a3a94 --- /dev/null +++ b/macros.fnl @@ -0,0 +1,1190 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn first [tbl] + (. tbl 1)) + +(fn rest [tbl] + [((or table.unpack _G.unpack) tbl 2)]) + +(fn string? [x] + (= (type x) :string)) + +(fn multisym->sym [s] + ;; Strip multisym part from symbol and return new symbol and + ;; indication that sym was transformed. Non-multisym symbols returned as + ;; is. + ;; + ;; ``` fennel + ;; (multisym->sym a.b) ;; => (a true) + ;; (multisym->sym a.b.c) ;; => (c true) + ;; (multisym->sym a) ;; => (a false) + ;; ``` + (values (sym (string.match (tostring s) "[^.]+$")) + (multi-sym? s))) + +(fn contains? [tbl x] + ;; Checks if `x` is stored in `tbl` in linear time. + (var res false) + (each [i v (ipairs tbl)] + (if (= v x) + (do (set res i) + (lua :break)))) + res) + +(fn check-two-binding-vec [bindings] + ;; Test if `bindings` is a `sequence` that holds two forms, first of + ;; which is a `sym`, `table` or `sequence`. + (and (assert-compile (sequence? bindings) + "expected binding table" []) + (assert-compile (= (length bindings) 2) + "expected exactly two forms in binding vector." bindings) + (assert-compile (or (sym? (first bindings)) + (sequence? (first bindings)) + (table? (first bindings))) + "expected symbol, sequence or table as binding." bindings))) + +(local fennel (require :fennel)) + +(fn attach-meta [value meta] + (each [k v (pairs meta)] + (fennel.metadata:set value k v))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;; Runtime function builers ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: This code should be shared with `init.fnl` + +(fn eq-fn [] + ;; Returns recursive equality function. + ;; + ;; This function is able to compare tables of any depth, even if one of + ;; the tables uses tables as keys. + `(fn eq# [left# right#] + (if (and (= (type left#) :table) (= (type right#) :table)) + (let [oldmeta# (getmetatable right#)] + ;; In case if we'll get something like + ;; `(eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}})` + ;; we have to do even deeper search + (setmetatable right# {:__index (fn [tbl# key#] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)}) + (var [res# count-a# count-b#] [true 0 0]) + (each [k# v# (pairs left#)] + (set res# (eq# v# (. right# k#))) + (set count-a# (+ count-a# 1)) + (when (not res#) (lua :break))) + (when res# + (each [_# _# (pairs right#)] + (set count-b# (+ count-b# 1))) + (set res# (= count-a# count-b#))) + (setmetatable right# oldmeta#) + res#) + (= left# right#)))) + +(fn seq-fn [] + ;; Returns function that transforms tables and strings into sequences. + ;; + ;; Sequential tables `[1 2 3 4]` are shallowly copied. + ;; + ;; Associative tables `{:a 1 :b 2}` are transformed into `[[:a 1] [:b 2]]` + ;; with non deterministic order. + ;; + ;; Strings are transformed into a sequence of letters. + `(fn [col#] + (let [type# (type col#) + res# (setmetatable {} {:cljlib/type :seq}) + insert# table.insert] + (if (= type# :table) + (do (var assoc?# false) + (let [assoc-res# (setmetatable {} {:cljlib/type :seq})] + (each [k# v# (pairs col#)] + (if (and (not assoc?#) + (not (= (type k#) :number))) + (set assoc?# true)) + (insert# res# v#) + (insert# assoc-res# [k# v#])) + (if assoc?# assoc-res# res#))) + (= type# :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#)) + (= type# :nil) nil + (error "expected table, string or nil" 2))))) + +(fn table-type-fn [] + `(fn [tbl#] + (let [t# (type tbl#)] + (if (= t# :table) + (let [meta# (getmetatable tbl#) + table-type# (and meta# (. meta# :cljlib/type))] + (if table-type# table-type# + (let [(k# _#) (next tbl#)] + (if (and (= (type k#) :number) (= k# 1)) :seq + (= k# nil) :empty + :table)))) + (= t# :nil) :nil + (= t# :string) :string + :else)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Metadata ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; compile time check that `--metadata` feature was enabled +(local meta-enabled (pcall _SCOPE.specials.doc + (list (sym :doc) (sym :doc)) + _SCOPE _CHUNK)) + +(fn when-meta [...] + "Wrapper that compiles away if metadata support was not enabled. What +this effectively means, is that everything that is wrapped with this +macro will disappear from the resulting Lua code if metadata is not +enabled when compiling with `fennel --compile` without `--metadata` +switch." + (when meta-enabled + `(do ,...))) + +(attach-meta when-meta {:fnl/arglist ["[& body]"]}) + +(fn meta [value] + "Get `value` metadata. If value has no metadata, or metadata +feature is not enabled returns `nil`. + +# Example + +``` fennel +>> (meta (with-meta {} {:meta \"data\"})) +;; => {:meta \"data\"} +``` + +# Note +There are several important gotchas about using metadata. + +First, note that this works only when used with Fennel, and only when +`(require fennel)` works. For compiled Lua library this feature is +turned off. + +Second, try to avoid using metadata with anything else than tables and +functions. When storing function or table as a key into metatable, +its address is used, while when storing string of number, the value is +used. This, for example, may cause documentation collision, when +you've set some variable holding a number value to have certain +docstring, and later you've defined another variable with the same +value, but different docstring. While this isn't a major breakage, it +may confuse if someone will explore your code in the REPL with `doc`. + +Lastly, note that prior to Fennel 0.7.1 `import-macros` wasn't +respecting `--metadata` switch. So if you're using Fennel < 0.7.1 +this stuff will only work if you use `require-macros` instead of +`import-macros`." + (when-meta + `(let [(res# fennel#) (pcall require :fennel)] + (if res# (. fennel#.metadata ,value))))) + +(fn with-meta [value meta] + "Attach metadata to a value. When metadata feature is not enabled, +returns the value without additional metadata. + +``` fennel +>> (local foo (with-meta (fn [...] (let [[x y z] [...]] (+ x y z))) + {:fnl/arglist [\"x\" \"y\" \"z\" \"...\"] + :fnl/docstring \"sum first three values\"})) +>> (doc foo) +(foo x y z ...) + sum first three values +```" + (if (not meta-enabled) value + `(let [value# ,value + (res# fennel#) (pcall require :fennel)] + (if res# + (each [k# v# (pairs ,meta)] + (fennel#.metadata:set value# k# v#))) + value#))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fn* ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn keyword? [data] + (and (= (type data) :string) + (data:find "^[-%w?\\^_!$%&*+./@:|<=>]+$"))) + +(fn deep-tostring [data key?] + (let [tbl []] + (if (sequence? data) + (do (each [_ v (ipairs data)] + (table.insert tbl (deep-tostring v))) + (.. "[" (table.concat tbl " ") "]")) + (table? data) + (do (each [k v (pairs data)] + (table.insert tbl (.. (deep-tostring k true) " " (deep-tostring v)))) + (.. "{" (table.concat tbl " ") "}")) + (and key? (keyword? data)) (.. ":" data) + (string? data) + (string.format "%q" data) + (tostring data)))) + +(fn gen-arglist-doc [args] + (if (list? (. args 1)) + (let [arglist []] + (each [_ v (ipairs args)] + (let [arglist-doc (gen-arglist-doc v)] + (when (next arglist-doc) + (table.insert arglist (table.concat arglist-doc " "))))) + (when (and (> (length (table.concat arglist " ")) 60) + (> (length arglist) 1)) + (each [i s (ipairs arglist)] + (tset arglist i (.. "\n " s)))) + arglist) + + (sequence? (. args 1)) + (let [arglist [] + args (. args 1) + len (length args)] + (if (= len 0) + (table.insert arglist "([])") + (each [i v (ipairs args)] + (table.insert arglist + (match i + (1 ? (= len 1)) (.. "([" (deep-tostring v) "])") + 1 (.. "([" (deep-tostring v)) + len (.. (deep-tostring v) "])") + _ (deep-tostring v))))) + arglist))) + +(fn multisym->sym [s] + ;; Strips away the multisym part from symbol, and return just the + ;; symbol itself. Also returns the second value of whether the + ;; transformation occured or not. + (if (multi-sym? s) + (values (sym (string.gsub (tostring s) ".*[.]" "")) true) + (values s false))) + +(fn has-amp? [args] + ;; Check if arglist has `&` and return its position of `false`. Performs + ;; additional checks for `&` and `...` usage in arglist. + (var res false) + (each [i s (ipairs args)] + (if (= (tostring s) "&") + (if res (assert-compile false "only one `&' can be specified in arglist." args) + (set res i)) + (= (tostring s) "...") + (assert-compile false "use of `...' in `fn*' is not permitted. Use `&' if you want a vararg." args) + (and res (> i (+ res 1))) + (assert-compile false "only one `more' argument can be supplied after `&' in arglist." args))) + res) + +(fn gen-arity [[args & body]] + ;; Forms three values, representing data needed to create dispatcher: + ;; + ;; - the length of arglist; + ;; - the body of the function we generate; + ;; - position of `&` in the arglist if any. + (assert-compile (sequence? args) "fn*: expected parameters table. + +* Try adding function parameters as a list of identifiers in brackets." args) + (values (length args) + (list 'let [args ['...]] (list 'do ((or table.unpack _G.unpack) body))) + (has-amp? args))) + +(fn grows-by-one-or-equal? [tbl] + ;; Checks if table consists of integers that grow by one or equal to + ;; eachother when sorted. Used for checking if we supplied all arities + ;; for dispatching, and there's no need in the error handling. + ;; + ;; ``` fennel + ;; (grows-by-one-or-equal? [1 3 2]) => true, because [1 2 3] + ;; (grows-by-one-or-equal? [1 4 2]) => true, because 3 is missing + ;; (grows-by-one-or-equal? [1 3 2 3]) => true, because equal values are allowed. + ;; ``` + (let [t []] + (each [_ v (ipairs tbl)] (table.insert t v)) + (table.sort t) + (var prev nil) + (each [_ cur (ipairs t)] + (if prev + (when (and (not= (+ prev 1) cur) + (not= prev cur)) + (lua "return false"))) + (set prev cur)) + prev)) + +(fn arity-dispatcher [len fixed amp-body name] + ;; Forms an `if` expression with all fixed arities first, then `&` arity, + ;; if present, and default error message as last arity. + ;; + ;; `len` is a symbol, that represents the length of the current argument + ;; list, and is computed at runtime. + ;; + ;; `fixed` is a table of arities with fixed amount of arguments. These + ;; are put in this `if` as: `(= len fixed-len)`, where `fixed-len` is the + ;; length of current arity arglist, computed with `gen-arity`. + ;; + ;; `amp-body` stores size of fixed part of arglist, that is, everything up + ;; until `&`, and the body itself. When `amp-body` provided, the `(>= len + ;; more-len)` is added to the resulting `if` expression. + ;; + ;; Lastly the catchall branch is added to `if` expression, which ensures + ;; that only valid amount of arguments were passed to function, which are + ;; defined by previous branches. + (let [bodies '(if) + lengths []] + (var max nil) + (each [fixed-len body (pairs (doto fixed))] + (when (or (not max) (> fixed-len max)) + (set max fixed-len)) + (table.insert lengths fixed-len) + (table.insert bodies (list '= len fixed-len)) + (table.insert bodies body)) + (when amp-body + (let [[more-len body arity] amp-body] + (assert-compile (not (and max (<= more-len max))) "fn*: arity with `&' must have more arguments than maximum arity without `&'. + +* Try adding more arguments before `&'" arity) + (table.insert lengths (- more-len 1)) + (table.insert bodies (list '>= len (- more-len 1))) + (table.insert bodies body))) + (if (not (and (grows-by-one-or-equal? lengths) + (contains? lengths 0) + amp-body)) + (table.insert bodies (list 'error + (.. "wrong argument amount" + (if name (.. " for " name) "")) 2))) + bodies)) + +(fn single-arity-body [args fname] + ;; Produces arglist and body for single-arity function. + ;; For more info check `gen-arity' documentation. + (let [[args & body] args + (arity body amp) (gen-arity [args ((or table.unpack _G.unpack) body)])] + `(let [len# (select :# ...)] + ,(arity-dispatcher + 'len# + (if amp {} {arity body}) + (if amp [amp body]) + fname)))) + +(fn multi-arity-body [args fname] + ;; Produces arglist and all body forms for multi-arity function. + ;; For more info check `gen-arity' documentation. + (let [bodies {} ;; bodies of fixed arity + amp-bodies []] ;; bodies where arglist contains `&' + (each [_ arity (ipairs args)] + (let [(n body amp) (gen-arity arity)] + (if amp + (table.insert amp-bodies [amp body arity]) + (tset bodies n body)))) + (assert-compile (<= (length amp-bodies) 1) + "fn* must have only one arity with `&':" + (. amp-bodies (length amp-bodies))) + `(let [len# (select :# ...)] + ,(arity-dispatcher + 'len# + bodies + (if (not= (next amp-bodies) nil) + (. amp-bodies 1)) + fname)))) + +(fn fn* [name doc? ...] + "Create (anonymous) function of fixed arity. +Supports multiple arities by defining bodies as lists. + +# Examples +Named function of fixed arity 2: + +``` fennel +(fn* f [a b] (+ a b)) +``` + +Function of fixed arities 1 and 2: + +``` fennel +(fn* ([x] x) + ([x y] (+ x y))) +``` + +Named function of 2 arities, one of which accepts 0 arguments, and the +other one or more arguments: + +``` fennel +(fn* f + ([] nil) + ([x & xs] + (print x) + (f (unpack xs)))) +``` + +Note, that this function is recursive, and calls itself with less and +less amount of arguments until there's no arguments, and terminates +when the zero-arity body is called. + +Named functions accept additional documentation string before the +argument list: + +``` fennel +(fn* cube + \"raise `x` to power of 3\" + [x] + (^ x 3)) + +(fn* greet + \"greet a `person`, optionally specifying default `greeting`.\" + ([person] (print (.. \"Hello, \" person \"!\"))) + ([greeting person] (print (.. greeting \", \" person \"!\")))) +``` + +Argument lists follow the same destruction rules as per `let`. +Variadic arguments with `...` are not supported use `& rest` instead. +Note that only one arity with `&` is supported. + +### Namespaces +If function name contains namespace part, defines local variable +without namespace part, then creates function with this name, sets +this function to the namespace, and returns it. + +This roughly means, that instead of writing this: + +``` fennel +(local ns {}) + +(fn f [x] ;; we have to define `f` without `ns` + (if (> x 0) (f (- x 1)))) ;; because we're going to use it in `g` + +(set ns.f f) + +(fn ns.g [x] (f (* x 100))) ;; `g` can be defined as `ns.g` as it is only exported + +ns +``` + +It is possible to write: + +``` fennel +(local ns {}) + +(fn* ns.f [x] + (if (> x 0) (f (- x 1)))) + +(fn* ns.g [x] (f (* x 100))) ;; we can use `f` here no problem + +ns +``` + +It is still possible to call `f` and `g` in current scope without `ns` +part, so functions can be reused inside the module, and `ns` will hold +both functions, so it can be exported from the module. + +Note that `fn` will not create the `ns` for you, hence this is just a +syntax sugar. Functions deeply nested in namespaces require exising +namespace tables: + +``` fennel +(local ns {:strings {} + :tables {}}) + +(fn* ns.strings.join + ([s1 s2] (.. s1 s2)) + ([s1 s2 & strings] + (join (join s1 s2) (unpack strings)))) ;; call `join` resolves to ns.strings.join + +(fn* ns.tables.join + ([t1 t2] + (let [res []] + (each [_ v (ipairs t1)] (table.insert res v)) + (each [_ v (ipairs t2)] (table.insert res v)) + res)) + ([t1 t2 & tables] + (join (join t1 t2) (unpack tables)))) ;; call to `join` resolves to ns.tables.join +``` + +Note that this creates a collision and local `join` overrides `join` +from `ns.strings`, so the latter must be fully qualified +`ns.strings.join` when called outside of the function: + +``` fennel +(ns.strings.join \"a\" \"b\" \"c\") +;; => abc +(join [\"a\"] [\"b\"] [\"c\"] [\"d\" \"e\"]) +;; => [\"a\" \"b\" \"c\" \"d\" \"e\"] +(join \"a\" \"b\" \"c\") +;; {} +```" + (assert-compile (not (string? name)) "fn* expects symbol, vector, or list as first argument" name) + (let [docstring (if (string? doc?) doc? nil) + (name-wo-namespace namespaced?) (multisym->sym name) + fname (if (sym? name-wo-namespace) (tostring name-wo-namespace)) + args (if (sym? name-wo-namespace) + (if (string? doc?) [...] [doc? ...]) + [name-wo-namespace doc? ...]) + arglist-doc (gen-arglist-doc args) + [x] args + + body (if (sequence? x) (single-arity-body args fname) + (list? x) (multi-arity-body args fname) + (assert-compile false "fn*: expected parameters table. + +* Try adding function parameters as a list of identifiers in brackets." x))] + (if (sym? name-wo-namespace) + (if namespaced? + `(local ,name-wo-namespace + (do (fn ,name-wo-namespace [...] ,docstring ,body) + (set ,name ,name-wo-namespace) ;; set function into module table, e.g. (set foo.bar bar) + ,(with-meta name-wo-namespace `{:fnl/arglist ,arglist-doc}))) + `(local ,name ,(with-meta `(fn ,name [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc}))) + (with-meta `(fn [...] ,docstring ,body) `{:fnl/arglist ,arglist-doc})))) + +(attach-meta fn* {:fnl/arglist ["name docstring? ([arglist*] body)*"]}) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; let variants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Fennel indeed has more advanced macro `match` which can be used in +;; place of any of the following macros, however it is sometimes more +;; convenient to convey intentions by explicitly saying `when-some` +;; implying that we're interested in non-nil value and only single branch +;; of execution. The `match` macro on the other hand does not convey +;; such intention + +(fn if-let [...] + (let [[bindings then else] (match (select :# ...) + 2 [...] + 3 [...] + _ (error "wrong argument amount for if-some" 2))] + (check-two-binding-vec bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if tmp# + (let [,form tmp#] + ,then) + ,else))))) + +(attach-meta if-let {:fnl/arglist ["[binding test]" "then-branch" "else-branch"] + :fnl/docstring "If test is logical true, +evaluates `then-branch` with binding-form bound to the value of test, +if not, yields `else-branch`."}) + + +(fn when-let [...] + (let [[bindings & body] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for when-let" 2))] + (check-two-binding-vec bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if tmp# + (let [,form tmp#] + ,((or table.unpack _G.unpack) body))))))) + +(attach-meta when-let {:fnl/arglist ["[binding test]" "& body"] + :fnl/docstring "If test is logical true, +evaluates `body` in implicit `do`."}) + + +(fn if-some [...] + (let [[bindings then else] (match (select :# ...) + 2 [...] + 3 [...] + _ (error "wrong argument amount for if-some" 2))] + (check-two-binding-vec bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if (= tmp# nil) + ,else + (let [,form tmp#] + ,then)))))) + +(attach-meta if-some {:fnl/arglist ["[binding test]" "then-branch" "else-branch"] + :fnl/docstring "If test is non-`nil`, evaluates +`then-branch` with binding-form bound to the value of test, if not, +yields `else-branch`."}) + + +(fn when-some [...] + (let [[bindings & body] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for when-some" 2))] + (check-two-binding-vec bindings) + (let [[form test] bindings] + `(let [tmp# ,test] + (if (= tmp# nil) + nil + (let [,form tmp#] + ,((or table.unpack _G.unpack) body))))))) + +(attach-meta when-some {:fnl/arglist ["[binding test]" "& body"] + :fnl/docstring "If test is non-`nil`, +evaluates `body` in implicit `do`."}) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; into ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn table-type [tbl] + (if (sequence? tbl) :seq + (table? tbl) :table + :else)) + +(fn into [to from] + "Transform one table into another. Mutates first table. + +Transformation happens in runtime, but type deduction happens in +compile time if possible. This means, that if literal values passed +to `into` this will have different effects for associative tables and +vectors: + +``` fennel +(into [1 2 3] [4 5 6]) ;; => [1 2 3 4 5 6] +(into {:a 1 :c 2} {:a 0 :b 1}) ;; => {:a 0 :b 1 :c 2} +``` + +Conversion between different table types is also supported: + +``` fennel +(into [] {:a 1 :b 2 :c 3}) ;; => [[:a 1] [:b 2] [:c 3]] +(into {} [[:a 1] [:b 2]]) ;; => {:a 1 :b 2} +``` + +Same rules apply to runtime detection of table type, except that this +will not work for empty tables: + +``` fennel +(local empty-table {}) +(into empty-table {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] +``` fennel + +If table is empty, `into` defaults to sequential table, because it +allows safe conversion from both sequential and associative tables. + +Type for non empty tables hidden in variables can be deduced at +runtime, and this works as expected: + +``` fennel +(local t1 [1 2 3]) +(local t2 {:a 10 :c 3}) +(into t1 {:a 1 :b 2}) ;; => [1 2 3 [:a 1] [:b 2]] +(into t2 {:a 1 :b 2}) ;; => {:a 1 :b 2 :c 3} +``` + +`cljlib.fnl` module provides two additional functions `vector` and +`hash-map`, that can create empty tables, which can be distinguished +at runtime: + +``` fennel +(into (vector) {:a 1 :b 2}) ;; => [[:a 1] [:b 2]] +(into (hash-map) [[:a 1 :b 2]]) ;; => {:a 1 :b 2} +```" + (assert-compile (and to from) "into: expected two arguments") + (let [to-type (table-type to) + from-type (table-type from)] + (if (and (= to-type :seq) (= from-type :seq)) + `(let [to# (or ,to []) + insert# table.insert] + (each [_# v# (ipairs (or ,from []))] + (insert# to# v#)) + (setmetatable to# {:cljlib/type :seq})) + (= to-type :seq) + `(let [to# (or ,to []) + insert# table.insert] + (each [_# v# (ipairs (,(seq-fn) (or ,from [])))] + (insert# to# v#)) + (setmetatable to# {:cljlib/type :seq})) + (and (= to-type :table) (= from-type :seq)) + `(let [to# (or ,to [])] + (each [_# [k# v#] (ipairs (or ,from []))] + (tset to# k# v#)) + (setmetatable to# {:cljlib/type :table})) + (and (= to-type :table) (= from-type :table)) + `(let [to# (or ,to []) + from# (or ,from [])] + (each [k# v# (pairs from#)] + (tset to# k# v#)) + (setmetatable to# {:cljlib/type :table})) + (= to-type :table) + `(let [to# (or ,to []) + seq# ,(seq-fn) + from# (or ,from [])] + (match (,(table-type-fn) from#) + :seq (each [_# [k# v#] (ipairs (seq# from#))] + (tset to# k# v#)) + :table (each [k# v# (pairs from#)] + (tset to# k# v#)) + :else (error "expected table as second argument" 2) + _# (do (each [_# [k# v#] (pairs (or (seq# from#) []))] + (tset to# k# v#)) + to#)) + (setmetatable to# {:cljlib/type :table})) + ;; runtime branch + `(let [to# ,to + from# ,from + insert# table.insert + table-type# ,(table-type-fn) + seq# ,(seq-fn) + to-type# (table-type# to#) + to# (or to# []) ;; secure nil + res# (match to-type# + ;; Sequence or empty table + (seq1# ? (or (= seq1# :seq) (= seq1# :empty))) + (do (each [_# v# (ipairs (seq# (or from# [])))] + (insert# to# v#)) + to#) + ;; associative table + :table (match (table-type# from#) + (seq2# ? (or (= seq2# :seq) (= seq2# :string))) + (do (each [_# [k# v#] (ipairs (or from# []))] + (tset to# k# v#)) + to#) + :table (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :empty to# + :else (error "expected table as second argument" 2) + _# (do (each [_# [k# v#] (pairs (or (seq# from#) []))] + (tset to# k# v#)) + to#)) + ;; sometimes it is handy to pass nil too + :nil (match (table-type# from#) + :nil nil + :empty to# + :seq (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :table (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :else (error "expected table as second argument" 2)) + :else (error "expected table as second argument" 2) + _# (let [m# (or (getmetatable to#) {})] + (match m#.cljlib/into + f# (f# to# from#) + nil (error "expected table as SECOND argument" 2))))] + (if res# + (let [m# (or (getmetatable res#) {})] + (set m#.cljlib/type (match to-type# + :seq :seq + :empty :seq + :table :table + t# t#)) + (setmetatable res# m#))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; empty ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn empty [x] + "Return empty table of the same kind as input table `x`, with +additional metadata indicating its type. + +# Example +Creating a generic `map` function, that will work on any table type, +and return result of the same type: + +``` fennel +(fn map [f tbl] + (let [res []] + (each [_ v (ipairs (into [] tbl))] + (table.insert res (f v))) + (into (empty tbl) res))) + +(map (fn [[k v]] [(string.upper k) v]) {:a 1 :b 2 :c 3}) +;; => {:A 1 :B 2 :C 3} +(map #(* $ $) [1 2 3 4]) +;; [1 4 9 16] +``` +See [`into`](#into) for more info on how conversion is done." + (match (table-type x) + :seq `(setmetatable {} {:cljlib/type :seq}) + :table `(setmetatable {} {:cljlib/type :table}) + _ `(let [x# ,x + m# (getmetatable x#)] + (match (and m# m#.cljlib/empty) + f# (f# x#) + _# (match (,(table-type-fn) x#) + :string (setmetatable {} {:cljlib/type :seq}) + :nil nil + :else (error (.. "can't create sequence from " (type x#))) + t# (setmetatable {} {:cljlib/type t#})))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; multimethods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn seq->table [seq] + (let [tbl {}] + (for [i 1 (length seq) 2] + (tset tbl (. seq i) (. seq (+ i 1)))) + tbl)) + +(fn defmulti [...] + (let [[name & options] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for defmulti")) + docstring (if (string? (first options)) (first options)) + options (if docstring (rest options) options) + dispatch-fn (first options) + options (rest options)] + (assert (= (% (length options) 2) 0) "wrong argument amount for defmulti") + (let [options (seq->table options)] + (if (in-scope? name) + `nil + `(local ,name + (setmetatable + ,(with-meta {} {:fnl/docstring docstring}) + {:__index + (fn [tbl# key#] + (let [eq# ,(eq-fn)] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)) + :__call + (fn [t# ...] + ,docstring + (let [dispatch-value# (,dispatch-fn ...) + (res# view#) (pcall require :fennelview) + tostr# (if res# #(view# $ {:one-line true}) tostring)] + ((or (. t# dispatch-value#) + (. t# (or (. ,options :default) :default)) + (error (.. "No method in multimethod '" + ,(tostring name) + "' for dispatch value: " + (tostr# dispatch-value#)) + 2)) ...))) + :__name (.. "multifn " ,(tostring name)) + :__fennelview tostring + :cljlib/type :multifn})))))) + +(attach-meta defmulti {:fnl/arglist [:name :docstring? :dispatch-fn :attr-map?] + :fnl/docstring "Create multifunction with +runtime dispatching based on results from `dispatch-fn`. Returns an +empty table with `__call` metamethod, that calls `dispatch-fn` on its +arguments. Amount of arguments passed, should be the same as accepted +by `dispatch-fn`. Looks for multimethod based on result from +`dispatch-fn`. + +By default, multifunction has no multimethods, see +[`multimethod`](#multimethod) on how to add one."}) + + +(fn defmethod [multifn dispatch-val ...] + (when (= (select :# ...) 0) (error "wrong argument amount for defmethod")) + `(doto ,multifn (tset ,dispatch-val (do (fn* f# ,...) f#)))) + +(attach-meta defmethod {:fnl/arglist [:multifn :dispatch-val :fnspec] + :fnl/docstring "Attach new method to multi-function dispatch value. accepts the `multi-fn` +as its first argument, the dispatch value as second, and function tail +starting from argument list, followed by function body as in +[`fn*`](#fn). + +# Examples +Here are some examples how multimethods can be used. + +## Factorial example +Key idea here is that multimethods can call itself with different +values, and will dispatch correctly. Here, `fac` recursively calls +itself with less and less number until it reaches `0` and dispatches +to another multimethod: + +``` fennel +(defmulti fac (fn [x] x)) + +(defmethod fac 0 [_] 1) +(defmethod fac :default [x] (* x (fac (- x 1)))) + +(fac 4) ;; => 24 +``` + +`:default` is a special method which gets called when no other methods +were found for given dispatch value. + +## Multi-arity dispatching +Multi-arity function tails are also supported: + +``` fennel +(defmulti foo (fn* ([x] [x]) ([x y] [x y]))) + +(defmethod foo [10] [_] (print \"I've knew I'll get 10\")) +(defmethod foo [10 20] [_ _] (print \"I've knew I'll get both 10 and 20\")) +(defmethod foo :default ([x] (print (.. \"Umm, got\" x))) + ([x y] (print (.. \"Umm, got both \" x \" and \" y)))) +``` + +Calling `(foo 10)` will print `\"I've knew I'll get 10\"`, and calling +`(foo 10 20)` will print `\"I've knew I'll get both 10 and 20\"`. +However, calling `foo` with any other numbers will default either to +`\"Umm, got x\"` message, when called with single value, and `\"Umm, got +both x and y\"` when calling with two values. + +## Dispatching on object's type +We can dispatch based on types the same way we dispatch on values. +For example, here's a naive conversion from Fennel's notation for +tables to Lua's one: + +``` fennel +(defmulti to-lua-str (fn [x] (type x))) + +(defmethod to-lua-str :number [x] (tostring x)) +(defmethod to-lua-str :table [x] (let [res []] + (each [k v (pairs x)] + (table.insert res (.. \"[\" (to-lua-str k) \"] = \" (to-lua-str v)))) + (.. \"{\" (table.concat res \", \") \"}\"))) +(defmethod to-lua-str :string [x] (.. \"\\\"\" x \"\\\"\")) +(defmethod to-lua-str :default [x] (tostring x)) +``` + +And if we call it on some table, we'll get a valid Lua table: + +``` fennel +(print (to-lua-str {:a {:b 10}})) +;; prints {[\"a\"] = {[\"b\"] = 10}} + +(print (to-lua-str [:a :b :c [:d {:e :f}]])) +;; prints {[1] = \"a\", [2] = \"b\", [3] = \"c\", [4] = {[1] = \"d\", [2] = {[\"e\"] = \"f\"}}} +``` + +Which we can then reformat as we want and use in Lua if we want."}) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; def and defonce ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn def [...] + (let [[attr-map name expr] (match (select :# ...) + 2 [{} ...] + 3 [...] + _ (error "wrong argument amount for def" 2)) + attr-map (if (table? attr-map) attr-map + (string? attr-map) {attr-map true} + (error "def: expected keyword or literal table as first argument" 2)) + (s multi) (multisym->sym name) + docstring (or (. attr-map :doc) + (. attr-map :fnl/docstring)) + f (if (. attr-map :mutable) 'var 'local)] + (if multi + `(,f ,s (do (,f ,s ,expr) + (set ,name ,s) + ,(with-meta s {:fnl/docstring docstring}))) + `(,f ,name ,(with-meta expr {:fnl/docstring docstring}))))) + +(attach-meta def {:fnl/arglist [:attr-map? :name :expr] + :fnl/docstring "Wrapper around `local` which can +declare variables inside namespace, and as local at the same time +similarly to [`fn*`](#fn*): + +``` fennel +(def ns {}) +(def a 10) ;; binds `a` to `10` + +(def ns.b 20) ;; binds `ns.b` and `b` to `20` +``` + +`a` is a `local`, and both `ns.b` and `b` refer to the same value. + +Additionally metadata can be attached to values, by providing +attribute map or keyword as first parameter. Only one keyword is +supported, which is `:mutable`, which allows mutating variable with +`set` later on: + +``` fennel +;; Bad, will override existing documentation for 299792458 (if any) +(def {:doc \"speed of light in m/s\"} c 299792458) +(set c 0) ;; => error, can't mutate `c` + +(def :mutable address \"Lua St.\") ;; same as (def {:mutable true} address \"Lua St.\") +(set address \"Lisp St.\") ;; can mutate `address` +``` + +However, attaching documentation metadata to anything other than +tables and functions considered bad practice, due to how Lua +works. More info can be found in [`with-meta`](#with-meta) +description."}) + +(fn defonce [...] + (let [[attr-map name expr] (match (select :# ...) + 2 [{} ...] + 3 [...] + _ (error "wrong argument amount for def" 2))] + (if (in-scope? name) + nil + (def attr-map name expr)))) + +(attach-meta defonce {:fnl/arglist [:attr-map? :name :expr] + :fnl/docstring "Works the same as [`def`](#def), but ensures that later `defonce` +calls will not override existing bindings: + +``` fennel +(defonce a 10) +(defonce a 20) +(print a) ;; => prints 10 +```"}) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; try ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(fn catch? [[fun]] + "Test if expression is a catch clause." + (= (tostring fun) :catch)) + +(fn finally? [[fun]] + "Test if expression is a finally clause." + (= (tostring fun) :finally)) + +(fn add-finally [finally form] + "Stores `form` as body of `finally`, which will be injected into +`match` branches at places appropriate for it to run. + +Checks if there already was `finally` clause met, which can be only +one." + (assert-compile (= (length finally) 0) + "Only one finally clause can exist in try expression" + []) + (table.insert finally (list 'do ((or table.unpack _G.unpack) form 2)))) + +(fn add-catch [finally catches form] + "Appends `catch` body to a sequence of catch bodies that will later +be used in `make-catch-clauses` to produce AST. + +Checks if there already was `finally` clause met." + (assert-compile (= (length finally) 0) + "finally clause must be last in try expression" + []) + (table.insert catches (list 'do ((or table.unpack _G.unpack) form 2)))) + +(fn make-catch-clauses [catches finally] + "Generates AST of error branches for `match` macro." + (let [clauses []] + (var add-catchall? true) + (each [_ [_ binding-or-val & body] (ipairs catches)] + (when (sym? binding-or-val) + (set add-catchall? false)) + (table.insert clauses `(false ,binding-or-val)) + (table.insert clauses `(let [res# (do ,((or table.unpack _G.unpack) body))] + ,(. finally 1) + res#))) + (when add-catchall? + ;; implicit catchall which retrows error further is added only + ;; if there were no catch clause that used symbol as catch value + (table.insert clauses `(false _#)) + (table.insert clauses `(do ,(. finally 1) (error _#)))) + ((or table.unpack _G.unpack) clauses))) + +(fn add-to-try [finally catches try form] + "Append form to the try body. There must be no `catch` of `finally` +clauses when we push body epression." + (assert-compile (and (= (length finally) 0) + (= (length catches) 0)) + "Only catch or finally clause can follow catch in try expression" + []) + (table.insert try form)) + +(fn try [...] + (let [try '(fn []) + catches [] + finally []] + (each [_ form (ipairs [...])] + (if (list? form) + (if (catch? form) (add-catch finally catches form) + (finally? form) (add-finally finally form) + (add-to-try finally catches try form)) + (add-to-try finally catches try form))) + `(match (pcall ,try) + (true _#) (do ,(. finally 1) _#) + ,(make-catch-clauses catches finally)))) + +(attach-meta try {:fnl/arglist [:body* :catch-clause* :finally-clause?] + :fnl/docstring "General purpose try/catch/finally macro. +Wraps its body in `pcall` and checks the return value with `match` +macro. + +Catch clause is written either as (catch symbol body*), thus acting as +catch-all, or (catch value body*) for catching specific errors. It is +possible to have several `catch` clauses. If no `catch` clauses +specified, an implicit catch-all clause is created. + +Finally clause is optional, and written as (finally body*). If +present, it must be the last clause in the `try` form, and the only +`finally` clause. Note that `finally` clause is for side effects +only, and runs either after succesful run of `try` body, or after any +`catch` clause body, before returning the result. If no `catch` +clause is provided `finally` runs in implicit catch-all clause, and +trows error to upper scope using `error` function. + +To throw error from `try` to catch it with `catch` clause use `error` +or `assert` functions. + +# Examples +Catch all errors, ignore those and return fallback value: + +``` fennel +(fn add [x y] + (try + (+ x y) + (catch _ 0))) + +(add nil 1) ;; => 0 +``` + +Catch error and do cleanup: + +``` fennel +>> (let [tbl []] + (try + (table.insert tbl \"a\") + (table.insert tbl \"b\" \"c\") + (catch _ + (each [k _ (pairs tbl)] + (tset tbl k nil)))) + tbl) +{} +``` + +Always run some side effect action: + +``` fennel +>> (local res (try 10 (finally (print \"side-effect!\"))) +side-effect! +nil +>> res +10 +>> (local res (try (error 10) (catch 10 nil) (finally (print \"side-effect!\"))) +side-effect! +nil +>> res +nil +``` +"}) + + +{: fn* + : try + : if-let + : when-let + : if-some + : when-some + : empty + : into + : when-meta + : with-meta + : meta + : defmulti + : defmethod + : def + : defonce + :_VERSION #"0.3.0" + :_LICENSE #"[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)" + :_COPYRIGHT #"Copyright (C) 2020 Andrey Orst" + :_DOC_ORDER #[:fn* + :try + :def :defonce :defmulti :defmethod + :into :empty + :when-meta :with-meta :meta + :if-let :when-let :if-some :when-some] + :_DESCRIPTION #"Macros for Cljlib that implement various facilities from Clojure."} + +;; LocalWords: arglist fn runtime arities arity multi destructuring +;; LocalWords: docstring Variadic LocalWords multisym sym tbl eq Lua +;; LocalWords: defonce metadata metatable fac defmulti Umm defmethod +;; LocalWords: multimethods multimethod multifn REPL fnl AST Lua's +;; LocalWords: lua tostring str concat namespace ns Cljlib Clojure diff --git a/tests/core.fnl b/tests/core.fnl index d323a07..ab62a4b 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -1,49 +1,40 @@ -(require-macros :cljlib-macros) +(require-macros :macros) (require-macros :tests.test) -(macro require-module [module] - "Require module and bind all it's functions to locals." - `(local ,(let [destr-map# {}] - (each [k# _# (pairs (require module))] - (when (not= (string.sub k# 1 1) :_) - (tset destr-map# k# (sym k#)))) - destr-map#) - (require ,module))) - -(require-module :cljlib) +(local core (require :init)) (deftest equality (testing "comparing basetypes" - (assert-not (pcall eq)) + (assert-not (pcall core.eq)) (assert-eq 1 1) (assert-ne 1 2) - (assert-is (eq 1 1 1 1 1)) + (assert-is (core.eq 1 1 1 1 1)) (assert-eq 1.0 1.0) - (assert-is (eq 1.0 1.0 1.0)) - (assert-is (eq 1.0 1.0 1.0)) - (assert-is (eq "1" "1" "1" "1" "1"))) + (assert-is (core.eq 1.0 1.0 1.0)) + (assert-is (core.eq 1.0 1.0 1.0)) + (assert-is (core.eq "1" "1" "1" "1" "1"))) (testing "deep comparison" - (assert-is (eq [])) + (assert-is (core.eq [])) (assert-eq [] []) (assert-eq [] {}) (assert-eq [1 2] [1 2]) (assert-eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]]) - (assert-is (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) - (assert-is (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) - (assert-not (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] - [[1 [2 [3]] {[6] {:a [1 [1 [1 [1]]]]}}]])) + (assert-is (core.eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + (assert-is (core.eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + (assert-not (core.eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[6] {:a [1 [1 [1 [1]]]]}}]])) (assert-ne [1] [1 2]) (assert-ne [1 2] [1]) - (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) - (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) - (assert-not (eq [1 [2]] [1 [2]] [1 [2 [3]]])) - (assert-not (eq {:a {:b 2}} {:a {:b 2}} {:a {:b 3}})) + (assert-is (core.eq [1 [2]] [1 [2]] [1 [2]])) + (assert-is (core.eq [1 [2]] [1 [2]] [1 [2]])) + (assert-not (core.eq [1 [2]] [1 [2]] [1 [2 [3]]])) + (assert-not (core.eq {:a {:b 2}} {:a {:b 2}} {:a {:b 3}})) (let [a {:a 1 :b 2} b {:a 1 :b 2}] @@ -74,12 +65,12 @@ meta-b (getmetatable b) index-a (. meta-a :__index) index-b (. meta-b :__index)] - (eq a b) + (core.eq a b) (assert-eq meta-a (getmetatable a)) (assert-eq meta-b (getmetatable b)) (assert-eq index-a (. (getmetatable a) :__index)) (assert-eq index-b (. (getmetatable b) :__index)) - (eq b a) + (core.eq b a) (assert-eq meta-a (getmetatable a)) (assert-eq meta-b (getmetatable b)) (assert-eq index-a (. (getmetatable a) :__index)) @@ -87,189 +78,190 @@ (deftest range (testing "range" - (assert-not (pcall range)) - (assert-eq (range 10) [0 1 2 3 4 5 6 7 8 9]) - (assert-eq (range -5 5) [-5 -4 -3 -2 -1 0 1 2 3 4]) + (assert-not (pcall core.range)) + (assert-eq (core.range 10) [0 1 2 3 4 5 6 7 8 9]) + (assert-eq (core.range -5 5) [-5 -4 -3 -2 -1 0 1 2 3 4]) (assert-eq [0 0.2 0.4 0.6 0.8] [0 0.2 0.4 0.6 0.8]) - (assert-eq (range 0 1 0.2) (range 0 1 0.2)))) + (assert-eq (core.range 0 1 0.2) (core.range 0 1 0.2)))) (deftest predicates (testing "zero?" - (assert-is (zero? 0)) - (assert-is (zero? -0)) - (assert-not (zero? 1)) - (assert-not (pcall zero?)) - (assert-not (pcall zero? 1 2))) + (assert-is (core.zero? 0)) + (assert-is (core.zero? -0)) + (assert-not (core.zero? 1)) + (assert-not (pcall core.zero?)) + (assert-not (pcall core.zero? 1 2))) (testing "int?" - (assert-is (int? 1)) - (assert-not (int? 1.1)) - (assert-not (pcall int?)) - (assert-not (pcall int? 1 2))) + (assert-is (core.int? 1)) + (assert-not (core.int? 1.1)) + (assert-not (pcall core.int?)) + (assert-not (pcall core.int? 1 2))) (testing "pos?" - (assert-is (pos? 1)) - (assert-is (and (not (pos? 0)) (not (pos? -1)))) - (assert-not (pcall pos?)) - (assert-not (pcall pos? 1 2))) + (assert-is (core.pos? 1)) + (assert-is (and (not (core.pos? 0)) (not (core.pos? -1)))) + (assert-not (pcall core.pos?)) + (assert-not (pcall core.pos? 1 2))) (testing "neg?" - (assert-is (neg? -1)) - (assert-is (and (not (neg? 0)) (not (neg? 1)))) - (assert-not (pcall neg?)) - (assert-not (pcall neg? 1 2))) + (assert-is (core.neg? -1)) + (assert-is (and (not (core.neg? 0)) (not (core.neg? 1)))) + (assert-not (pcall core.neg?)) + (assert-not (pcall core.neg? 1 2))) (testing "pos-int?" - (assert-is (pos-int? 42)) - (assert-not (pos-int? 4.2)) - (assert-not (pcall pos-int?)) - (assert-not (pcall pos-int? 1 2))) + (assert-is (core.pos-int? 42)) + (assert-not (core.pos-int? 4.2)) + (assert-not (pcall core.pos-int?)) + (assert-not (pcall core.pos-int? 1 2))) (testing "neg-int?" - (assert-is (neg-int? -42)) - (assert-not (neg-int? -4.2)) - (assert-not (pcall neg-int?)) - (assert-not (pcall neg-int? 1 2))) + (assert-is (core.neg-int? -42)) + ;; (assert-not (core.neg-int? -4.2)) + (assert-not (pcall core.neg-int?)) + (assert-not (pcall core.neg-int? 1 2))) (testing "string?" - (assert-is (string? :s)) - (assert-not (pcall string?)) - (assert-not (pcall string? 1 2))) + (assert-is (core.string? :s)) + (assert-not (pcall core.string?)) + (assert-not (pcall core.string? 1 2))) (testing "double?" - (assert-is (double? 3.3)) - (assert-not (double? 3.0)) - (assert-not (pcall double?)) - (assert-not (pcall double? 1 2))) + (assert-is (core.double? 3.3)) + (assert-not (core.double? 3.0)) + (assert-not (pcall core.double?)) + (assert-not (pcall core.double? 1 2))) (testing "map?" - (assert-is (map? {:a 1})) - (assert-not (map? {})) - (assert-is (map? (empty {}))) - (assert-not (map? (empty []))) - (assert-not (pcall map?)) - (assert-not (pcall map? 1 2))) + (assert-is (core.map? {:a 1})) + (assert-not (core.map? {})) + (assert-is (core.map? (empty {}))) + (assert-not (core.map? (empty []))) + (assert-not (pcall core.map?)) + (assert-not (pcall core.map? 1 2))) (testing "vector?" - (assert-not (vector? [])) - (assert-is (vector? [{:a 1}])) - (assert-not (vector? {})) - (assert-not (vector? {:a 1})) - (assert-is (vector? (empty []))) - (assert-not (vector? (empty {}))) - (assert-not (pcall vector?)) - (assert-not (pcall vector? 1 2))) + (assert-not (core.vector? [])) + (assert-is (core.vector? [{:a 1}])) + (assert-not (core.vector? {})) + (assert-not (core.vector? {:a 1})) + (assert-is (core.vector? (empty []))) + (assert-not (core.vector? (empty {}))) + (assert-not (pcall core.vector?)) + (assert-not (pcall core.vector? 1 2))) (testing "multifn?" - (assert-not (multifn? [])) - (assert-is (multifn? (do (defmulti f identity) f))) - (assert-not (pcall multifn?)) - (assert-not (pcall multifn? 1 2))) + (assert-not (core.multifn? [])) + (assert-is (core.multifn? (do (defmulti f core.identity) f))) + (assert-not (pcall core.multifn?)) + (assert-not (pcall core.multifn? 1 2))) (testing "set?" - (assert-is (set? (ordered-set))) - (assert-is (set? (hash-set))) - (assert-eq (set? (hash-set)) :cljlib/hash-set) - (assert-eq (set? (ordered-set)) :cljlib/ordered-set) - (assert-not (pcall set?)) - (assert-not (pcall set? 1 2))) + (assert-is (core.set? (core.ordered-set))) + (assert-is (core.set? (core.hash-set))) + (assert-eq (core.set? (core.hash-set)) :cljlib/hash-set) + (assert-eq (core.set? (core.ordered-set)) :cljlib/ordered-set) + (assert-not (pcall core.set?)) + (assert-not (pcall core.set? 1 2))) (testing "nil?" - (assert-is (nil?)) - (assert-is (nil? nil)) - (assert-not (nil? 1)) - (assert-not (pcall nil? 1 2))) + (assert-is (core.nil?)) + (assert-is (core.nil? nil)) + (assert-not (core.nil? 1)) + (assert-not (pcall core.nil? 1 2))) (testing "odd?" - (assert-is (odd? 3)) - (assert-is (odd? -3)) - (assert-not (odd? 2)) - (assert-not (odd? -2)) - (assert-not (pcall odd?)) - (assert-not (pcall odd? 1 2))) + (assert-is (core.odd? 3)) + (assert-is (core.odd? -3)) + (assert-not (core.odd? 2)) + (assert-not (core.odd? -2)) + (assert-not (pcall core.odd?)) + (assert-not (pcall core.odd? 1 2))) (testing "even?" - (assert-is (even? 2)) - (assert-is (even? -2)) - (assert-not (even? 23)) - (assert-not (even? -23)) - (assert-not (pcall even?)) - (assert-not (pcall even? 1 2))) + (assert-is (core.even? 2)) + (assert-is (core.even? -2)) + (assert-not (core.even? 23)) + (assert-not (core.even? -23)) + (assert-not (pcall core.even?)) + (assert-not (pcall core.even? 1 2))) (testing "true?" - (assert-is (true? true)) - (assert-not (true? false)) - (assert-not (true? 10)) - (assert-not (true? :true)) - (assert-not (pcall true?)) - (assert-not (pcall true? 1 2))) + (assert-is (core.true? true)) + (assert-not (core.true? false)) + (assert-not (core.true? 10)) + (assert-not (core.true? :true)) + (assert-not (pcall core.true?)) + (assert-not (pcall core.true? 1 2))) (testing "false?" - (assert-is (false? false)) - (assert-not (false? true)) - (assert-not (false? 10)) - (assert-not (false? :true)) - (assert-not (pcall false?)) - (assert-not (pcall false? 1 2))) + (assert-is (core.false? false)) + (assert-not (core.false? true)) + (assert-not (core.false? 10)) + (assert-not (core.false? :true)) + (assert-not (pcall core.false?)) + (assert-not (pcall core.false? 1 2))) (testing "boolean?" - (assert-is (boolean? true)) - (assert-is (boolean? false)) - (assert-not (boolean? :false)) - (assert-not (boolean? (fn [] true))) - (assert-not (pcall boolean?)) - (assert-not (pcall boolean? 1 2)))) + (assert-is (core.boolean? true)) + (assert-is (core.boolean? false)) + (assert-not (core.boolean? :false)) + (assert-not (core.boolean? (fn [] true))) + (assert-not (pcall core.boolean?)) + (assert-not (pcall core.boolean? 1 2)))) (deftest sequence-functions (testing "seq" - (assert-not (pcall seq)) - (assert-not (pcall seq [] [])) - (assert-eq (seq []) nil) - (assert-eq (seq {}) nil) - (assert-eq (seq [1]) [1]) - (assert-eq (seq [1 2 3]) [1 2 3]) - (assert-eq (seq {:a 1}) [["a" 1]]) - (assert-eq (seq "abc") ["a" "b" "c"]) - (assert-eq (seq "абв") ["а" "б" "в"]) - (assert-eq (seq {12345 123}) [[12345 123]]) - (assert-eq (seq (ordered-set 1 2 3)) [1 2 3]) - (assert-eq (length (seq (ordered-set 1 2 3))) 3) - (assert-eq (seq (hash-set 1)) [1]) - (assert-eq (length (seq (hash-set 1 2 3))) 3)) + (assert-not (pcall core.seq)) + (assert-not (pcall core.seq [] [])) + (assert-eq (core.seq []) nil) + (assert-eq (core.seq {}) nil) + (assert-eq (core.seq [1]) [1]) + (assert-eq (core.seq [1 2 3]) [1 2 3]) + (assert-eq (core.seq {:a 1}) [["a" 1]]) + (assert-eq (core.seq "abc") ["a" "b" "c"]) + (when _G.utf8 (assert-eq (core.seq "абв") ["а" "б" "в"])) + (assert-eq (core.seq {12345 123}) [[12345 123]]) + (assert-eq (core.seq (core.ordered-set 1 2 3)) [1 2 3]) + (assert-eq (length (core.seq (core.ordered-set 1 2 3))) 3) + (assert-eq (core.seq (core.hash-set 1)) [1]) + (assert-eq (length (core.seq (core.hash-set 1 2 3))) 3)) (testing "kvseq" - (assert-not (pcall kvseq)) - (assert-not (pcall kvseq [] [])) - (assert-eq (kvseq {123 456}) [[123 456]]) - (assert-eq (kvseq {:a 1}) [[:a 1]]) - (assert-eq (kvseq [0 0 0 10]) [[1 0] [2 0] [3 0] [4 10]]) - (assert-eq (kvseq (ordered-set :a :b :c)) [[1 :a] [2 :b] [3 :c]]) - (assert-eq (kvseq (hash-set :a)) [[1 :a]])) + (assert-not (pcall core.kvseq)) + (assert-not (pcall core.kvseq [] [])) + (assert-eq (core.kvseq {123 456}) [[123 456]]) + (assert-eq (core.kvseq {:a 1}) [[:a 1]]) + (assert-eq (core.kvseq [0 0 0 10]) [[1 0] [2 0] [3 0] [4 10]]) + (assert-eq (core.kvseq (core.ordered-set :a :b :c)) [[1 :a] [2 :b] [3 :c]]) + (assert-eq (core.kvseq (core.hash-set :a)) [[1 :a]]) + (assert-eq (core.kvseq "abc") [[1 "a"] [2 "b"] [3 "c"]])) (testing "mapv" - (assert-not (pcall mapv)) - (assert-not (pcall mapv #(do nil))) - (assert-eq (mapv #(* $ $) [1 2 3 4]) [1 4 9 16]) + (assert-not (pcall core.mapv)) + (assert-not (pcall core.mapv #(do nil))) + (assert-eq (core.mapv #(* $ $) [1 2 3 4]) [1 4 9 16]) - (assert-eq (into {} (mapv (fn [[k v]] [k (* v v)]) {:a 1 :b 2 :c 3})) + (assert-eq (into {} (core.mapv (fn [[k v]] [k (* v v)]) {:a 1 :b 2 :c 3})) (into {} [[:a 1] [:b 4] [:c 9]])) - (assert-eq (into {} (mapv (fn [[k1 v1] [k2 v2]] [k1 (* v1 v2)]) - {:a 1 :b 2 :c 3} - {:a -1 :b 0 :c 2})) + (assert-eq (into {} (core.mapv (fn [[k1 v1] [k2 v2]] [k1 (* v1 v2)]) + {:a 1 :b 2 :c 3} + {:a -1 :b 0 :c 2})) {:a -1 :b 0 :c 6}) - (assert-eq (mapv #(* $1 $2 $3) [1] [2] [-1]) [-2]) - (assert-eq (mapv string.upper ["a" "b" "c"]) ["A" "B" "C"]) - (assert-eq (mapv #(+ $1 $2 $3 $4) [1 -1] [2 -2] [3 -3] [4 -4]) [(+ 1 2 3 4) (+ -1 -2 -3 -4)]) - (assert-eq (mapv (fn [f-name s-name company position] - (.. f-name " " s-name " works as " position " at " company)) - ["Bob" "Alice"] - ["Smith" "Watson"] - ["Happy Days co." "Coffee With You"] - ["secretary" "chief officer"]) + (assert-eq (core.mapv #(* $1 $2 $3) [1] [2] [-1]) [-2]) + (assert-eq (core.mapv string.upper ["a" "b" "c"]) ["A" "B" "C"]) + (assert-eq (core.mapv #(+ $1 $2 $3 $4) [1 -1] [2 -2] [3 -3] [4 -4]) [(+ 1 2 3 4) (+ -1 -2 -3 -4)]) + (assert-eq (core.mapv (fn [f-name s-name company position] + (.. f-name " " s-name " works as " position " at " company)) + ["Bob" "Alice"] + ["Smith" "Watson"] + ["Happy Days co." "Coffee With You"] + ["secretary" "chief officer"]) ["Bob Smith works as secretary at Happy Days co." "Alice Watson works as chief officer at Coffee With You"]) - (assert-eq (table.concat (mapv string.upper "vaiv")) "VAIV")) + (assert-eq (table.concat (core.mapv string.upper "vaiv")) "VAIV")) (testing "reduce" (fn* add @@ -282,18 +274,18 @@ (set res (+ res v))) res)) - (assert-eq (reduce add []) 0) - (assert-eq (reduce add [1]) 1) - (assert-eq (reduce add [1 2]) 3) - (assert-eq (reduce add (range 10)) 45) - (assert-eq (reduce add -3 (range 10)) 42) - (assert-eq (reduce add 10 []) 10) - (assert-eq (reduce add 10 [1]) 11) - (assert-eq (reduce add 10 nil) 10) - (assert-not (pcall reduce)) - (assert-not (pcall reduce add))) - - (testing "reduce reference implementation" + (assert-eq (core.reduce add []) 0) + (assert-eq (core.reduce add [1]) 1) + (assert-eq (core.reduce add [1 2]) 3) + (assert-eq (core.reduce add (core.range 10)) 45) + (assert-eq (core.reduce add -3 (core.range 10)) 42) + (assert-eq (core.reduce add 10 []) 10) + (assert-eq (core.reduce add 10 [1]) 11) + (assert-eq (core.reduce add 10 nil) 10) + (assert-not (pcall core.reduce)) + (assert-not (pcall core.reduce add))) + + (testing "core.reduce reference implementation" (fn mapping [f] (fn [reducing] (fn [result input] @@ -302,168 +294,173 @@ (fn -reduce [f init [x & tbl]] (if x (-reduce f (f init x) tbl) init)) - (assert-eq (reduce add (range 10)) (-reduce add 0 (range 10))) - (assert-eq (reduce ((mapping inc) add) 0 (range 10)) - (-reduce ((mapping inc) add) 0 (range 10)))) + (assert-eq (core.reduce core.add (core.range 10)) (-reduce core.add 0 (core.range 10))) + (assert-eq (core.reduce ((mapping core.inc) core.add) 0 (core.range 10)) + (-reduce ((mapping core.inc) core.add) 0 (core.range 10)))) (testing "filter" - (assert-not (pcall filter)) - (assert-not (pcall filter even?)) - (assert-eq (filter even? (range 10)) [0 2 4 6 8]) - (assert-eq (filter odd? (range 10)) [1 3 5 7 9]) - (assert-eq (filter map? [{:a 1} {5 1} [1 2] [] {}]) [{:a 1} {5 1}]) - (assert-eq (filter vector? [{:a 1} {5 1} [1 2] [] {}]) [[1 2]])) + (assert-not (pcall core.filter)) + (assert-not (pcall core.filter core.even?)) + (assert-eq (core.filter core.even? (core.range 10)) [0 2 4 6 8]) + (assert-eq (core.filter core.odd? (core.range 10)) [1 3 5 7 9]) + (assert-eq (core.filter core.map? [{:a 1} {5 1} [1 2] [] {}]) [{:a 1} {5 1}]) + (assert-eq (core.filter core.vector? [{:a 1} {5 1} [1 2] [] {}]) [[1 2]])) (testing "concat" - (assert-eq (concat) nil) - (assert-eq (concat []) []) - (assert-eq (concat [1 2 3]) [1 2 3]) - (assert-eq (concat [1 2 3] [4 5 6]) [1 2 3 4 5 6]) - (assert-eq (concat [1 2] [3 4] [5 6]) [1 2 3 4 5 6]) - (assert-eq (concat {:a 1} {:b 2}) [[:a 1] [:b 2]]) - (assert-eq (concat [[:a 1]] {:b 2}) [[:a 1] [:b 2]]) - (assert-eq (concat {:a 1} [[:b 2]]) [[:a 1] [:b 2]]) - (assert-eq (concat [] [[:b 2]]) [[:b 2]]) - (assert-eq (concat [] []) []) - (assert-not (pcall concat 1)) - (assert-not (pcall concat 1 2)) - (assert-not (pcall concat 1 [])) - (assert-not (pcall concat [] 2)) - (assert-not (pcall concat [1] 2))) + (assert-eq (core.concat) nil) + (assert-eq (core.concat []) []) + (assert-eq (core.concat [1 2 3]) [1 2 3]) + (assert-eq (core.concat [1 2 3] [4 5 6]) [1 2 3 4 5 6]) + (assert-eq (core.concat [1 2] [3 4] [5 6]) [1 2 3 4 5 6]) + (assert-eq (core.concat {:a 1} {:b 2}) [[:a 1] [:b 2]]) + (assert-eq (core.concat [[:a 1]] {:b 2}) [[:a 1] [:b 2]]) + (assert-eq (core.concat {:a 1} [[:b 2]]) [[:a 1] [:b 2]]) + (assert-eq (core.concat [] [[:b 2]]) [[:b 2]]) + (assert-eq (core.concat [] []) []) + (assert-not (pcall core.concat 1)) + (assert-not (pcall core.concat 1 2)) + (assert-not (pcall core.concat 1 [])) + (assert-not (pcall core.concat [] 2)) + (assert-not (pcall core.concat [1] 2))) (testing "reverse" - (assert-not (pcall reverse)) - (assert-not (pcall reverse [] [])) - (assert-eq (reverse []) nil) - (assert-eq (reverse [1 2 3]) [3 2 1]) - (assert-eq (reverse {:a 1}) [[:a 1]])) + (assert-not (pcall core.reverse)) + (assert-not (pcall core.reverse [] [])) + (assert-eq (core.reverse []) nil) + (assert-eq (core.reverse [1 2 3]) [3 2 1]) + (assert-eq (core.reverse {:a 1}) [[:a 1]])) (testing "conj" - (assert-eq (conj) []) - (assert-eq (conj [1]) [1]) - (assert-eq (conj [] 1 2 3) [1 2 3]) - (assert-eq (conj [0] 1 2 3) [0 1 2 3]) - (assert-eq (conj {:a 1} [:b 2]) {:a 1 :b 2}) - (assert-eq (conj {:a 1}) {:a 1}) - (assert-eq (conj [1] 2 3 4 5 6 7) [1 2 3 4 5 6 7])) + (assert-eq (core.conj) []) + (assert-eq (core.conj [1]) [1]) + (assert-eq (core.conj [] 1 2 3) [1 2 3]) + (assert-eq (core.conj [0] 1 2 3) [0 1 2 3]) + (assert-eq (core.conj {:a 1} [:b 2]) {:a 1 :b 2}) + (assert-eq (core.conj {:a 1}) {:a 1}) + (assert-eq (core.conj [1] 2 3 4 5 6 7) [1 2 3 4 5 6 7])) (testing "disj" - (assert-not (pcall disj)) - (assert-not (pcall disj [1])) - (assert-not (pcall disj [1] 1)) - (assert-eq (disj (ordered-set)) (ordered-set)) - (assert-eq (disj (ordered-set 1 3 2 5) 3) (ordered-set 1 2 5)) - (assert-eq (disj (ordered-set 1 3 2 5) 3 1 5) (ordered-set 2))) + (assert-not (pcall core.disj)) + (assert-not (pcall core.disj [1])) + (assert-not (pcall core.disj [1] 1)) + (assert-eq (core.disj (core.ordered-set)) (core.ordered-set)) + (assert-eq (core.disj (core.ordered-set 1 3 2 5) 3) (core.ordered-set 1 2 5)) + (assert-eq (core.disj (core.ordered-set 1 3 2 5) 3 1 5) (core.ordered-set 2))) (testing "cons" - (assert-not (pcall cons)) - (assert-not (pcall cons [] [] [])) - (assert-eq (cons nil [1]) [1]) - (assert-eq (cons 1 []) [1]) - (assert-eq (cons 1 [0]) [1 0])) + (assert-not (pcall core.cons)) + (assert-not (pcall core.cons [] [] [])) + (assert-eq (core.cons nil [1]) [1]) + (assert-eq (core.cons 1 []) [1]) + (assert-eq (core.cons 1 [0]) [1 0])) (testing "first" - (assert-not (pcall first)) - (assert-not (pcall first [] [])) - (assert-eq (first [1 2 3]) 1) - (assert-eq (first {:a 1}) [:a 1]) - (assert-eq (first []) nil)) + (assert-not (pcall core.first)) + (assert-not (pcall core.first [] [])) + (assert-eq (core.first [1 2 3]) 1) + (assert-eq (core.first {:a 1}) [:a 1]) + (assert-eq (core.first []) nil)) (testing "last" - (assert-not (pcall last)) - (assert-not (pcall last [] [])) - (assert-eq (last [1 2 3]) 3) - (assert-eq (last []) nil) - (assert-eq (last nil) nil) - (assert-eq (last {:a 1}) [:a 1])) + (assert-not (pcall core.last)) + (assert-not (pcall core.last [] [])) + (assert-eq (core.last [1 2 3]) 3) + (assert-eq (core.last []) nil) + (assert-eq (core.last nil) nil) + (assert-eq (core.last {:a 1}) [:a 1])) (testing "rest" - (assert-not (pcall rest)) - (assert-not (pcall rest [] [])) - (assert-eq (rest [1 2 3]) [2 3]) - (assert-eq (rest {:a 1}) []) - (assert-eq (rest []) []) - (assert-eq (rest nil) [])) + (assert-not (pcall core.rest)) + (assert-not (pcall core.rest [] [])) + (assert-eq (core.rest [1 2 3]) [2 3]) + (assert-eq (core.rest {:a 1}) []) + (assert-eq (core.rest []) []) + (assert-eq (core.rest nil) [])) (testing "butlast" - (assert-not (pcall butlast)) - (assert-not (pcall butlast [] [])) - (assert-eq (butlast [1 2 3]) [1 2]) - (assert-eq (butlast {:a 1}) nil) - (assert-eq (butlast []) nil) - (assert-eq (butlast nil) nil)) + (assert-not (pcall core.butlast)) + (assert-not (pcall core.butlast [] [])) + (assert-eq (core.butlast [1 2 3]) [1 2]) + (assert-eq (core.butlast {:a 1}) nil) + (assert-eq (core.butlast []) nil) + (assert-eq (core.butlast nil) nil)) (testing "reduce-kv" - (assert-eq (reduce-kv #(+ $1 $3) 0 {:a 1 :b 2 :c 3}) 6) - (assert-eq (reduce-kv #(+ $1 $3) 0 [1 2 3]) 6) - (assert-not (pcall reduce-kv #(+ $1 $3) 0)) - (assert-not (pcall reduce-kv #(+ $1 $3))) - (assert-not (pcall reduce-kv))) + (assert-eq (core.reduce-kv #(+ $1 $3) 0 {:a 1 :b 2 :c 3}) 6) + (assert-eq (core.reduce-kv #(+ $1 $3) 0 [1 2 3]) 6) + (assert-not (pcall core.reduce-kv #(+ $1 $3) 0)) + (assert-not (pcall core.reduce-kv #(+ $1 $3))) + (assert-not (pcall core.reduce-kv))) (testing "reduced" - (assert-not (pcall reduced)) - (assert-not (pcall reduced 1 2 3)) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1]) 1) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2]) 3) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4]) 10) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4 5]) 15) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) [1 2 3 4 5 6]) -1) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 10 [1]) 11) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 10 [1 2]) -1) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 0 [10 5]) 15) - (assert-eq (reduce #(if (> $1 10) (reduced -1) (+ $1 $2)) 1 [10 7]) -1) - - (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 0 {:a 1 :b 2}) 3) - (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 0 {:a 10 :b 2}) 12) - (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 1 {:a 3 :b 3 :c 3 :d 3}) 13) - (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 2 {:a 3 :b 3 :c 3 :d 3}) -1) - (assert-eq (reduce-kv (fn [res _ v] (if (> res 10) (reduced -1) (+ res v))) 1 [10 12]) -1)) + (assert-not (pcall core.reduced)) + (assert-not (pcall core.reduced 1 2 3)) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) [1]) 1) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) [1 2]) 3) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) [1 2 3 4]) 10) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) [1 2 3 4 5]) 15) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) [1 2 3 4 5 6]) -1) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) 10 [1]) 11) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) 10 [1 2]) -1) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) 0 [10 5]) 15) + (assert-eq (core.reduce #(if (> $1 10) (core.reduced -1) (+ $1 $2)) 1 [10 7]) -1) + + (assert-eq (core.reduce-kv (fn [res _ v] (if (> res 10) (core.reduced -1) (+ res v))) 0 {:a 1 :b 2}) 3) + (assert-eq (core.reduce-kv (fn [res _ v] (if (> res 10) (core.reduced -1) (+ res v))) 0 {:a 10 :b 2}) 12) + (assert-eq (core.reduce-kv (fn [res _ v] (if (> res 10) (core.reduced -1) (+ res v))) 1 {:a 3 :b 3 :c 3 :d 3}) 13) + (assert-eq (core.reduce-kv (fn [res _ v] (if (> res 10) (core.reduced -1) (+ res v))) 2 {:a 3 :b 3 :c 3 :d 3}) -1) + (assert-eq (core.reduce-kv (fn [res _ v] (if (> res 10) (core.reduced -1) (+ res v))) 1 [10 12]) -1)) (testing "assoc" - (assert-not (pcall assoc)) - (assert-not (pcall assoc {})) - (assert-eq (assoc {} :a 1) {:a 1}) - (assert-eq (assoc {} :a 1 :b 2 :c 3 :d 4) {:a 1 :b 2 :c 3 :d 4})) + (assert-not (pcall core.assoc)) + (assert-not (pcall core.assoc {})) + (assert-eq (core.assoc {} :a 1) {:a 1}) + (assert-eq (core.assoc {} :a 1 :b 2 :c 3 :d 4) {:a 1 :b 2 :c 3 :d 4})) (testing "dissoc" - (assert-not (pcall dissoc)) - (assert-eq (dissoc {}) {}) - (assert-eq (dissoc {:a 1 :b 2} :b) {:a 1}) - (assert-eq (dissoc {:a 1 :b 2 :c 3} :a :c) {:b 2})) + (assert-not (pcall core.dissoc)) + (assert-eq (core.dissoc {}) {}) + (assert-eq (core.dissoc {:a 1 :b 2} :b) {:a 1}) + (assert-eq (core.dissoc {:a 1 :b 2 :c 3} :a :c) {:b 2})) (testing "find, keys and vals" - (assert-not (pcall keys)) - (assert-not (pcall keys {} {} {})) - (assert-not (pcall vals)) - (assert-not (pcall vals {} {} {})) - (assert-not (pcall find)) - (assert-not (pcall find {} {} {})) - (assert-eq (keys {:a 1 :b 2 :c 3}) (hash-set :a :b :c)) - (assert-eq (vals {:a 1 :b 2 :c 3}) (hash-set 1 2 3)) - (assert-eq (find {:a 1 :b 2 :c 3} :c) [:c 3]) - (assert-eq (find {:a 1 :b 2 :c 3} :d) nil))) + (assert-not (pcall core.keys)) + (assert-not (pcall core.keys {} {} {})) + (assert-not (pcall core.vals)) + (assert-not (pcall core.vals {} {} {})) + (assert-not (pcall core.find)) + (assert-not (pcall core.find {} {} {})) + (assert-eq (core.keys {:a 1}) [:a]) + (assert-eq (core.vals {:a 1}) [1]) + (match (pcall #(assert-eq (core.keys {:a 1 :b 2 :c 3}) (core.hash-set :a :b :c))) + (false msg) (io.stderr:write (.. "WARNING: " msg))) + (match (pcall #(assert-eq (core.vals {:a 1 :b 2 :c 3}) (core.hash-set 1 2 3))) + (false msg) (io.stderr:write (.. "WARNING: " msg))) + (assert-eq (core.find {:a 1 :b 2 :c 3} :c) [:c 3]) + (assert-eq (core.find {:a 1 :b 2 :c 3} :d) nil))) + (deftest function-manipulation (testing "constantly" - (assert-not (pcall constantly)) - (assert-not (pcall constantly nil nil)) - (let [always-nil (constantly nil)] + (assert-not (pcall core.constantly)) + (assert-not (pcall core.constantly nil nil)) + (let [always-nil (core.constantly nil)] (assert-eq (always-nil) nil) (assert-eq (always-nil 1) nil) (assert-eq (always-nil 1 2 3 4 "5") nil)) - (let [always-true (constantly true)] + (let [always-true (core.constantly true)] (assert-is (always-true)) (assert-is (always-true false)))) (testing "complement" - (assert-not (pcall complement)) - (assert-not (pcall complement #nil #nil)) - (assert-is ((complement #(do false)))) - (assert-is ((complement nil?) 10)) - (assert-is ((complement every?) double? [1 2 3 4])) - (assert-is ((complement #(= $1 $2 $3)) 1 1 2 1)) - (assert-is ((complement #(= $1 $2)) 1 2))) + (assert-not (pcall core.complement)) + (assert-not (pcall core.complement #nil #nil)) + (assert-is ((core.complement #(do false)))) + (assert-is ((core.complement core.nil?) 10)) + (assert-is ((core.complement core.every?) core.double? [1 2 3 4])) + (assert-is ((core.complement #(= $1 $2 $3)) 1 1 2 1)) + (assert-is ((core.complement #(= $1 $2)) 1 2))) (testing "apply" (fn* add @@ -471,325 +468,329 @@ ([x y] (+ x y)) ([x y & zs] (add (+ x y) ((or _G.unpack table.unpack) zs)))) - (assert-eq (apply add [1 2 3 4]) 10) - (assert-eq (apply add -1 [1 2 3 4]) 9) - (assert-eq (apply add -2 -1 [1 2 3 4]) 7) - (assert-eq (apply add -3 -2 -1 [1 2 3 4]) 4) - (assert-eq (apply add -4 -3 -2 -1 [1 2 3 4]) 0) - (assert-eq (apply add -5 -4 -3 -2 -1 [1 2 3 4]) -5) - (assert-not (pcall apply)) - (assert-not (pcall apply add))) + (assert-eq (core.apply add [1 2 3 4]) 10) + (assert-eq (core.apply add -1 [1 2 3 4]) 9) + (assert-eq (core.apply add -2 -1 [1 2 3 4]) 7) + (assert-eq (core.apply add -3 -2 -1 [1 2 3 4]) 4) + (assert-eq (core.apply add -4 -3 -2 -1 [1 2 3 4]) 0) + (assert-eq (core.apply add -5 -4 -3 -2 -1 [1 2 3 4]) -5) + (assert-not (pcall core.apply)) + (assert-not (pcall core.apply add))) (testing "comp" - (assert-eq ((comp) 10) 10) - (assert-eq ((comp #10)) 10) + (assert-eq ((core.comp) 10) 10) + (assert-eq ((core.comp #10)) 10) (fn square [x] (* x x)) - (assert-eq (comp square) square) - (assert-eq ((comp square inc) 6) 49) - (assert-eq ((comp #(- $ 7) square inc inc inc inc inc inc inc) 0) 42) + (assert-eq (core.comp square) square) + (assert-eq ((core.comp square core.inc) 6) 49) + (assert-eq ((core.comp #(- $ 7) square core.inc core.inc core.inc core.inc core.inc core.inc core.inc) 0) 42) (fn sum-squares [x y] (+ (* x x) (* y y))) - (assert-eq ((comp square inc sum-squares) 2 3) 196) + (assert-eq ((core.comp square core.inc sum-squares) 2 3) 196) (fn f [a b c] (+ a b c)) - (assert-eq ((comp inc f) 1 2 3) 7) + (assert-eq ((core.comp core.inc f) 1 2 3) 7) (fn g [a b c d] (+ a b c d)) - (assert-eq ((comp inc g) 1 2 3 4) 11) + (assert-eq ((core.comp core.inc g) 1 2 3 4) 11) (fn h [a b c d e f] (+ a b c d e f)) - (assert-eq ((comp inc h) 1 2 3 4 5 6) 22)) + (assert-eq ((core.comp core.inc h) 1 2 3 4 5 6) 22)) (testing "identity" (fn f [] nil) (local a {}) - (assert-not (pcall identity)) - (assert-not (pcall identity 1 2)) - (assert-eq (identity 1) 1) - (assert-eq (identity {:a 1 :b 2}) {:a 1 :b 2}) - (assert-eq (identity [1 2 3]) [1 2 3]) - (assert-eq (identity "abc") "abc") - (assert-eq (identity f) f) - (assert-eq (identity a) a))) + (assert-not (pcall core.identity)) + (assert-not (pcall core.identity 1 2)) + (assert-eq (core.identity 1) 1) + (assert-eq (core.identity {:a 1 :b 2}) {:a 1 :b 2}) + (assert-eq (core.identity [1 2 3]) [1 2 3]) + (assert-eq (core.identity "abc") "abc") + (assert-eq (core.identity f) f) + (assert-eq (core.identity a) a))) (deftest sequence-predicates (testing "some" - (assert-not (pcall some)) - (assert-not (pcall some pos-int?)) - (assert-is (some pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) - (assert-not (some pos-int? {:a 1})) - (assert-is (some pos-int? [{:a 1} "1" -1 1]))) + (assert-not (pcall core.some)) + (assert-not (pcall core.some core.pos-int?)) + (assert-is (core.some core.pos-int? [-1 1.1 2.3 -55 42 10 -27])) + (assert-not (core.some core.pos-int? {:a 1})) + (assert-is (core.some core.pos-int? [{:a 1} "1" -1 1]))) (testing "not-any?" - (assert-not (pcall not-any?)) - (assert-not (pcall not-any? pos-int?)) - (assert-is (not-any? pos-int? [-1 1.1 2.3 -5.5 -42 -10 -27])) - (assert-is (not-any? pos-int? {:a 1})) - (assert-not (not-any? pos-int? [1 2 3 4 5]))) + (assert-not (pcall core.not-any?)) + (assert-not (pcall core.not-any? core.pos-int?)) + (assert-is (core.not-any? core.pos-int? [-1 1.1 2.3 -55 -42 -10 -27])) + (assert-is (core.not-any? core.pos-int? {:a 1})) + (assert-not (core.not-any? core.pos-int? [1 2 3 4 5]))) (testing "every?" - (assert-not (pcall every?)) - (assert-not (pcall every? pos-int?)) - (assert-not (every? pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) - (assert-not (every? pos-int? {:a 1})) - (assert-is (every? pos-int? [1 2 3 4 5]))) + (assert-not (pcall core.every?)) + (assert-not (pcall core.every? core.pos-int?)) + (assert-not (core.every? core.pos-int? [-1 1.1 2.3 -55 42 10 -27])) + (assert-not (core.every? core.pos-int? {:a 1})) + (assert-is (core.every? core.pos-int? [1 2 3 4 5]))) (testing "empty?" - (assert-not (pcall empty?)) - (assert-is (empty? [])) - (assert-is (empty? {})) - (assert-is (empty? "")) - (assert-not (empty? "1")) - (assert-not (empty? [1])) - (assert-not (empty? {:a 1})) - (assert-not (pcall empty? 10))) + (assert-not (pcall core.empty?)) + (assert-is (core.empty? [])) + (assert-is (core.empty? {})) + (assert-is (core.empty? "")) + (assert-not (core.empty? "1")) + (assert-not (core.empty? [1])) + (assert-not (core.empty? {:a 1})) + (assert-not (pcall core.empty? 10))) (testing "not-empty" - (assert-not (pcall not-empty)) - (assert-eq (not-empty []) nil) - (assert-eq (not-empty {}) nil) - (assert-eq (not-empty "") nil) - (assert-eq (not-empty "1") "1") - (assert-eq (not-empty [1]) [1]) - (assert-eq (not-empty {:a 1}) {:a 1}))) + (assert-not (pcall core.not-empty)) + (assert-eq (core.not-empty []) nil) + (assert-eq (core.not-empty {}) nil) + (assert-eq (core.not-empty "") nil) + (assert-eq (core.not-empty "1") "1") + (assert-eq (core.not-empty [1]) [1]) + (assert-eq (core.not-empty {:a 1}) {:a 1}))) (deftest math-functions (testing "inc" - (assert-eq (inc 1) 2) - (assert-eq (inc -1) 0) - (assert-not (pcall inc)) - (assert-not (pcall inc nil))) + (assert-eq (core.inc 1) 2) + (assert-eq (core.inc -1) 0) + (assert-not (pcall core.inc)) + (assert-not (pcall core.inc nil))) (testing "dec" - (assert-eq (dec 1) 0) - (assert-eq (dec -1) -2) - (assert-not (pcall dec)) - (assert-not (pcall dec nil)))) + (assert-eq (core.dec 1) 0) + (assert-eq (core.dec -1) -2) + (assert-not (pcall core.dec)) + (assert-not (pcall core.dec nil)))) (deftest table-access (testing "get" - (assert-eq (get {:key1 10 :key2 20} :key1) 10) - (assert-eq (get {:key1 10 :key2 20} :key1 false) 10) - (assert-eq (get {:key1 10 :key2 20} :key3 false) false) - (assert-eq (get {:key1 10 :key2 20} :key3) nil) - (assert-not (pcall get)) - (assert-not (pcall get {}))) + (assert-eq (core.get {:key1 10 :key2 20} :key1) 10) + (assert-eq (core.get {:key1 10 :key2 20} :key1 false) 10) + (assert-eq (core.get {:key1 10 :key2 20} :key3 false) false) + (assert-eq (core.get {:key1 10 :key2 20} :key3) nil) + (assert-not (pcall core.get)) + (assert-not (pcall core.get {}))) (testing "get-in" (local t {:a {:b {:c 10}}}) - (assert-eq (get-in t [:a]) {:b {:c 10}}) - (assert-eq (get-in t [:a :b]) {:c 10}) - (assert-eq (get-in t [:a :b :c]) 10) - (assert-eq (get-in t [:a :b :c] false) 10) - (assert-eq (get-in t [:a :b :d] false) false) - (assert-eq (get-in t [:a :b :d]) nil) - (assert-eq (get-in t []) t) - (assert-not (pcall get-in)) - (assert-not (pcall get-in {})))) + (assert-eq (core.get-in t [:a]) {:b {:c 10}}) + (assert-eq (core.get-in t [:a :b]) {:c 10}) + (assert-eq (core.get-in t [:a :b :c]) 10) + (assert-eq (core.get-in t [:a :b :c] false) 10) + (assert-eq (core.get-in t [:a :b :d] false) false) + (assert-eq (core.get-in t [:a :b :d]) nil) + (assert-eq (core.get-in t []) t) + (assert-not (pcall core.get-in)) + (assert-not (pcall core.get-in {})))) (deftest methods (testing "methods" - (defmulti f identity) + (defmulti f core.identity) (defmethod f :a [_] :a) (defmethod f :b [_] :b) (defmethod f :c [x] (* x x)) - (assert-eq (methods f) f) - (assert-not (pcall methods)) - (assert-not (pcall methods [])) - (assert-not (pcall methods f f))) + (assert-eq (core.methods f) f) + (assert-not (pcall core.methods)) + (assert-not (pcall core.methods [])) + (assert-not (pcall core.methods f f))) (testing "get-method" - (defmulti f identity) + (defmulti f core.identity) (defmethod f :a [_] :a) (defmethod f :b [_] :b) (defmethod f :c [x] (* x x)) - (assert-eq ((get-method f :a) 10) :a) - (assert-eq ((get-method f :b) 20) :b) - (assert-eq ((get-method f :c) 4) 16) - (assert-not (pcall get-method)) - (assert-not (pcall get-method [])) - (assert-not (pcall get-method [] :a)) - (assert-not (pcall get-method f)) - (assert-not (pcall get-method f :a :b))) + (assert-eq ((core.get-method f :a) 10) :a) + (assert-eq ((core.get-method f :b) 20) :b) + (assert-eq ((core.get-method f :c) 4) 16) + (assert-not (pcall core.get-method)) + (assert-not (pcall core.get-method [])) + (assert-not (pcall core.get-method [] :a)) + (assert-not (pcall core.get-method f)) + (assert-not (pcall core.get-method f :a :b))) (testing "remove-method" - (defmulti f identity) + (defmulti f core.identity) (defmethod f :a [_] :a) (defmethod f :b [_] :b) - (remove-method f :a) - (assert-eq (get-method f :a) nil) + (core.remove-method f :a) + (assert-eq (core.get-method f :a) nil) (defmethod f :default [_] :default) - (assert-eq (get-method f :a) (get-method f :default)) - (assert-not (pcall remove-method)) - (assert-not (pcall remove-method [])) - (assert-not (pcall remove-method [] :a)) - (assert-not (pcall remove-method f)) - (assert-not (pcall remove-method f :a :b))) + (assert-eq (core.get-method f :a) (core.get-method f :default)) + (assert-not (pcall core.remove-method)) + (assert-not (pcall core.remove-method [])) + (assert-not (pcall core.remove-method [] :a)) + (assert-not (pcall core.remove-method f)) + (assert-not (pcall core.remove-method f :a :b))) (testing "remove-all-methods" - (defmulti f identity) + (defmulti f core.identity) (defmethod f :a [_] :a) (defmethod f :b [_] :b) (defmethod f :default [_] :default) - (remove-all-methods f) - (assert-eq (methods f) {}) - (assert-not (pcall remove-all-methods)) - (assert-not (pcall remove-all-methods [])) - (assert-not (pcall remove-all-methods f f)))) + (core.remove-all-methods f) + (assert-eq (core.methods f) {}) + (assert-not (pcall core.remove-all-methods)) + (assert-not (pcall core.remove-all-methods [])) + (assert-not (pcall core.remove-all-methods f f)))) (deftest math-functions - (testing "add" - (assert-eq (add) 0) - (assert-eq (add 1) 1) - (assert-eq (add -1) -1) - (assert-eq (add 1 2) 3) - (assert-eq (add 1 2 3) 6) - (assert-eq (add 1 2 3 4) 10) - (assert-eq (add 1 2 3 4 5) 15)) + (testing "core.add" + (assert-eq (core.add) 0) + (assert-eq (core.add 1) 1) + (assert-eq (core.add -1) -1) + (assert-eq (core.add 1 2) 3) + (assert-eq (core.add 1 2 3) 6) + (assert-eq (core.add 1 2 3 4) 10) + (assert-eq (core.add 1 2 3 4 5) 15)) (testing "sub" - (assert-eq (sub) 0) - (assert-eq (sub 1) -1) - (assert-eq (sub -1) 1) - (assert-eq (sub 1 2) -1) - (assert-eq (sub 1 2 3) -4) - (assert-eq (sub 1 2 3 4) -8) - (assert-eq (sub 1 2 3 4 5) -13)) + (assert-eq (core.sub) 0) + (assert-eq (core.sub 1) -1) + (assert-eq (core.sub -1) 1) + (assert-eq (core.sub 1 2) -1) + (assert-eq (core.sub 1 2 3) -4) + (assert-eq (core.sub 1 2 3 4) -8) + (assert-eq (core.sub 1 2 3 4 5) -13)) (testing "mul" - (assert-eq (mul) 1) - (assert-eq (mul 1) 1) - (assert-eq (mul -1) -1) - (assert-eq (mul 1 2) 2) - (assert-eq (mul 1 2 3) 6) - (assert-eq (mul 1 2 3 4) 24) - (assert-eq (mul 1 2 3 4 5) 120)) + (assert-eq (core.mul) 1) + (assert-eq (core.mul 1) 1) + (assert-eq (core.mul -1) -1) + (assert-eq (core.mul 1 2) 2) + (assert-eq (core.mul 1 2 3) 6) + (assert-eq (core.mul 1 2 3 4) 24) + (assert-eq (core.mul 1 2 3 4 5) 120)) (testing "div" - (assert-not (pcall div)) - (assert-eq (div 1) 1) - (assert-eq (div -1) -1) - (assert-eq (div 1 2) (/ 1 2)) - (assert-eq (div 1 2 3) (/ 1 2 3)) - (assert-eq (div 1 2 3 4) (/ 1 2 3 4)) - (assert-eq (div 1 2 3 4 5) (/ 1 2 3 4 5)))) + (assert-not (pcall core.div)) + (assert-eq (core.div 1) 1) + (assert-eq (core.div -1) -1) + (assert-eq (core.div 1 2) (/ 1 2)) + (assert-eq (core.div 1 2 3) (/ 1 2 3)) + (assert-eq (core.div 1 2 3 4) (/ 1 2 3 4)) + (assert-eq (core.div 1 2 3 4 5) (/ 1 2 3 4 5)))) (deftest comparison-functions (testing "le" - (assert-not (pcall le)) - (assert-is (le 1)) - (assert-is (le 1 2)) - (assert-is (le 1 2 2)) - (assert-is (le 1 2 3 4)) - (assert-not (le 2 1)) - (assert-not (le 2 1 3)) - (assert-not (le 1 2 4 3))) + (assert-not (pcall core.le)) + (assert-is (core.le 1)) + (assert-is (core.le 1 2)) + (assert-is (core.le 1 2 2)) + (assert-is (core.le 1 2 3 4)) + (assert-not (core.le 2 1)) + (assert-not (core.le 2 1 3)) + (assert-not (core.le 1 2 4 3))) (testing "lt" - (assert-not (pcall lt)) - (assert-is (lt 1)) - (assert-is (lt 1 2)) - (assert-is (lt 1 2 3)) - (assert-is (lt 1 2 3 4)) - (assert-not (lt 2 1)) - (assert-not (lt 2 1 3)) - (assert-not (lt 1 2 4 4))) + (assert-not (pcall core.lt)) + (assert-is (core.lt 1)) + (assert-is (core.lt 1 2)) + (assert-is (core.lt 1 2 3)) + (assert-is (core.lt 1 2 3 4)) + (assert-not (core.lt 2 1)) + (assert-not (core.lt 2 1 3)) + (assert-not (core.lt 1 2 4 4))) (testing "ge" - (assert-not (pcall ge)) - (assert-is (ge 2)) - (assert-is (ge 2 1)) - (assert-is (ge 3 3 2)) - (assert-is (ge 4 3 2 -1)) - (assert-not (ge 1 2)) - (assert-not (ge 2 1 3)) - (assert-not (ge 1 2 4 4))) + (assert-not (pcall core.ge)) + (assert-is (core.ge 2)) + (assert-is (core.ge 2 1)) + (assert-is (core.ge 3 3 2)) + (assert-is (core.ge 4 3 2 -1)) + (assert-not (core.ge 1 2)) + (assert-not (core.ge 2 1 3)) + (assert-not (core.ge 1 2 4 4))) (testing "gt" - (assert-not (pcall gt)) - (assert-is (gt 2)) - (assert-is (gt 2 1)) - (assert-is (gt 3 2 1)) - (assert-is (gt 4 3 2 -1)) - (assert-not (gt 1 2)) - (assert-not (gt 2 1 3)) - (assert-not (gt 1 2 4 4)))) + (assert-not (pcall core.gt)) + (assert-is (core.gt 2)) + (assert-is (core.gt 2 1)) + (assert-is (core.gt 3 2 1)) + (assert-is (core.gt 4 3 2 -1)) + (assert-not (core.gt 1 2)) + (assert-not (core.gt 2 1 3)) + (assert-not (core.gt 1 2 4 4)))) (deftest vector (testing "vector" - (assert-eq (vector) []) - (assert-eq (vector 1) [1]) - (assert-eq (vector 1 2 3) [1 2 3]) - (assert-eq (getmetatable (vector 1 2 3)) {:cljlib/type :seq}))) + (assert-eq (core.vector) []) + (assert-eq (core.vector 1) [1]) + (assert-eq (core.vector 1 2 3) [1 2 3]) + (assert-eq (getmetatable (core.vector 1 2 3)) {:cljlib/type :seq}))) (deftest hash-map (testing "hash-map" - (assert-not (pcall hash-map :a)) - (assert-eq (hash-map) {}) - (assert-eq (hash-map :a 1) {:a 1}) - (assert-eq (hash-map :a 1 :b 2 :c 3) {:a 1 :b 2 :c 3}) - (assert-eq (getmetatable (hash-map)) {:cljlib/type :table}))) + (assert-not (pcall core.hash-map :a)) + (assert-eq (core.hash-map) {}) + (assert-eq (core.hash-map :a 1) {:a 1}) + (assert-eq (core.hash-map :a 1 :b 2 :c 3) {:a 1 :b 2 :c 3}) + (assert-eq (getmetatable (core.hash-map)) {:cljlib/type :table}))) (deftest sets (testing "hash-set" - (let [h1 (hash-set [1] [1] [2] [3] [:a]) - h2 (hash-set [1] [2] [3] [:a])] - (assert-is (eq h1 h2))) + (let [h1 (core.hash-set [1] [1] [2] [3] [:a]) + h2 (core.hash-set [1] [2] [3] [:a])] + (assert-is (core.eq h1 h2))) - (let [h3 (hash-set [1] [1] [2] [3] [:a]) - h4 (hash-set [1] [1] [3] [:a])] - (assert-not (eq h3 h4))) + (let [h3 (core.hash-set [1] [1] [2] [3] [:a]) + h4 (core.hash-set [1] [1] [3] [:a])] + (assert-not (core.eq h3 h4))) - (assert-eq (. (hash-set [1]) [1]) [1]) - (assert-eq (. (hash-set [1]) [2]) nil) - (assert-eq ((hash-set [1]) [1]) [1]) - (assert-eq ((hash-set [1]) [2]) nil)) + (assert-eq (. (core.hash-set [1]) [1]) [1]) + (assert-eq (. (core.hash-set [1]) [2]) nil) + (assert-eq ((core.hash-set [1]) [1]) [1]) + (assert-eq ((core.hash-set [1]) [2]) nil)) (testing "ordered-set" - (let [o1 (ordered-set [1] [1] [2] [3] [:a]) - o2 (ordered-set [1] [2] [3] [:a])] + (let [o1 (core.ordered-set [1] [1] [2] [3] [:a]) + o2 (core.ordered-set [1] [2] [3] [:a])] (assert-eq o1 o2)) - (let [o3 (ordered-set [1] [1] [2] [3] [:a]) - o4 (ordered-set [2] [1] [1] [3] [:a])] + (let [o3 (core.ordered-set [1] [1] [2] [3] [:a]) + o4 (core.ordered-set [2] [1] [1] [3] [:a])] (assert-eq o3 o4)) - (assert-eq (. (ordered-set [1]) [1]) [1]) - (assert-eq ((ordered-set [1]) [1]) [1]) - (assert-eq (. (ordered-set [1]) [2]) nil) - (assert-eq ((ordered-set [1]) [2]) nil)) + (assert-eq (. (core.ordered-set [1]) [1]) [1]) + (assert-eq ((core.ordered-set [1]) [1]) [1]) + (assert-eq (. (core.ordered-set [1]) [2]) nil) + (assert-eq ((core.ordered-set [1]) [2]) nil)) (testing "set equality" - (let [o1 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) - h1 (hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] + (let [o1 (core.ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h1 (core.hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] (assert-eq o1 h1)) - (let [o2 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) - h2 (hash-set [1] [[-1 1] 1] [2] [3] [:a] :a 2)] + (let [o2 (core.ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h2 (core.hash-set [1] [[-1 1] 1] [2] [3] [:a] :a 2)] (assert-ne o2 h2)) - (let [o3 (ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) - h3 (hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] - (assert-eq (disj o3 [2]) (disj h3 [2])) - (assert-ne (disj o3 :a) h3) - (assert-eq (disj h3 :a) o3)) + (let [o3 (core.ordered-set [1] [[-1 0] 1] [2] [3] [:a] :a 2) + h3 (core.hash-set [1] [[-1 0] 1] [2] [3] [:a] :a 2)] + (assert-eq (core.disj o3 [2]) (core.disj h3 [2])) + (assert-ne (core.disj o3 :a) h3) + (assert-eq (core.disj h3 :a) o3)) - (let [o4 (ordered-set [1] [[-1 5] 1] [3] [:a] :a 2) - h4 (hash-set [1] [[-1 5] 1] [2] [3] [:a] :a 2)] - (assert-eq (conj o4 [2]) (conj (disj h4 [2]) [2])))) + (let [o4 (core.ordered-set [1] [[-1 5] 1] [3] [:a] :a 2) + h4 (core.hash-set [1] [[-1 5] 1] [2] [3] [:a] :a 2)] + (assert-eq (core.conj o4 [2]) (core.conj (core.disj h4 [2]) [2])))) (testing "empty sets" - (assert-eq (empty (ordered-set)) (ordered-set)) - (assert-eq (empty (ordered-set 1 2 3)) (ordered-set)) - (assert-eq (. (getmetatable (empty (ordered-set))) :cljlib/type ) :cljlib/ordered-set) + (assert-eq (empty (core.ordered-set)) (core.ordered-set)) + (assert-eq (empty (core.ordered-set 1 2 3)) (core.ordered-set)) + (assert-eq (. (getmetatable (empty (core.ordered-set))) :cljlib/type ) :cljlib/ordered-set) - (assert-eq (empty (hash-set)) (hash-set)) - (assert-eq (empty (hash-set 1 2 3)) (hash-set)) - (assert-eq (. (getmetatable (empty (hash-set))) :cljlib/type ) :cljlib/hash-set)) + (assert-eq (empty (core.hash-set)) (core.hash-set)) + (assert-eq (empty (core.hash-set 1 2 3)) (core.hash-set)) + (assert-eq (. (getmetatable (empty (core.hash-set))) :cljlib/type ) :cljlib/hash-set)) (testing "into sets" - (assert-eq (into (ordered-set) [1 2 3]) (ordered-set 1 2 3)) - (assert-eq (into (ordered-set) {:a 1 :b 2}) (ordered-set [:a 1] [:b 2])) - (assert-eq (into (ordered-set) "vaiv") (ordered-set "v" "a" "i" "v")) - (assert-eq (into (hash-set) [1 2 3]) (hash-set 1 2 3)) - (assert-eq (into (hash-set) {:a 1 :b 2}) (hash-set [:a 1] [:b 2])) - (assert-eq (into (hash-set) "vaiv") (hash-set "v" "a" "i" "v")))) + (assert-eq (into (core.ordered-set) [1 2 3]) (core.ordered-set 1 2 3)) + (assert-eq (into (core.ordered-set) {:a 1 :b 2}) (core.ordered-set [:a 1] [:b 2])) + (assert-eq (into (core.ordered-set) "vaiv") (core.ordered-set "v" "a" "i" "v")) + (assert-eq (into (core.hash-set) [1 2 3]) (core.hash-set 1 2 3)) + (assert-eq (into (core.hash-set) {:a 1 :b 2}) (core.hash-set [:a 1] [:b 2])) + (assert-eq (into (core.hash-set) "vaiv") (core.hash-set "v" "a" "i" "v"))) + + (testing "sets into tables" + (assert-eq (into [] (core.ordered-set 1 2 3)) [1 2 3]) + (assert-eq (into {} (core.ordered-set [:a 1] [:b 2])) {:a 1 :b 2}))) (deftest memoization (testing "memoize" @@ -801,10 +802,10 @@ (fn slow [x] (for [i 0 1000000] nil) x) - (assert-not (pcall memoize)) - (assert-not (pcall memoize slow 2)) + (assert-not (pcall core.memoize)) + (assert-not (pcall core.memoize slow 2)) - (local fast (memoize slow)) + (local fast (core.memoize slow)) (let [(res1 time1) (time (fast 42)) (res2 time2) (time (fast 42))] @@ -813,5 +814,5 @@ (let [(res1 time1) (time (fast [10])) (res2 time2) (time (fast [10]))] - (assert-is (and (eq res1 res2 [10]))) + (assert-is (and (core.eq res1 res2 [10]))) (assert-is (< time2 time1))))) diff --git a/tests/fn.fnl b/tests/fn.fnl index 4381a60..63a5802 100644 --- a/tests/fn.fnl +++ b/tests/fn.fnl @@ -1,5 +1,5 @@ (require-macros :tests.test) -(require-macros :cljlib-macros) +(require-macros :macros) (deftest fn* (testing "fn* meta" @@ -7,7 +7,12 @@ "docstring" [x] x) (assert-eq (meta f) (when-meta {:fnl/docstring "docstring" - :fnl/arglist ["[x]"]})) + :fnl/arglist ["([x])"]})) + (fn* f + "docstring" + []) + (assert-eq (meta f) (when-meta {:fnl/docstring "docstring" + :fnl/arglist ["([])"]})) (fn* f "docstring" @@ -20,8 +25,16 @@ ([x] x) ([x y] (+ x y))) (assert-eq (meta f) (when-meta {:fnl/docstring "docstring" - :fnl/arglist ["\n ([x])" - "\n ([x y])"]})) + :fnl/arglist ["([x])" + "([x y])"]})) + + (fn* f + "docstring" + ([]) + ([x y] (+ x y))) + (assert-eq (meta f) (when-meta {:fnl/docstring "docstring" + :fnl/arglist ["([])" + "([x y])"]})) (fn* f "docstring" @@ -29,6 +42,6 @@ ([x y] (+ x y)) ([x y & z] (+ x y))) (assert-eq (meta f) (when-meta {:fnl/docstring "docstring" - :fnl/arglist ["\n ([x])" - "\n ([x y])" - "\n ([x y & z])"]})))) + :fnl/arglist ["([x])" + "([x y])" + "([x y & z])"]})))) diff --git a/tests/macros.fnl b/tests/macros.fnl index e387eb2..c3b54c9 100644 --- a/tests/macros.fnl +++ b/tests/macros.fnl @@ -1,5 +1,5 @@ (require-macros :tests.test) -(require-macros :cljlib-macros) +(require-macros :macros) (deftest into (testing "into" @@ -55,9 +55,9 @@ (let [a {} b []] (assert-eq (into a "vaiv") ["v" "a" "i" "v"]) - (assert-eq (into b "ваыв") ["в" "а" "ы" "в"])) + (when _G.utf8 (assert-eq (into b "ваыв") ["в" "а" "ы" "в"]))) (assert-eq (into [] "vaiv") ["v" "a" "i" "v"]) - (assert-eq (into [] "ваыв") ["в" "а" "ы" "в"]))) + (when _G.utf8 (assert-eq (into [] "ваыв") ["в" "а" "ы" "в"])))) (deftest let-variants (testing "when-let" @@ -89,7 +89,7 @@ (defmulti fac (fn [x] x)) (defmethod fac 0 [_] 1) (defmethod fac :default [x] (* x (fac (- x 1)))) - (assert-eq (fac 42) 7538058755741581312)) + (assert-eq (fac 4) 24)) (testing "defmulti keys" (defmulti send-data (fn [protocol data] protocol)) @@ -212,13 +212,13 @@ (assert-eq (try (+ 1 2 3 nil) (catch _) (finally 10)) nil)) (testing "catch-all" (assert-eq (try - (error 10) - (catch _ :pass)) - :pass) + (error "10") + (catch _ :pass)) + :pass) (assert-eq (try - (error 10) - (catch err err)) - 10)) + (error [10]) + (catch err err)) + [10])) (testing "finally" (let [tbl []] (try diff --git a/tests/test.fnl b/tests/test.fnl index f3db701..143b749 100644 --- a/tests/test.fnl +++ b/tests/test.fnl @@ -14,12 +14,12 @@ the tables uses tables as keys." ;; (eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}}) ;; we have to do even deeper search (setmetatable right# {:__index (fn [tbl# key#] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#)}) + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)}) (var [res# count-a# count-b#] [true 0 0]) (each [k# v# (pairs left#)] (set res# (eq# v# (. right# k#))) @@ -62,26 +62,26 @@ runtime error: equality assertion failed ```" `(let [left# ,expr1 right# ,expr2 - (res# view#) (pcall require :fennelview) eq# ,(eq-fn) - tostr# (if res# view# tostring)] + fennel# (require :fennel)] (assert (eq# left# right#) - (or ,msg (.. "equality assertion failed - Left: " (tostr# left#) " - Right: " (tostr# right#) "\n"))))) + (or ,msg (.. "assertion failed for expression: +(= " ,(view expr1 {:one-line? true}) " " ,(view expr2 {:one-line? true}) " + Left: " (fennel#.view left# {:one-line? true}) " + Right: " (fennel#.view right# {:one-line? true}) "\n"))))) (fn test.assert-ne [expr1 expr2 msg] "Assert for unequality. Same as [`assert-eq`](#assert-eq)." `(let [left# ,expr1 right# ,expr2 - (res# view#) (pcall require :fennelview) eq# ,(eq-fn) - tostr# (if res# view# tostring)] + fennel# (require :fennel)] (assert (not (eq# left# right#)) - (or ,msg (.. "unequality assertion failed - Left: " (tostr# left#) " - Right: " (tostr# right#) "\n"))))) + (or ,msg (.. "assertion failed for expression: +(not= " ,(view expr1 {:one-line? true}) " " ,(view expr2 {:one-line? true}) " + Left: " (fennel#.view left# {:one-line? true}) " + Right: " (fennel#.view right# {:one-line? true}) "\n"))))) (fn test.assert-is [expr msg] @@ -92,13 +92,15 @@ runtime error: equality assertion failed >> (assert-is (= 1 2 3)) runtime error: assertion failed for (= 1 2 3) ```" - `(assert ,expr (.. "assertion failed for " - (or ,msg ,(tostring expr))))) + `(assert ,expr + (.. "assertion failed for " + (or ,msg ,(view expr {:one-line? true}))))) (fn test.assert-not [expr msg] "Assert for not truth. Works the same as [`assert-is`](#assert-is)." - `(assert (not ,expr) (.. "assertion failed for " - (or ,msg ,(tostring expr))))) + `(assert (not ,expr) + (.. "assertion failed for " + (or ,msg ,(view expr {:one-line? true}))))) (fn test.deftest [name ...] @@ -108,7 +110,7 @@ runtime error: assertion failed for (= 1 2 3) (fn test.testing [description ...] "Print test description and run it." - `(do (io.stderr:write (.. "testing: " ,description "\n")) + `(do (io.stdout:write (.. "testing: " ,description "\n")) ,...)) (doto test -- cgit v1.2.3