From 7f66c54f4c9753b94dbf46ec50b8b16549daf324 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 1 Dec 2016 11:00:44 -0400 Subject: - Collected the Lux compiler's repo, the Standard Library's, the Leiningen plugin's and the Emacs mode's into a big monorepo, to keep development unified. --- stdlib/README.md | 15 + stdlib/license.txt | 374 ++ stdlib/project.clj | 19 + stdlib/source/lux.lux | 5541 +++++++++++++++++++++++++ stdlib/source/lux/cli.lux | 271 ++ stdlib/source/lux/codata/cont.lux | 64 + stdlib/source/lux/codata/env.lux | 65 + stdlib/source/lux/codata/function.lux | 23 + stdlib/source/lux/codata/io.lux | 56 + stdlib/source/lux/codata/state.lux | 114 + stdlib/source/lux/codata/struct/stream.lux | 135 + stdlib/source/lux/compiler.lux | 559 +++ stdlib/source/lux/concurrency/actor.lux | 278 ++ stdlib/source/lux/concurrency/atom.lux | 41 + stdlib/source/lux/concurrency/frp.lux | 194 + stdlib/source/lux/concurrency/promise.lux | 233 ++ stdlib/source/lux/concurrency/stm.lux | 237 ++ stdlib/source/lux/control/applicative.lux | 33 + stdlib/source/lux/control/bounded.lux | 14 + stdlib/source/lux/control/codec.lux | 28 + stdlib/source/lux/control/comonad.lux | 54 + stdlib/source/lux/control/effect.lux | 315 ++ stdlib/source/lux/control/enum.lux | 24 + stdlib/source/lux/control/eq.lux | 29 + stdlib/source/lux/control/fold.lux | 12 + stdlib/source/lux/control/functor.lux | 16 + stdlib/source/lux/control/hash.lux | 15 + stdlib/source/lux/control/monad.lux | 142 + stdlib/source/lux/control/monoid.lux | 13 + stdlib/source/lux/control/number.lux | 22 + stdlib/source/lux/control/ord.lux | 44 + stdlib/source/lux/data/bit.lux | 66 + stdlib/source/lux/data/bool.lux | 47 + stdlib/source/lux/data/char.lux | 107 + stdlib/source/lux/data/error.lux | 66 + stdlib/source/lux/data/error/exception.lux | 62 + stdlib/source/lux/data/format/json.lux | 1031 +++++ stdlib/source/lux/data/ident.lux | 57 + stdlib/source/lux/data/identity.lux | 37 + stdlib/source/lux/data/log.lux | 62 + stdlib/source/lux/data/maybe.lux | 82 + stdlib/source/lux/data/number.lux | 222 + stdlib/source/lux/data/product.lux | 35 + stdlib/source/lux/data/struct/array.lux | 224 + stdlib/source/lux/data/struct/dict.lux | 675 +++ stdlib/source/lux/data/struct/list.lux | 487 +++ stdlib/source/lux/data/struct/queue.lux | 79 + stdlib/source/lux/data/struct/set.lux | 85 + stdlib/source/lux/data/struct/stack.lux | 47 + stdlib/source/lux/data/struct/tree.lux | 54 + stdlib/source/lux/data/struct/vector.lux | 428 ++ stdlib/source/lux/data/struct/zipper.lux | 196 + stdlib/source/lux/data/sum.lux | 45 + stdlib/source/lux/data/text.lux | 223 + stdlib/source/lux/data/text/format.lux | 54 + stdlib/source/lux/host.lux | 2137 ++++++++++ stdlib/source/lux/lexer.lux | 439 ++ stdlib/source/lux/macro.lux | 31 + stdlib/source/lux/macro/ast.lux | 149 + stdlib/source/lux/macro/poly.lux | 364 ++ stdlib/source/lux/macro/poly/eq.lux | 103 + stdlib/source/lux/macro/poly/functor.lux | 126 + stdlib/source/lux/macro/poly/text-encoder.lux | 126 + stdlib/source/lux/macro/syntax.lux | 472 +++ stdlib/source/lux/macro/syntax/common.lux | 164 + stdlib/source/lux/macro/template.lux | 54 + stdlib/source/lux/math.lux | 158 + stdlib/source/lux/math/complex.lux | 291 ++ stdlib/source/lux/math/random.lux | 283 ++ stdlib/source/lux/math/ratio.lux | 141 + stdlib/source/lux/pipe.lux | 147 + stdlib/source/lux/regex.lux | 432 ++ stdlib/source/lux/test.lux | 330 ++ stdlib/source/lux/type.lux | 275 ++ stdlib/source/lux/type/auto.lux | 211 + stdlib/source/lux/type/check.lux | 518 +++ stdlib/test/test/lux.lux | 164 + stdlib/test/test/lux/cli.lux | 84 + stdlib/test/test/lux/codata/env.lux | 23 + stdlib/test/test/lux/codata/io.lux | 21 + stdlib/test/test/lux/codata/state.lux | 34 + stdlib/test/test/lux/codata/struct/stream.lux | 68 + stdlib/test/test/lux/concurrency/actor.lux | 70 + stdlib/test/test/lux/concurrency/frp.lux | 54 + stdlib/test/test/lux/concurrency/promise.lux | 31 + stdlib/test/test/lux/concurrency/stm.lux | 57 + stdlib/test/test/lux/data/bit.lux | 65 + stdlib/test/test/lux/data/bool.lux | 38 + stdlib/test/test/lux/data/char.lux | 47 + stdlib/test/test/lux/data/error.lux | 42 + stdlib/test/test/lux/data/format/json.lux | 314 ++ stdlib/test/test/lux/data/ident.lux | 53 + stdlib/test/test/lux/data/identity.lux | 36 + stdlib/test/test/lux/data/log.lux | 32 + stdlib/test/test/lux/data/maybe.lux | 49 + stdlib/test/test/lux/data/number.lux | 135 + stdlib/test/test/lux/data/product.lux | 20 + stdlib/test/test/lux/data/struct/array.lux | 130 + stdlib/test/test/lux/data/struct/dict.lux | 136 + stdlib/test/test/lux/data/struct/list.lux | 191 + stdlib/test/test/lux/data/struct/queue.lux | 54 + stdlib/test/test/lux/data/struct/set.lux | 67 + stdlib/test/test/lux/data/struct/stack.lux | 47 + stdlib/test/test/lux/data/struct/tree.lux | 39 + stdlib/test/test/lux/data/struct/vector.lux | 84 + stdlib/test/test/lux/data/struct/zipper.lux | 127 + stdlib/test/test/lux/data/sum.lux | 32 + stdlib/test/test/lux/data/text.lux | 150 + stdlib/test/test/lux/data/text/format.lux | 22 + stdlib/test/test/lux/host.lux | 54 + stdlib/test/test/lux/lexer.lux | 133 + stdlib/test/test/lux/macro/ast.lux | 31 + stdlib/test/test/lux/macro/syntax.lux | 176 + stdlib/test/test/lux/math.lux | 45 + stdlib/test/test/lux/pipe.lux | 47 + stdlib/test/test/lux/regex.lux | 200 + stdlib/test/test/lux/type.lux | 41 + stdlib/test/tests.lux | 84 + 118 files changed, 23729 insertions(+) create mode 100644 stdlib/README.md create mode 100644 stdlib/license.txt create mode 100644 stdlib/project.clj create mode 100644 stdlib/source/lux.lux create mode 100644 stdlib/source/lux/cli.lux create mode 100644 stdlib/source/lux/codata/cont.lux create mode 100644 stdlib/source/lux/codata/env.lux create mode 100644 stdlib/source/lux/codata/function.lux create mode 100644 stdlib/source/lux/codata/io.lux create mode 100644 stdlib/source/lux/codata/state.lux create mode 100644 stdlib/source/lux/codata/struct/stream.lux create mode 100644 stdlib/source/lux/compiler.lux create mode 100644 stdlib/source/lux/concurrency/actor.lux create mode 100644 stdlib/source/lux/concurrency/atom.lux create mode 100644 stdlib/source/lux/concurrency/frp.lux create mode 100644 stdlib/source/lux/concurrency/promise.lux create mode 100644 stdlib/source/lux/concurrency/stm.lux create mode 100644 stdlib/source/lux/control/applicative.lux create mode 100644 stdlib/source/lux/control/bounded.lux create mode 100644 stdlib/source/lux/control/codec.lux create mode 100644 stdlib/source/lux/control/comonad.lux create mode 100644 stdlib/source/lux/control/effect.lux create mode 100644 stdlib/source/lux/control/enum.lux create mode 100644 stdlib/source/lux/control/eq.lux create mode 100644 stdlib/source/lux/control/fold.lux create mode 100644 stdlib/source/lux/control/functor.lux create mode 100644 stdlib/source/lux/control/hash.lux create mode 100644 stdlib/source/lux/control/monad.lux create mode 100644 stdlib/source/lux/control/monoid.lux create mode 100644 stdlib/source/lux/control/number.lux create mode 100644 stdlib/source/lux/control/ord.lux create mode 100644 stdlib/source/lux/data/bit.lux create mode 100644 stdlib/source/lux/data/bool.lux create mode 100644 stdlib/source/lux/data/char.lux create mode 100644 stdlib/source/lux/data/error.lux create mode 100644 stdlib/source/lux/data/error/exception.lux create mode 100644 stdlib/source/lux/data/format/json.lux create mode 100644 stdlib/source/lux/data/ident.lux create mode 100644 stdlib/source/lux/data/identity.lux create mode 100644 stdlib/source/lux/data/log.lux create mode 100644 stdlib/source/lux/data/maybe.lux create mode 100644 stdlib/source/lux/data/number.lux create mode 100644 stdlib/source/lux/data/product.lux create mode 100644 stdlib/source/lux/data/struct/array.lux create mode 100644 stdlib/source/lux/data/struct/dict.lux create mode 100644 stdlib/source/lux/data/struct/list.lux create mode 100644 stdlib/source/lux/data/struct/queue.lux create mode 100644 stdlib/source/lux/data/struct/set.lux create mode 100644 stdlib/source/lux/data/struct/stack.lux create mode 100644 stdlib/source/lux/data/struct/tree.lux create mode 100644 stdlib/source/lux/data/struct/vector.lux create mode 100644 stdlib/source/lux/data/struct/zipper.lux create mode 100644 stdlib/source/lux/data/sum.lux create mode 100644 stdlib/source/lux/data/text.lux create mode 100644 stdlib/source/lux/data/text/format.lux create mode 100644 stdlib/source/lux/host.lux create mode 100644 stdlib/source/lux/lexer.lux create mode 100644 stdlib/source/lux/macro.lux create mode 100644 stdlib/source/lux/macro/ast.lux create mode 100644 stdlib/source/lux/macro/poly.lux create mode 100644 stdlib/source/lux/macro/poly/eq.lux create mode 100644 stdlib/source/lux/macro/poly/functor.lux create mode 100644 stdlib/source/lux/macro/poly/text-encoder.lux create mode 100644 stdlib/source/lux/macro/syntax.lux create mode 100644 stdlib/source/lux/macro/syntax/common.lux create mode 100644 stdlib/source/lux/macro/template.lux create mode 100644 stdlib/source/lux/math.lux create mode 100644 stdlib/source/lux/math/complex.lux create mode 100644 stdlib/source/lux/math/random.lux create mode 100644 stdlib/source/lux/math/ratio.lux create mode 100644 stdlib/source/lux/pipe.lux create mode 100644 stdlib/source/lux/regex.lux create mode 100644 stdlib/source/lux/test.lux create mode 100644 stdlib/source/lux/type.lux create mode 100644 stdlib/source/lux/type/auto.lux create mode 100644 stdlib/source/lux/type/check.lux create mode 100644 stdlib/test/test/lux.lux create mode 100644 stdlib/test/test/lux/cli.lux create mode 100644 stdlib/test/test/lux/codata/env.lux create mode 100644 stdlib/test/test/lux/codata/io.lux create mode 100644 stdlib/test/test/lux/codata/state.lux create mode 100644 stdlib/test/test/lux/codata/struct/stream.lux create mode 100644 stdlib/test/test/lux/concurrency/actor.lux create mode 100644 stdlib/test/test/lux/concurrency/frp.lux create mode 100644 stdlib/test/test/lux/concurrency/promise.lux create mode 100644 stdlib/test/test/lux/concurrency/stm.lux create mode 100644 stdlib/test/test/lux/data/bit.lux create mode 100644 stdlib/test/test/lux/data/bool.lux create mode 100644 stdlib/test/test/lux/data/char.lux create mode 100644 stdlib/test/test/lux/data/error.lux create mode 100644 stdlib/test/test/lux/data/format/json.lux create mode 100644 stdlib/test/test/lux/data/ident.lux create mode 100644 stdlib/test/test/lux/data/identity.lux create mode 100644 stdlib/test/test/lux/data/log.lux create mode 100644 stdlib/test/test/lux/data/maybe.lux create mode 100644 stdlib/test/test/lux/data/number.lux create mode 100644 stdlib/test/test/lux/data/product.lux create mode 100644 stdlib/test/test/lux/data/struct/array.lux create mode 100644 stdlib/test/test/lux/data/struct/dict.lux create mode 100644 stdlib/test/test/lux/data/struct/list.lux create mode 100644 stdlib/test/test/lux/data/struct/queue.lux create mode 100644 stdlib/test/test/lux/data/struct/set.lux create mode 100644 stdlib/test/test/lux/data/struct/stack.lux create mode 100644 stdlib/test/test/lux/data/struct/tree.lux create mode 100644 stdlib/test/test/lux/data/struct/vector.lux create mode 100644 stdlib/test/test/lux/data/struct/zipper.lux create mode 100644 stdlib/test/test/lux/data/sum.lux create mode 100644 stdlib/test/test/lux/data/text.lux create mode 100644 stdlib/test/test/lux/data/text/format.lux create mode 100644 stdlib/test/test/lux/host.lux create mode 100644 stdlib/test/test/lux/lexer.lux create mode 100644 stdlib/test/test/lux/macro/ast.lux create mode 100644 stdlib/test/test/lux/macro/syntax.lux create mode 100644 stdlib/test/test/lux/math.lux create mode 100644 stdlib/test/test/lux/pipe.lux create mode 100644 stdlib/test/test/lux/regex.lux create mode 100644 stdlib/test/test/lux/type.lux create mode 100644 stdlib/test/tests.lux (limited to 'stdlib') diff --git a/stdlib/README.md b/stdlib/README.md new file mode 100644 index 000000000..454228d07 --- /dev/null +++ b/stdlib/README.md @@ -0,0 +1,15 @@ +# stdlib +Standard library for the Lux family of programming languages. + +### How do I get it? + +Just add this to your Leiningen dependencies when building Lux programs: +``` +[com.github.luxlang/lux-stdlib "0.3.3"] +``` + +You can find the Leiningen plugin for Lux over here: https://github.com/LuxLang/lux-lein + +### How do I use it? + +You can see what's available here: https://github.com/LuxLang/lux/wiki/Standard-Library diff --git a/stdlib/license.txt b/stdlib/license.txt new file mode 100644 index 000000000..52d135112 --- /dev/null +++ b/stdlib/license.txt @@ -0,0 +1,374 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. + diff --git a/stdlib/project.clj b/stdlib/project.clj new file mode 100644 index 000000000..287a2f803 --- /dev/null +++ b/stdlib/project.clj @@ -0,0 +1,19 @@ +(defproject com.github.luxlang/lux-stdlib "0.5.0-SNAPSHOT" + :description "Standard library for the Lux programming language." + :url "https://github.com/LuxLang/stdlib" + :license {:name "Mozilla Public License (Version 2.0)" + :url "https://www.mozilla.org/en-US/MPL/2.0/"} + :plugins [[com.github.luxlang/lein-luxc "0.5.0-SNAPSHOT"]] + :deploy-repositories [["releases" {:url "https://oss.sonatype.org/service/local/staging/deploy/maven2/" + :creds :gpg}] + ["snapshots" {:url "https://oss.sonatype.org/content/repositories/snapshots/" + :creds :gpg}]] + :pom-addition [:developers [:developer + [:name "Eduardo Julian"] + [:url "https://github.com/eduardoejp"]]] + :repositories [["snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"] + ["releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]] + :source-paths ["source"] + :test-paths ["test"] + :lux {:tests "tests"} + ) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux new file mode 100644 index 000000000..2b66cdbe1 --- /dev/null +++ b/stdlib/source/lux.lux @@ -0,0 +1,5541 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +## Basic types +(_lux_def Bool + (+12 ["lux" "Bool"] + (+0 "java.lang.Boolean" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Nat + (+12 ["lux" "Nat"] + (+0 "#Nat" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Int + (+12 ["lux" "Int"] + (+0 "java.lang.Long" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Real + (+12 ["lux" "Real"] + (+0 "java.lang.Double" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Frac + (+12 ["lux" "Frac"] + (+0 "#Frac" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Char + (+12 ["lux" "Char"] + (+0 "java.lang.Character" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Text + (+12 ["lux" "Text"] + (+0 "java.lang.String" (+0))) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Void + (+12 ["lux" "Void"] + (+1)) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Unit + (+12 ["lux" "Unit"] + (+2)) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +(_lux_def Ident + (+12 ["lux" "Ident"] + (+4 Text Text)) + (+1 [["lux" "type?"] (+0 true)] (+1 [["lux" "export?"] (+0 true)] (+0)))) + +## (type: (List a) +## #Nil +## (#Cons a (List a))) +(_lux_def List + (+12 ["lux" "List"] + (+9 (+0) + (+3 ## "lux;Nil" + (+2) + ## "lux;Cons" + (+4 (+6 +1) + (+11 (+6 +0) (+6 +1)))))) + (+1 [["lux" "type?"] (+0 true)] + (+1 [["lux" "export?"] (+0 true)] + (+1 [["lux" "tags"] (+8 (+1 (+6 "Nil") (+1 (+6 "Cons") (+0))))] + (+1 [["lux" "type-args"] (+8 (+1 (+6 "a") (+0)))] + (+0)))))) + +## (type: (Maybe a) +## #None +## (#Some a)) +(_lux_def Maybe + (+12 ["lux" "Maybe"] + (+9 (+0) + (+3 ## "lux;None" + (+2) + ## "lux;Some" + (+6 +1)))) + (#Cons [["lux" "type?"] (+0 true)] + (#Cons [["lux" "export?"] (+0 true)] + (#Cons [["lux" "tags"] (+8 (#Cons (+6 "None") (#Cons (+6 "Some") #Nil)))] + (#Cons [["lux" "type-args"] (+8 (#Cons (+6 "a") #Nil))] + #Nil))))) + +## (type: #rec Type +## (#HostT Text (List Type)) +## #VoidT +## #UnitT +## (#SumT Type Type) +## (#ProdT Type Type) +## (#LambdaT Type Type) +## (#BoundT Nat) +## (#VarT Nat) +## (#ExT Nat) +## (#UnivQ (List Type) Type) +## (#ExQ (List Type) Type) +## (#AppT Type Type) +## (#NamedT Ident Type) +## ) +(_lux_def Type + (+12 ["lux" "Type"] + (_lux_case (+11 (+6 +0) (+6 +1)) + Type + (_lux_case (+11 List Type) + TypeList + (_lux_case (+4 Type Type) + TypePair + (+11 (+9 (+0) + (+3 ## "lux;HostT" + (+4 Text TypeList) + (+3 ## "lux;VoidT" + (+2) + (+3 ## "lux;UnitT" + (+2) + (+3 ## "lux;SumT" + TypePair + (+3 ## "lux;ProdT" + TypePair + (+3 ## "lux;LambdaT" + TypePair + (+3 ## "lux;BoundT" + Nat + (+3 ## "lux;VarT" + Nat + (+3 ## "lux;ExT" + Nat + (+3 ## "lux;UnivQ" + (+4 TypeList Type) + (+3 ## "lux;ExQ" + (+4 TypeList Type) + (+3 ## "lux;AppT" + TypePair + ## "lux;NamedT" + (+4 Ident Type)))))))))))))) + Void))))) + (#Cons [["lux" "type?"] (+0 true)] + (#Cons [["lux" "export?"] (+0 true)] + (#Cons [["lux" "tags"] (+8 (#Cons (+6 "HostT") + (#Cons (+6 "VoidT") + (#Cons (+6 "UnitT") + (#Cons (+6 "SumT") + (#Cons (+6 "ProdT") + (#Cons (+6 "LambdaT") + (#Cons (+6 "BoundT") + (#Cons (+6 "VarT") + (#Cons (+6 "ExT") + (#Cons (+6 "UnivQ") + (#Cons (+6 "ExQ") + (#Cons (+6 "AppT") + (#Cons (+6 "NamedT") + #Nil))))))))))))))] + (#Cons [["lux" "doc"] (+6 "This type represents the data-structures that are used to specify types themselves.")] + (#Cons [["lux" "type-rec?"] (+0 true)] + #Nil)))))) + +## (type: Top +## (Ex [a] a)) +(_lux_def Top + (#NamedT ["lux" "Top"] + (#ExQ (+0) (#BoundT +1))) + (#Cons [["lux" "type?"] (+0 true)] + (#Cons [["lux" "export?"] (+0 true)] + (#Cons [["lux" "doc"] (+6 "The type of things whose type doesn't matter. + It can be used to write functions or data-structures that can take, or return anything.")] + #Nil)))) + +## (type: Bottom +## (All [a] a)) +(_lux_def Bottom + (#NamedT ["lux" "Bottom"] + (#UnivQ (+0) (#BoundT +1))) + (#Cons [["lux" "type?"] (+0 true)] + (#Cons [["lux" "export?"] (+0 true)] + (#Cons [["lux" "doc"] (+6 "The type of things whose type is unknown or undefined. + Useful for expressions that cause errors or other \"extraordinary\" conditions.")] + #Nil)))) + +## (type: #rec Ann-Value +## (#BoolM Bool) +## (#NatM Nat) +## (#IntM Int) +## (#FracM Frac) +## (#RealM Real) +## (#CharM Char) +## (#TextM Text) +## (#IdentM Ident) +## (#ListM (List Ann-Value)) +## (#DictM (List [Text Ann-Value]))) +(_lux_def Ann-Value + (#NamedT ["lux" "Ann-Value"] + (_lux_case (#AppT (#BoundT +0) (#BoundT +1)) + Ann-Value + (#AppT (#UnivQ #Nil + (#SumT ## #BoolM + Bool + (#SumT ## #NatM + Nat + (#SumT ## #IntM + Int + (#SumT ## #FracM + Frac + (#SumT ## #RealM + Real + (#SumT ## #CharM + Char + (#SumT ## #TextM + Text + (#SumT ## #IdentM + Ident + (#SumT ## #ListM + (#AppT List Ann-Value) + ## #DictM + (#AppT List (#ProdT Text Ann-Value))))))))))) + ) + Void) + )) + (#Cons [["lux" "type?"] (+0 true)] + (#Cons [["lux" "export?"] (+0 true)] + (#Cons [["lux" "tags"] (+8 (#Cons (+6 "BoolM") + (#Cons (+6 "NatM") + (#Cons (+6 "IntM") + (#Cons (+6 "FracM") + (#Cons (+6 "RealM") + (#Cons (+6 "CharM") + (#Cons (+6 "TextM") + (#Cons (+6 "IdentM") + (#Cons (+6 "ListM") + (#Cons (+6 "DictM") + #Nil)))))))))))] + (#Cons [["lux" "type-rec?"] (+0 true)] + #Nil))))) + +## (type: Anns +## (List [Ident Ann-Value])) +(_lux_def Anns + (#NamedT ["lux" "Anns"] + (#AppT List (#ProdT Ident Ann-Value))) + (#Cons [["lux" "type?"] (#BoolM true)] + (#Cons [["lux" "export?"] (#BoolM true)] + #Nil))) + +(_lux_def default-def-meta-exported + (_lux_: Anns + (#Cons [["lux" "type?"] (#BoolM true)] + (#Cons [["lux" "export?"] (#BoolM true)] + #Nil))) + #Nil) + +(_lux_def default-def-meta-unexported + (_lux_: Anns + (#Cons [["lux" "type?"] (#BoolM true)] + #Nil)) + #Nil) + +## (type: Def +## [Type Anns Unit]) +(_lux_def Def + (#NamedT ["lux" "Def"] + (#ProdT Type (#ProdT Anns Unit))) + default-def-meta-exported) + +## (type: (Bindings k v) +## {#counter Nat +## #mappings (List [k v])}) +(_lux_def Bindings + (#NamedT ["lux" "Bindings"] + (#UnivQ #Nil + (#UnivQ #Nil + (#ProdT ## "lux;counter" + Nat + ## "lux;mappings" + (#AppT List + (#ProdT (#BoundT +3) + (#BoundT +1))))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "counter") + (#Cons (#TextM "mappings") + #Nil)))] + (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "k") (#Cons (#TextM "v") #;Nil)))] + default-def-meta-exported))) + +## (type: Cursor +## {#module Text +## #line Int +## #column Int}) +(_lux_def Cursor + (#NamedT ["lux" "Cursor"] + (#ProdT Text (#ProdT Int Int))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "module") + (#Cons (#TextM "line") + (#Cons (#TextM "column") + #Nil))))] + (#Cons [["lux" "doc"] (#TextM "Cursors are for specifying the location of AST nodes in Lux files during compilation.")] + default-def-meta-exported))) + +## (type: (Meta m v) +## {#meta m +## #datum v}) +(_lux_def Meta + (#NamedT ["lux" "Meta"] + (#UnivQ #Nil + (#UnivQ #Nil + (#ProdT (#BoundT +3) + (#BoundT +1))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "meta") + (#Cons (#TextM "datum") + #Nil)))] + (#Cons [["lux" "doc"] (#TextM "The type of things that can have meta-data of arbitrary types.")] + (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "m") (#Cons (#TextM "v") #;Nil)))] + default-def-meta-exported)))) + +(_lux_def Analysis + (#NamedT ["lux" "Analysis"] + (#AppT (#AppT Meta + (#ProdT Type Cursor)) + Void)) + default-def-meta-exported) + +## (type: Scope +## {#name (List Text) +## #inner-closures Int +## #locals (Bindings Text Analysis) +## #closure (Bindings Text Analysis)}) +(_lux_def Scope + (#NamedT ["lux" "Scope"] + (#ProdT ## "lux;name" + (#AppT List Text) + (#ProdT ## "lux;inner-closures" + Int + (#ProdT ## "lux;locals" + (#AppT (#AppT Bindings Text) Analysis) + ## "lux;closure" + (#AppT (#AppT Bindings Text) Analysis))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "name") + (#Cons (#TextM "inner-closures") + (#Cons (#TextM "locals") + (#Cons (#TextM "closure") + #Nil)))))] + default-def-meta-exported)) + +## (type: (AST' w) +## (#BoolS Bool) +## (#NatS Nat) +## (#IntS Int) +## (#FracS Frac) +## (#RealS Real) +## (#CharS Char) +## (#TextS Text) +## (#SymbolS Text Text) +## (#TagS Text Text) +## (#FormS (List (w (AST' w)))) +## (#TupleS (List (w (AST' w)))) +## (#RecordS (List [(w (AST' w)) (w (AST' w))]))) +(_lux_def AST' + (#NamedT ["lux" "AST'"] + (_lux_case (#AppT (#BoundT +1) + (#AppT (#BoundT +0) + (#BoundT +1))) + AST + (_lux_case (#AppT [List AST]) + ASTList + (#UnivQ #Nil + (#SumT ## "lux;BoolS" + Bool + (#SumT ## "lux;NatS" + Nat + (#SumT ## "lux;IntS" + Int + (#SumT ## "lux;FracS" + Frac + (#SumT ## "lux;RealS" + Real + (#SumT ## "lux;CharS" + Char + (#SumT ## "lux;TextS" + Text + (#SumT ## "lux;SymbolS" + Ident + (#SumT ## "lux;TagS" + Ident + (#SumT ## "lux;FormS" + ASTList + (#SumT ## "lux;TupleS" + ASTList + ## "lux;RecordS" + (#AppT List (#ProdT AST AST)) + ))))))))))) + )))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "BoolS") + (#Cons (#TextM "NatS") + (#Cons (#TextM "IntS") + (#Cons (#TextM "FracS") + (#Cons (#TextM "RealS") + (#Cons (#TextM "CharS") + (#Cons (#TextM "TextS") + (#Cons (#TextM "SymbolS") + (#Cons (#TextM "TagS") + (#Cons (#TextM "FormS") + (#Cons (#TextM "TupleS") + (#Cons (#TextM "RecordS") + #Nil)))))))))))))] + (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "w") #;Nil))] + default-def-meta-exported))) + +## (type: AST +## (Meta Cursor (AST' (Meta Cursor)))) +(_lux_def AST + (#NamedT ["lux" "AST"] + (_lux_case (#AppT Meta Cursor) + w + (#AppT w (#AppT AST' w)))) + (#Cons [["lux" "doc"] (#TextM "The type of AST nodes for Lux syntax.")] + default-def-meta-exported)) + +(_lux_def ASTList + (#AppT List AST) + default-def-meta-unexported) + +## (type: (Either l r) +## (#Left l) +## (#Right r)) +(_lux_def Either + (#NamedT ["lux" "Either"] + (#UnivQ #Nil + (#UnivQ #Nil + (#SumT ## "lux;Left" + (#BoundT +3) + ## "lux;Right" + (#BoundT +1))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "Left") + (#Cons (#TextM "Right") + #Nil)))] + (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "l") (#Cons (#TextM "r") #;Nil)))] + default-def-meta-exported))) + +## (type: Source +## (List (Meta Cursor Text))) +(_lux_def Source + (#NamedT ["lux" "Source"] + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])])) + default-def-meta-exported) + +## (type: Module +## {#module-hash Int +## #module-aliases (List [Text Text]) +## #defs (List [Text Def]) +## #imports (List Text) +## #tags (List [Text [Nat (List Ident) Bool Type]]) +## #types (List [Text [(List Ident) Bool Type]])} +## #module-anns Anns +## ) +(_lux_def Module + (#NamedT ["lux" "Module"] + (#ProdT ## "lux;module-hash" + Int + (#ProdT ## "lux;module-aliases" + (#AppT List (#ProdT Text Text)) + (#ProdT ## "lux;defs" + (#AppT List (#ProdT Text + Def)) + (#ProdT ## "lux;imports" + (#AppT List Text) + (#ProdT ## "lux;tags" + (#AppT List + (#ProdT Text + (#ProdT Nat + (#ProdT (#AppT List Ident) + (#ProdT Bool + Type))))) + (#ProdT ## "lux;types" + (#AppT List + (#ProdT Text + (#ProdT (#AppT List Ident) + (#ProdT Bool + Type)))) + ## "lux;module-anns" + Anns) + )))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "module-hash") + (#Cons (#TextM "module-aliases") + (#Cons (#TextM "defs") + (#Cons (#TextM "imports") + (#Cons (#TextM "tags") + (#Cons (#TextM "types") + (#Cons (#TextM "module-anns") + #Nil))))))))] + default-def-meta-exported)) + +## (type: CompilerMode +## #Release +## #Debug +## #Eval +## #REPL) +(_lux_def CompilerMode + (#NamedT ["lux" "CompilerMode"] + (#SumT ## "lux;Release" + #UnitT + (#SumT ## "lux;Debug" + #UnitT + (#SumT ## "lux;Eval" + #UnitT + ## "lux;REPL" + #UnitT)))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "Release") + (#Cons (#TextM "Debug") + (#Cons (#TextM "Eval") + (#Cons (#TextM "REPL") + #Nil)))))] + default-def-meta-exported)) + +## (type: CompilerInfo +## {#compiler-name Text +## #compiler-version Text +## #compiler-mode CompilerMode}) +(_lux_def CompilerInfo + (#NamedT ["lux" "CompilerInfo"] + (#ProdT ## "lux;compiler-name" + Text + (#ProdT ## "lux;compiler-version" + Text + ## "lux;compiler-mode" + CompilerMode))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "compiler-name") + (#Cons (#TextM "compiler-version") + (#Cons (#TextM "compiler-mode") + #Nil))))] + default-def-meta-exported)) + +## (type: Compiler +## {#info CompilerInfo +## #source Source +## #cursor Cursor +## #modules (List [Text Module]) +## #scopes (List Scope) +## #type-vars (Bindings Nat (Maybe Type)) +## #expected (Maybe Type) +## #seed Nat +## #scope-type-vars (List Nat) +## #host Void}) +(_lux_def Compiler + (#NamedT ["lux" "Compiler"] + (#ProdT ## "lux;info" + CompilerInfo + (#ProdT ## "lux;source" + Source + (#ProdT ## "lux;cursor" + Cursor + (#ProdT ## "lux;modules" + (#AppT List (#ProdT Text + Module)) + (#ProdT ## "lux;scopes" + (#AppT List Scope) + (#ProdT ## "lux;type-vars" + (#AppT (#AppT Bindings Nat) (#AppT Maybe Type)) + (#ProdT ## "lux;expected" + (#AppT Maybe Type) + (#ProdT ## "lux;seed" + Nat + (#ProdT ## "lux;scope-type-vars" + (#AppT List Nat) + ## "lux;host" + Void)))))))))) + (#Cons [["lux" "tags"] (#ListM (#Cons (#TextM "info") + (#Cons (#TextM "source") + (#Cons (#TextM "cursor") + (#Cons (#TextM "modules") + (#Cons (#TextM "scopes") + (#Cons (#TextM "type-vars") + (#Cons (#TextM "expected") + (#Cons (#TextM "seed") + (#Cons (#TextM "scope-type-vars") + (#Cons (#TextM "host") + #Nil)))))))))))] + (#Cons [["lux" "doc"] (#TextM "Represents the state of the Lux compiler during a run. + It's provided to macros during their invocation, so they can access compiler data. + + Caveat emptor: Avoid fiddling with it, unless you know what you're doing.")] + default-def-meta-exported))) + +## (type: (Lux a) +## (-> Compiler (Either Text [Compiler a]))) +(_lux_def Lux + (#NamedT ["lux" "Lux"] + (#UnivQ #Nil + (#LambdaT Compiler + (#AppT (#AppT Either Text) + (#ProdT Compiler (#BoundT +1)))))) + (#Cons [["lux" "doc"] (#TextM "Computations that can have access to the state of the compiler. + Those computations may also fail, or modify the state of the compiler.")] + (#Cons [["lux" "type-args"] (#ListM (#Cons (#TextM "a") #;Nil))] + default-def-meta-exported))) + +## (type: Macro +## (-> (List AST) (Lux (List AST)))) +(_lux_def Macro + (#NamedT ["lux" "Macro"] + (#LambdaT ASTList (#AppT Lux ASTList))) + default-def-meta-exported) + +## Base functions & macros +## (def: _cursor +## Cursor +## ["" -1 -1]) +(_lux_def _cursor + (_lux_: Cursor ["" -1 -1]) + #Nil) + +## (def: (_meta data) +## (-> (AST' (Meta Cursor)) AST) +## [["" -1 -1] data]) +(_lux_def _meta + (_lux_: (#LambdaT (#AppT AST' + (#AppT Meta Cursor)) + AST) + (_lux_lambda _ data + [_cursor data])) + #Nil) + +## (def: (return x) +## (All [a] +## (-> a Compiler +## (Either Text [Compiler a]))) +## ...) +(_lux_def return + (_lux_: (#UnivQ #Nil + (#LambdaT (#BoundT +1) + (#LambdaT Compiler + (#AppT (#AppT Either Text) + (#ProdT Compiler + (#BoundT +1)))))) + (_lux_lambda _ val + (_lux_lambda _ state + (#Right state val)))) + #Nil) + +## (def: (fail msg) +## (All [a] +## (-> Text Compiler +## (Either Text [Compiler a]))) +## ...) +(_lux_def fail + (_lux_: (#UnivQ #Nil + (#LambdaT Text + (#LambdaT Compiler + (#AppT (#AppT Either Text) + (#ProdT Compiler + (#BoundT +1)))))) + (_lux_lambda _ msg + (_lux_lambda _ state + (#Left msg)))) + #Nil) + +(_lux_def bool$ + (_lux_: (#LambdaT Bool AST) + (_lux_lambda _ value (_meta (#BoolS value)))) + #Nil) + +(_lux_def nat$ + (_lux_: (#LambdaT Nat AST) + (_lux_lambda _ value (_meta (#NatS value)))) + #Nil) + +(_lux_def int$ + (_lux_: (#LambdaT Int AST) + (_lux_lambda _ value (_meta (#IntS value)))) + #Nil) + +(_lux_def frac$ + (_lux_: (#LambdaT Frac AST) + (_lux_lambda _ value (_meta (#FracS value)))) + #Nil) + +(_lux_def real$ + (_lux_: (#LambdaT Real AST) + (_lux_lambda _ value (_meta (#RealS value)))) + #Nil) + +(_lux_def char$ + (_lux_: (#LambdaT Char AST) + (_lux_lambda _ value (_meta (#CharS value)))) + #Nil) + +(_lux_def text$ + (_lux_: (#LambdaT Text AST) + (_lux_lambda _ text (_meta (#TextS text)))) + #Nil) + +(_lux_def symbol$ + (_lux_: (#LambdaT Ident AST) + (_lux_lambda _ ident (_meta (#SymbolS ident)))) + #Nil) + +(_lux_def tag$ + (_lux_: (#LambdaT Ident AST) + (_lux_lambda _ ident (_meta (#TagS ident)))) + #Nil) + +(_lux_def form$ + (_lux_: (#LambdaT (#AppT List AST) AST) + (_lux_lambda _ tokens (_meta (#FormS tokens)))) + #Nil) + +(_lux_def tuple$ + (_lux_: (#LambdaT (#AppT List AST) AST) + (_lux_lambda _ tokens (_meta (#TupleS tokens)))) + #Nil) + +(_lux_def record$ + (_lux_: (#LambdaT (#AppT List (#ProdT AST AST)) AST) + (_lux_lambda _ tokens (_meta (#RecordS tokens)))) + #Nil) + +(_lux_def default-macro-meta + (_lux_: Anns + (#Cons [["lux" "macro?"] (#BoolM true)] + #Nil)) + #Nil) + +(_lux_def let'' + (_lux_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons lhs (#Cons rhs (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["" "_lux_case"]) + (#Cons rhs (#Cons lhs (#Cons body #Nil))))) + #Nil)) + + _ + (fail "Wrong syntax for let''")))) + default-macro-meta) + +(_lux_def lambda'' + (_lux_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)) + (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) + (#Cons (_meta (#SymbolS "" "")) + (#Cons arg + (#Cons (_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''")) + (#Cons (_meta (#TupleS args')) + (#Cons body #Nil)))))) + #Nil)))))) + #Nil)) + + (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))) + (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) + (#Cons (_meta (#SymbolS "" self)) + (#Cons arg + (#Cons (_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''")) + (#Cons (_meta (#TupleS args')) + (#Cons body #Nil)))))) + #Nil)))))) + #Nil)) + + _ + (fail "Wrong syntax for lambda''")))) + default-macro-meta) + +(_lux_def export?-meta + (_lux_: AST + (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "export?") #Nil])])) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(bool$ true) + #Nil])])) + #Nil])]))) + #Nil) + +(_lux_def hidden?-meta + (_lux_: AST + (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "hidden?") #Nil])])) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(bool$ true) + #Nil])])) + #Nil])]))) + #Nil) + +(_lux_def macro?-meta + (_lux_: AST + (tuple$ (#Cons [(tuple$ (#Cons [(text$ "lux") (#Cons [(text$ "macro?") #Nil])])) + (#Cons [(form$ (#Cons [(tag$ ["lux" "BoolM"]) + (#Cons [(bool$ true) + #Nil])])) + #Nil])]))) + #Nil) + +(_lux_def with-export-meta + (_lux_: (#LambdaT AST AST) + (lambda'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons export?-meta + (#Cons tail #Nil)))))) + #Nil) + +(_lux_def with-hidden-meta + (_lux_: (#LambdaT AST AST) + (lambda'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons hidden?-meta + (#Cons tail #Nil)))))) + #Nil) + +(_lux_def with-macro-meta + (_lux_: (#LambdaT AST AST) + (lambda'' [tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons macro?-meta + (#Cons tail #Nil)))))) + #Nil) + +(_lux_def def:'' + (_lux_: Macro + (lambda'' [tokens] + (_lux_case tokens + (#Cons [[_ (#TagS ["" "export"])] + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons (with-export-meta meta) #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons (with-export-meta meta) #Nil)])])]))) + #Nil])) + + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + (#Cons meta #Nil)])])]))) + #Nil])) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + (#Cons meta #Nil)])])]))) + #Nil])) + + _ + (fail "Wrong syntax for def''")) + )) + default-macro-meta) + +(def:'' (macro:' tokens) + default-macro-meta + Macro + (_lux_case tokens + (#Cons [_ (#FormS (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + ))) + #Nil)) + + (#Cons [_ (#TagS ["" "export"])] (#Cons [_ (#FormS (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + (#Cons [_ (#TagS ["" "export"])] (#Cons [_ (#FormS (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "def:''"]) + (#Cons (tag$ ["" "export"]) + (#Cons (form$ (#Cons name args)) + (#Cons (with-macro-meta meta-data) + (#Cons (symbol$ ["lux" "Macro"]) + (#Cons body + #Nil))) + )))) + #Nil)) + + _ + (fail "Wrong syntax for macro:'"))) + +(macro:' #export (comment tokens) + (#Cons [["lux" "doc"] (#TextM "## Throws away any code given to it. + ## Great for commenting out code, while retaining syntax high-lightning and formatting in your text editor. + (comment 1 2 3 4)")] + #;Nil) + (return #Nil)) + +(macro:' ($' tokens) + (_lux_case tokens + (#Cons x #Nil) + (return tokens) + + (#Cons x (#Cons y xs)) + (return (#Cons (form$ (#Cons (symbol$ ["lux" "$'"]) + (#Cons (form$ (#Cons (tag$ ["lux" "AppT"]) + (#Cons x (#Cons y #Nil)))) + xs))) + #Nil)) + + _ + (fail "Wrong syntax for $'"))) + +(def:'' (map f xs) + #Nil + (#UnivQ #Nil + (#UnivQ #Nil + (#LambdaT (#LambdaT (#BoundT +3) (#BoundT +1)) + (#LambdaT ($' List (#BoundT +3)) + ($' List (#BoundT +1)))))) + (_lux_case xs + #Nil + #Nil + + (#Cons x xs') + (#Cons (f x) (map f xs')))) + +(def:'' RepEnv + #Nil + Type + ($' List (#ProdT Text AST))) + +(def:'' (make-env xs ys) + #Nil + (#LambdaT ($' List Text) (#LambdaT ($' List AST) RepEnv)) + (_lux_case [xs ys] + [(#Cons x xs') (#Cons y ys')] + (#Cons [x y] (make-env xs' ys')) + + _ + #Nil)) + +(def:'' (Text/= x y) + #Nil + (#LambdaT Text (#LambdaT Text Bool)) + (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [x y])) + +(def:'' (get-rep key env) + #Nil + (#LambdaT Text (#LambdaT RepEnv ($' Maybe AST))) + (_lux_case env + #Nil + #None + + (#Cons [k v] env') + (_lux_case (Text/= k key) + true + (#Some v) + + false + (get-rep key env')))) + +(def:'' (replace-syntax reps syntax) + #Nil + (#LambdaT RepEnv (#LambdaT AST AST)) + (_lux_case syntax + [_ (#SymbolS "" name)] + (_lux_case (get-rep name reps) + (#Some replacement) + replacement + + #None + syntax) + + [meta (#FormS parts)] + [meta (#FormS (map (replace-syntax reps) parts))] + + [meta (#TupleS members)] + [meta (#TupleS (map (replace-syntax reps) members))] + + [meta (#RecordS slots)] + [meta (#RecordS (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST)) + (lambda'' [slot] + (_lux_case slot + [k v] + [(replace-syntax reps k) (replace-syntax reps v)]))) + slots))] + + _ + syntax) + ) + +(def:'' (update-bounds ast) + #Nil + (#LambdaT AST AST) + (_lux_case ast + [_ (#TupleS members)] + (tuple$ (map update-bounds members)) + + [_ (#RecordS pairs)] + (record$ (map (_lux_: (#LambdaT (#ProdT AST AST) (#ProdT AST AST)) + (lambda'' [pair] + (let'' [name val] pair + [name (update-bounds val)]))) + pairs)) + + [_ (#FormS (#Cons [_ (#TagS "lux" "BoundT")] (#Cons [_ (#NatS idx)] #Nil)))] + (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (nat$ (_lux_proc ["nat" "+"] [+2 idx])) #Nil))) + + [_ (#FormS members)] + (form$ (map update-bounds members)) + + _ + ast)) + +(def:'' (parse-quantified-args args next) + #Nil + ## (-> (List AST) (-> (List Text) (Lux (List AST))) (Lux (List AST))) + (#LambdaT ($' List AST) + (#LambdaT (#LambdaT ($' List Text) (#AppT Lux ($' List AST))) + (#AppT Lux ($' List AST)) + )) + (_lux_case args + #Nil + (next #Nil) + + (#Cons [_ (#SymbolS "" arg-name)] args') + (parse-quantified-args args' (lambda'' [names] (next (#Cons arg-name names)))) + + _ + (fail "Expected symbol.") + )) + +(def:'' (make-bound idx) + #Nil + (#LambdaT Nat AST) + (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (nat$ idx) #Nil)))) + +(def:'' (fold f init xs) + #Nil + ## (All [a b] (-> (-> b a a) a (List b) a)) + (#UnivQ #Nil (#UnivQ #Nil (#LambdaT (#LambdaT (#BoundT +1) + (#LambdaT (#BoundT +3) + (#BoundT +3))) + (#LambdaT (#BoundT +3) + (#LambdaT ($' List (#BoundT +1)) + (#BoundT +3)))))) + (_lux_case xs + #Nil + init + + (#Cons x xs') + (fold f (f x init) xs'))) + +(def:'' (length list) + #Nil + (#UnivQ #Nil + (#LambdaT ($' List (#BoundT +1)) Int)) + (fold (lambda'' [_ acc] (_lux_proc ["jvm" "ladd"] [1 acc])) 0 list)) + +(macro:' #export (All tokens) + (#Cons [["lux" "doc"] (#TextM "## Universal quantification. + (All [a] + (-> a a)) + + ## A name can be provided, to specify a recursive type. + (All List [a] + (| Unit + [a (List a)]))")] + #;Nil) + (let'' [self-name tokens] (_lux_case tokens + (#Cons [_ (#SymbolS "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]) + (_lux_case tokens + (#Cons [_ (#TupleS args)] (#Cons body #Nil)) + (parse-quantified-args args + (lambda'' [names] + (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) + (lambda'' [name' body'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons (_lux_case [(Text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) + + _ + (fail "Wrong syntax for All")) + )) + +(macro:' #export (Ex tokens) + (#Cons [["lux" "doc"] (#TextM "## Existential quantification. + (Ex [a] + [(Codec Text a) + a]) + + ## A name can be provided, to specify a recursive type. + (Ex Self [a] + [(Codec Text a) + a + (List (Self a))])")] + #;Nil) + (let'' [self-name tokens] (_lux_case tokens + (#Cons [_ (#SymbolS "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens]) + (_lux_case tokens + (#Cons [_ (#TupleS args)] (#Cons body #Nil)) + (parse-quantified-args args + (lambda'' [names] + (let'' body' (fold (_lux_: (#LambdaT Text (#LambdaT AST AST)) + (lambda'' [name' body'] + (form$ (#Cons (tag$ ["lux" "ExQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound +1)] #Nil) + (update-bounds body')) #Nil)))))) + body + names) + (return (#Cons (_lux_case [(Text/= "" self-name) names] + [true _] + body' + + [_ #;Nil] + body' + + [false _] + (replace-syntax (#Cons [self-name (make-bound (_lux_proc ["nat" "*"] + [+2 (_lux_proc ["nat" "-"] + [(_lux_proc ["int" "to-nat"] + [(length names)]) + +1])]))] + #Nil) + body')) + #Nil))))) + + _ + (fail "Wrong syntax for Ex")) + )) + +(def:'' (reverse list) + #Nil + (All [a] (#LambdaT ($' List a) ($' List a))) + (fold (lambda'' [head tail] (#Cons head tail)) + #Nil + list)) + +(macro:' #export (-> tokens) + (#Cons [["lux" "doc"] (#TextM "## Function types: + (-> Int Int Int) + + ## This is the type of a function that takes 2 Ints and returns an Int.")] + #;Nil) + (_lux_case (reverse tokens) + (#Cons output inputs) + (return (#Cons (fold (_lux_: (#LambdaT AST (#LambdaT AST AST)) + (lambda'' [i o] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->"))) + +(macro:' #export (list xs) + (#Cons [["lux" "doc"] (#TextM "## List-construction macro. + (list 1 2 3)")] + #;Nil) + (return (#Cons (fold (lambda'' [head tail] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) + (tag$ ["lux" "Nil"]) + (reverse xs)) + #Nil))) + +(macro:' #export (list& xs) + (#Cons [["lux" "doc"] (#TextM "## List-construction macro, with the last element being a tail-list. + ## In other words, this macro prepends elements to another list. + (list& 1 2 3 (list 4 5 6))")] + #;Nil) + (_lux_case (reverse xs) + (#Cons last init) + (return (list (fold (lambda'' [head tail] + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) + last + init))) + + _ + (fail "Wrong syntax for list&"))) + +(macro:' #export (& tokens) + (#Cons [["lux" "doc"] (#TextM "## Tuple types: + (& Text Int Bool) + + ## The empty tuple, a.k.a. Unit. + (&)")] + #;Nil) + (_lux_case (reverse tokens) + #Nil + (return (list (tag$ ["lux" "UnitT"]))) + + (#Cons last prevs) + (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "ProdT"]) left right))) + last + prevs))) + )) + +(macro:' #export (| tokens) + (#Cons [["lux" "doc"] (#TextM "## Variant types: + (| Text Int Bool) + + ## The empty tuple, a.k.a. Void. + (|)")] + #;Nil) + (_lux_case (reverse tokens) + #Nil + (return (list (tag$ ["lux" "VoidT"]))) + + (#Cons last prevs) + (return (list (fold (lambda'' [left right] (form$ (list (tag$ ["lux" "SumT"]) left right))) + last + prevs))) + )) + +(macro:' (lambda' tokens) + (let'' [name tokens'] (_lux_case tokens + (#Cons [[_ (#SymbolS ["" name])] tokens']) + [name tokens'] + + _ + ["" tokens]) + (_lux_case tokens' + (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])]) + (_lux_case args + #Nil + (fail "lambda' requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list (form$ (list (symbol$ ["" "_lux_lambda"]) + (symbol$ ["" name]) + harg + (fold (lambda'' [arg body'] + (form$ (list (symbol$ ["" "_lux_lambda"]) + (symbol$ ["" ""]) + arg + body'))) + body + (reverse targs))))))) + + _ + (fail "Wrong syntax for lambda'")))) + +(macro:' (def:''' tokens) + (_lux_case tokens + (#Cons [[_ (#TagS ["" "export"])] + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (symbol$ ["" "_lux_def"]) + name + (form$ (list (symbol$ ["" "_lux_:"]) + type + (form$ (list (symbol$ ["lux" "lambda'"]) + name + (tuple$ args) + body)))) + (with-export-meta meta))))) + + (#Cons [[_ (#TagS ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) + (return (list (form$ (list (symbol$ ["" "_lux_def"]) + name + (form$ (list (symbol$ ["" "_lux_:"]) + type + body)) + (with-export-meta meta))))) + + (#Cons [[_ (#FormS (#Cons [name args]))] + (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (symbol$ ["" "_lux_def"]) + name + (form$ (list (symbol$ ["" "_lux_:"]) + type + (form$ (list (symbol$ ["lux" "lambda'"]) + name + (tuple$ args) + body)))) + meta)))) + + (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) + (return (list (form$ (list (symbol$ ["" "_lux_def"]) + name + (form$ (list (symbol$ ["" "_lux_:"]) type body)) + meta)))) + + _ + (fail "Wrong syntax for def'''") + )) + +(def:''' (as-pairs xs) + #Nil + (All [a] (-> ($' List a) ($' List (& a a)))) + (_lux_case xs + (#Cons x (#Cons y xs')) + (#Cons [x y] (as-pairs xs')) + + _ + #Nil)) + +(macro:' (let' tokens) + (_lux_case tokens + (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])]) + (return (list (fold (_lux_: (-> (& AST AST) AST + AST) + (lambda' [binding body] + (_lux_case binding + [label value] + (form$ (list (symbol$ ["" "_lux_case"]) value label body))))) + body + (reverse (as-pairs bindings))))) + + _ + (fail "Wrong syntax for let'"))) + +(def:''' (any? p xs) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + (_lux_case xs + #Nil + false + + (#Cons x xs') + (_lux_case (p x) + true true + false (any? p xs')))) + +(def:''' (spliced? token) + #Nil + (-> AST Bool) + (_lux_case token + [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [_ #Nil])]))] + true + + _ + false)) + +(def:''' (wrap-meta content) + #Nil + (-> AST AST) + (tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1))) + content))) + +(def:''' (untemplate-list tokens) + #Nil + (-> ($' List AST) AST) + (_lux_case tokens + #Nil + (_meta (#TagS ["lux" "Nil"])) + + (#Cons [token tokens']) + (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) token (untemplate-list tokens')))))) + +(def:''' (List/append xs ys) + #Nil + (All [a] (-> ($' List a) ($' List a) ($' List a))) + (_lux_case xs + (#Cons x xs') + (#Cons x (List/append xs' ys)) + + #Nil + ys)) + +(def:''' #export (splice-helper xs ys) + (#Cons [["lux" "hidden?"] (#BoolM true)] + #;Nil) + (-> ($' List AST) ($' List AST) ($' List AST)) + (_lux_case xs + (#Cons x xs') + (#Cons x (splice-helper xs' ys)) + + #Nil + ys)) + +(macro:' #export (_$ tokens) + (#Cons [["lux" "doc"] (#TextM "## Left-association for the application of binary functions over variadic arguments. + (_$ Text/append \"Hello, \" name \".\\nHow are you?\") + + ## => + (Text/append (Text/append \"Hello, \" name) \".\\nHow are you?\")")] + #;Nil) + (_lux_case tokens + (#Cons op tokens') + (_lux_case tokens' + (#Cons first nexts) + (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2))) + first + nexts))) + + _ + (fail "Wrong syntax for _$")) + + _ + (fail "Wrong syntax for _$"))) + +(macro:' #export ($_ tokens) + (#Cons [["lux" "doc"] (#TextM "## Right-association for the application of binary functions over variadic arguments. + ($_ Text/append \"Hello, \" name \".\\nHow are you?\") + + ## => + (Text/append \"Hello, \" (Text/append name \".\\nHow are you?\"))")] + #;Nil) + (_lux_case tokens + (#Cons op tokens') + (_lux_case (reverse tokens') + (#Cons last prevs) + (return (list (fold (lambda' [a1 a2] (form$ (list op a1 a2))) + last + prevs))) + + _ + (fail "Wrong syntax for $_")) + + _ + (fail "Wrong syntax for $_"))) + +## (sig: (Monad m) +## (: (All [a] (-> a (m a))) +## wrap) +## (: (All [a b] (-> (-> a (m b)) (m a) (m b))) +## bind)) +(def:''' Monad + (list& [["lux" "tags"] (#ListM (list (#TextM "wrap") (#TextM "bind")))] + default-def-meta-unexported) + Type + (#NamedT ["lux" "Monad"] + (All [m] + (& (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b))))))) + +(def:''' Monad + #Nil + ($' Monad Maybe) + {#wrap + (lambda' return [x] + (#Some x)) + + #bind + (lambda' [f ma] + (_lux_case ma + #None #None + (#Some a) (f a)))}) + +(def:''' Monad + #Nil + ($' Monad Lux) + {#wrap + (lambda' [x] + (lambda' [state] + (#Right state x))) + + #bind + (lambda' [f ma] + (lambda' [state] + (_lux_case (ma state) + (#Left msg) + (#Left msg) + + (#Right state' a) + (f a state'))))}) + +(macro:' (do tokens) + (_lux_case tokens + (#Cons monad (#Cons [_ (#TupleS bindings)] (#Cons body #Nil))) + (let' [g!wrap (symbol$ ["" "wrap"]) + g!bind (symbol$ ["" " bind "]) + body' (fold (_lux_: (-> (& AST AST) AST AST) + (lambda' [binding body'] + (let' [[var value] binding] + (_lux_case var + [_ (#TagS "" "let")] + (form$ (list (symbol$ ["lux" "let'"]) value body')) + + _ + (form$ (list g!bind + (form$ (list (symbol$ ["" "_lux_lambda"]) (symbol$ ["" ""]) var body')) + value)))))) + body + (reverse (as-pairs bindings)))] + (return (list (form$ (list (symbol$ ["" "_lux_case"]) + monad + (record$ (list [(tag$ ["lux" "wrap"]) g!wrap] [(tag$ ["lux" "bind"]) g!bind])) + body'))))) + + _ + (fail "Wrong syntax for do"))) + +(def:''' (mapM m f xs) + #Nil + ## (All [m a b] + ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) + (All [m a b] + (-> ($' Monad m) + (-> a ($' m b)) + ($' List a) + ($' m ($' List b)))) + (let' [{#;wrap wrap #;bind _} m] + (_lux_case xs + #Nil + (wrap #Nil) + + (#Cons x xs') + (do m + [y (f x) + ys (mapM m f xs')] + (wrap (#Cons y ys))) + ))) + +(macro:' #export (if tokens) + (list [["lux" "doc"] (#TextM "(if true + \"Oh, yeah!\" + \"Aw hell naw!\")")]) + (_lux_case tokens + (#Cons test (#Cons then (#Cons else #Nil))) + (return (list (form$ (list (symbol$ ["" "_lux_case"]) test + (bool$ true) then + (bool$ false) else)))) + + _ + (fail "Wrong syntax for if"))) + +(def:''' (get k plist) + #Nil + (All [a] + (-> Text ($' List (& Text a)) ($' Maybe a))) + (_lux_case plist + (#Cons [[k' v] plist']) + (if (Text/= k k') + (#Some v) + (get k plist')) + + #Nil + #None)) + +(def:''' (put k v dict) + #Nil + (All [a] + (-> Text a ($' List (& Text a)) ($' List (& Text a)))) + (_lux_case dict + #Nil + (list [k v]) + + (#Cons [[k' v'] dict']) + (if (Text/= k k') + (#Cons [[k' v] dict']) + (#Cons [[k' v'] (put k v dict')])))) + +(def:''' (Text/append x y) + #Nil + (-> Text Text Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.String:concat:java.lang.String"] [x y])) + +(def:''' (Ident->Text ident) + #Nil + (-> Ident Text) + (let' [[module name] ident] + (_lux_case module + "" name + _ ($_ Text/append module ";" name)))) + +(def:''' (get-meta tag def-meta) + #Nil + (-> Ident Anns ($' Maybe Ann-Value)) + (let' [[prefix name] tag] + (_lux_case def-meta + (#Cons [[prefix' name'] value] def-meta') + (_lux_case [(Text/= prefix prefix') + (Text/= name name')] + [true true] + (#Some value) + + _ + (get-meta tag def-meta')) + + #Nil + #None))) + +(def:''' (resolve-global-symbol ident state) + #Nil + (-> Ident ($' Lux Ident)) + (let' [[module name] ident + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (_lux_case (get module modules) + (#Some {#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _}) + (_lux_case (get name defs) + (#Some [def-type def-meta def-value]) + (_lux_case (get-meta ["lux" "alias"] def-meta) + (#Some (#IdentM real-name)) + (#Right [state real-name]) + + _ + (#Right [state ident])) + + #None + (#Left ($_ Text/append "Unknown definition: " (Ident->Text ident)))) + + #None + (#Left ($_ Text/append "Unknown module: " module " @ " (Ident->Text ident)))))) + +(def:''' (splice replace? untemplate tag elems) + #Nil + (-> Bool (-> AST ($' Lux AST)) AST ($' List AST) ($' Lux AST)) + (_lux_case replace? + true + (_lux_case (any? spliced? elems) + true + (do Monad + [elems' (_lux_: ($' Lux ($' List AST)) + (mapM Monad + (_lux_: (-> AST ($' Lux AST)) + (lambda' [elem] + (_lux_case elem + [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [spliced #Nil])]))] + (wrap spliced) + + _ + (do Monad + [=elem (untemplate elem)] + (wrap (form$ (list (symbol$ ["" "_lux_:"]) + (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"]))))) + (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list =elem (tag$ ["lux" "Nil"])))))))))))) + elems))] + (wrap (wrap-meta (form$ (list tag + (form$ (list& (symbol$ ["lux" "$_"]) + (symbol$ ["lux" "splice-helper"]) + elems'))))))) + + false + (do Monad + [=elems (mapM Monad untemplate elems)] + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems))))))) + false + (do Monad + [=elems (mapM Monad untemplate elems)] + (wrap (wrap-meta (form$ (list tag (untemplate-list =elems)))))))) + +(def:''' (untemplate replace? subst token) + #Nil + (-> Bool Text AST ($' Lux AST)) + (_lux_case [replace? token] + [_ [_ (#BoolS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (bool$ value))))) + + [_ [_ (#NatS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "NatS"]) (nat$ value))))) + + [_ [_ (#IntS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (int$ value))))) + + [_ [_ (#FracS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "FracS"]) (frac$ value))))) + + [_ [_ (#RealS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (real$ value))))) + + [_ [_ (#CharS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (char$ value))))) + + [_ [_ (#TextS value)]] + (return (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (text$ value))))) + + [false [_ (#TagS [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module) (text$ name))))))) + + [true [_ (#TagS [module name])]] + (let' [module' (_lux_case module + "" + subst + + _ + module)] + (return (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))) + + [true [_ (#SymbolS [module name])]] + (do Monad + [real-name (_lux_case module + "" + (if (Text/= "" subst) + (wrap [module name]) + (resolve-global-symbol [subst name])) + + _ + (wrap [module name])) + #let [[module name] real-name]] + (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name)))))))) + + [false [_ (#SymbolS [module name])]] + (return (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module) (text$ name))))))) + + [_ [_ (#TupleS elems)]] + (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems) + + [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~"])] (#Cons [unquoted #Nil])]))]] + (return unquoted) + + [true [_ (#FormS (#Cons [[_ (#SymbolS ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] + (untemplate false subst keep-quoted) + + [_ [meta (#FormS elems)]] + (do Monad + [output (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems) + #let [[_ form'] output]] + (return [meta form'])) + + [_ [_ (#RecordS fields)]] + (do Monad + [=fields (mapM Monad + (_lux_: (-> (& AST AST) ($' Lux AST)) + (lambda' [kv] + (let' [[k v] kv] + (do Monad + [=k (untemplate replace? subst k) + =v (untemplate replace? subst v)] + (wrap (tuple$ (list =k =v))))))) + fields)] + (wrap (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) (untemplate-list =fields)))))) + )) + +(macro:' #export (host tokens) + (list [["lux" "doc"] (#TextM "## Macro to treat host-types as Lux-types. + (host java.lang.Object) + + (host java.util.List [java.lang.Long])")]) + (_lux_case tokens + (#Cons [_ (#SymbolS "" class-name)] #Nil) + (return (list (form$ (list (tag$ ["lux" "HostT"]) (text$ class-name) (tag$ ["lux" "Nil"]))))) + + (#Cons [_ (#SymbolS "" class-name)] (#Cons [_ (#TupleS params)] #Nil)) + (return (list (form$ (list (tag$ ["lux" "HostT"]) (text$ class-name) (untemplate-list params))))) + + _ + (fail "Wrong syntax for host"))) + +(def:'' (current-module-name state) + #Nil + ($' Lux Text) + (_lux_case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + (_lux_case (reverse scopes) + (#Cons {#name (#;Cons module-name #Nil) #inner-closures _ #locals _ #closure _} _) + (#Right [state module-name]) + + _ + (#Left "Can't get the module name without a module!") + ))) + +(macro:' #export (` tokens) + (list [["lux" "doc"] (#TextM "## Hygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + ## All unprefixed macros will receive their parent module's prefix if imported; otherwise will receive the prefix of the module on which the quasi-quote is being used. + (` (def: (~ name) + (lambda [(~@ args)] + (~ body))))")]) + (_lux_case tokens + (#Cons template #Nil) + (do Monad + [current-module current-module-name + =template (untemplate true current-module template)] + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + + _ + (fail "Wrong syntax for `"))) + +(macro:' #export (`' tokens) + (list [["lux" "doc"] (#TextM "## Unhygienic quasi-quotation as a macro. Unquote (~) and unquote-splice (~@) must also be used as forms. + (`' (def: (~ name) + (lambda [(~@ args)] + (~ body))))")]) + (_lux_case tokens + (#Cons template #Nil) + (do Monad + [=template (untemplate true "" template)] + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + + _ + (fail "Wrong syntax for `"))) + +(macro:' #export (' tokens) + (list [["lux" "doc"] (#TextM "## Quotation as a macro. + (' \"YOLO\")")]) + (_lux_case tokens + (#Cons template #Nil) + (do Monad + [=template (untemplate false "" template)] + (wrap (list (form$ (list (symbol$ ["" "_lux_:"]) (symbol$ ["lux" "AST"]) =template))))) + + _ + (fail "Wrong syntax for '"))) + +(macro:' #export (|> tokens) + (list [["lux" "doc"] (#TextM "## Piping macro. + (|> elems (map ->Text) (interpose \" \") (fold Text/append \"\")) + + ## => + (fold Text/append \"\" + (interpose \" \" + (map ->Text elems)))")]) + (_lux_case tokens + (#Cons [init apps]) + (return (list (fold (_lux_: (-> AST AST AST) + (lambda' [app acc] + (_lux_case app + [_ (#TupleS parts)] + (tuple$ (List/append parts (list acc))) + + [_ (#FormS parts)] + (form$ (List/append parts (list acc))) + + _ + (` ((~ app) (~ acc)))))) + init + apps))) + + _ + (fail "Wrong syntax for |>"))) + +(macro:' #export (<| tokens) + (list [["lux" "doc"] (#TextM "## Reverse piping macro. + (<| (fold Text/append \"\") (interpose \" \") (map ->Text) elems) + + ## => + (fold Text/append \"\" + (interpose \" \" + (map ->Text elems)))")]) + (_lux_case (reverse tokens) + (#Cons [init apps]) + (return (list (fold (_lux_: (-> AST AST AST) + (lambda' [app acc] + (_lux_case app + [_ (#TupleS parts)] + (tuple$ (List/append parts (list acc))) + + [_ (#FormS parts)] + (form$ (List/append parts (list acc))) + + _ + (` ((~ app) (~ acc)))))) + init + apps))) + + _ + (fail "Wrong syntax for <|"))) + +(def:''' #export (. f g) + (list [["lux" "doc"] (#TextM "Function composition.")]) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (lambda' [x] (f (g x)))) + +(def:''' (get-ident x) + #Nil + (-> AST ($' Maybe Ident)) + (_lux_case x + [_ (#SymbolS sname)] + (#Some sname) + + _ + #None)) + +(def:''' (get-tag x) + #Nil + (-> AST ($' Maybe Ident)) + (_lux_case x + [_ (#TagS sname)] + (#Some sname) + + _ + #None)) + +(def:''' (get-name x) + #Nil + (-> AST ($' Maybe Text)) + (_lux_case x + [_ (#SymbolS "" sname)] + (#Some sname) + + _ + #None)) + +(def:''' (tuple->list tuple) + #Nil + (-> AST ($' Maybe ($' List AST))) + (_lux_case tuple + [_ (#TupleS members)] + (#Some members) + + _ + #None)) + +(def:''' (apply-template env template) + #Nil + (-> RepEnv AST AST) + (_lux_case template + [_ (#SymbolS "" sname)] + (_lux_case (get-rep sname env) + (#Some subst) + subst + + _ + template) + + [meta (#TupleS elems)] + [meta (#TupleS (map (apply-template env) elems))] + + [meta (#FormS elems)] + [meta (#FormS (map (apply-template env) elems))] + + [meta (#RecordS members)] + [meta (#RecordS (map (_lux_: (-> (& AST AST) (& AST AST)) + (lambda' [kv] + (let' [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members))] + + _ + template)) + +(def:''' (join-map f xs) + #Nil + (All [a b] + (-> (-> a ($' List b)) ($' List a) ($' List b))) + (_lux_case xs + #Nil + #Nil + + (#Cons [x xs']) + (List/append (f x) (join-map f xs')))) + +(def:''' (every? p xs) + #Nil + (All [a] + (-> (-> a Bool) ($' List a) Bool)) + (fold (lambda' [_2 _1] (if _1 (p _2) false)) true xs)) + +(def:''' (i= x y) + #Nil + (-> Int Int Bool) + (_lux_proc ["jvm" "leq"] [x y])) + +(def:''' (n= x y) + #Nil + (-> Nat Nat Bool) + (_lux_proc ["nat" "="] [x y])) + +(def:''' (->Text x) + #Nil + (-> (host java.lang.Object) Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x])) + +(macro:' #export (do-template tokens) + (list [["lux" "doc"] (#TextM "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. + (do-template [ ] + [(def: #export + (-> Int Int) + (+ ))] + + [inc 1] + [dec -1])")]) + (_lux_case tokens + (#Cons [[_ (#TupleS bindings)] (#Cons [[_ (#TupleS templates)] data])]) + (_lux_case [(mapM Monad get-name bindings) + (mapM Monad tuple->list data)] + [(#Some bindings') (#Some data')] + (let' [apply (_lux_: (-> RepEnv ($' List AST)) + (lambda' [env] (map (apply-template env) templates))) + num-bindings (length bindings')] + (if (every? (i= num-bindings) (map length data')) + (|> data' + (join-map (. apply (make-env bindings'))) + return) + (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (->Text num-bindings))))) + + _ + (fail "Wrong syntax for do-template")) + + _ + (fail "Wrong syntax for do-template"))) + + +(do-template [ ] + [(def:''' ( x y) + #Nil + (-> Bool) + (_lux_proc ["jvm" ] [x y]))] + + ## [i= "leq" Int] + [i> "lgt" Int] + [i< "llt" Int] + ) + +(do-template [ ] + [(def:''' ( x y) + #Nil + (-> Bool) + (if ( x y) + true + ( x y)))] + + [i>= i> i= Int] + [i<= i< i= Int] + ) + +(do-template [ ] + [(def:''' ( x y) + #Nil + (-> ) + (_lux_proc [x y]))] + + [i+ ["jvm" "ladd"] Int] + [i- ["jvm" "lsub"] Int] + [i* ["jvm" "lmul"] Int] + [i/ ["jvm" "ldiv"] Int] + [i% ["jvm" "lrem"] Int] + + [n+ ["nat" "+"] Nat] + [n- ["nat" "-"] Nat] + [n* ["nat" "*"] Nat] + [n/ ["nat" "/"] Nat] + [n% ["nat" "%"] Nat] + ) + +(def:''' (multiple? div n) + #Nil + (-> Int Int Bool) + (i= 0 (i% n div))) + +(def:''' #export (not x) + #Nil + (-> Bool Bool) + (if x false true)) + +(def:''' (find-macro' modules current-module module name) + #Nil + (-> ($' List (& Text Module)) + Text Text Text + ($' Maybe Macro)) + (do Monad + [$module (get module modules) + gdef (let' [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} (_lux_: Module $module)] + (get name bindings))] + (let' [[def-type def-meta def-value] (_lux_: Def gdef)] + (_lux_case (get-meta ["lux" "macro?"] def-meta) + (#Some (#BoolM true)) + (_lux_case (get-meta ["lux" "export?"] def-meta) + (#Some (#BoolM true)) + (#Some (_lux_:! Macro def-value)) + + _ + (if (Text/= module current-module) + (#Some (_lux_:! Macro def-value)) + #None)) + + _ + (_lux_case (get-meta ["lux" "alias"] def-meta) + (#Some (#IdentM [r-module r-name])) + (find-macro' modules current-module r-module r-name) + + _ + #None) + )) + )) + +(def:''' (normalize ident) + #Nil + (-> Ident ($' Lux Ident)) + (_lux_case ident + ["" name] + (do Monad + [module-name current-module-name] + (wrap [module-name name])) + + _ + (return ident))) + +(def:''' (find-macro ident) + #Nil + (-> Ident ($' Lux ($' Maybe Macro))) + (do Monad + [current-module current-module-name] + (let' [[module name] ident] + (lambda' [state] + (_lux_case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right state (find-macro' modules current-module module name))))))) + +(def:''' (macro? ident) + #Nil + (-> Ident ($' Lux Bool)) + (do Monad + [ident (normalize ident) + output (find-macro ident)] + (wrap (_lux_case output + (#Some _) true + #None false)))) + +(def:''' (List/join xs) + #Nil + (All [a] + (-> ($' List ($' List a)) ($' List a))) + (fold List/append #Nil (reverse xs))) + +(def:''' (interpose sep xs) + #Nil + (All [a] + (-> a ($' List a) ($' List a))) + (_lux_case xs + #Nil + xs + + (#Cons [x #Nil]) + xs + + (#Cons [x xs']) + (list& x sep (interpose sep xs')))) + +(def:''' (macro-expand-once token) + #Nil + (-> AST ($' Lux ($' List AST))) + (_lux_case token + [_ (#FormS (#Cons [_ (#SymbolS macro-name)] args))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (_lux_case ?macro + (#Some macro) + (macro args) + + #None + (return (list token)))) + + _ + (return (list token)))) + +(def:''' (macro-expand token) + #Nil + (-> AST ($' Lux ($' List AST))) + (_lux_case token + [_ (#FormS (#Cons [_ (#SymbolS macro-name)] args))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (_lux_case ?macro + (#Some macro) + (do Monad + [expansion (macro args) + expansion' (mapM Monad macro-expand expansion)] + (wrap (List/join expansion'))) + + #None + (return (list token)))) + + _ + (return (list token)))) + +(def:''' (macro-expand-all syntax) + #Nil + (-> AST ($' Lux ($' List AST))) + (_lux_case syntax + [_ (#FormS (#Cons [_ (#SymbolS macro-name)] args))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (_lux_case ?macro + (#Some macro) + (do Monad + [expansion (macro args) + expansion' (mapM Monad macro-expand-all expansion)] + (wrap (List/join expansion'))) + + #None + (do Monad + [args' (mapM Monad macro-expand-all args)] + (wrap (list (form$ (#Cons (symbol$ macro-name) (List/join args')))))))) + + [_ (#FormS members)] + (do Monad + [members' (mapM Monad macro-expand-all members)] + (wrap (list (form$ (List/join members'))))) + + [_ (#TupleS members)] + (do Monad + [members' (mapM Monad macro-expand-all members)] + (wrap (list (tuple$ (List/join members'))))) + + [_ (#RecordS pairs)] + (do Monad + [pairs' (mapM Monad + (lambda' [kv] + (let' [[key val] kv] + (do Monad + [val' (macro-expand-all val)] + (_lux_case val' + (#;Cons val'' #;Nil) + (return [key val'']) + + _ + (fail "The value-part of a KV-pair in a record must macro-expand to a single AST."))))) + pairs)] + (wrap (list (record$ pairs')))) + + _ + (return (list syntax)))) + +(def:''' (walk-type type) + #Nil + (-> AST AST) + (_lux_case type + [_ (#FormS (#Cons [_ (#TagS tag)] parts))] + (form$ (#Cons [(tag$ tag) (map walk-type parts)])) + + [_ (#TupleS members)] + (` (& (~@ (map walk-type members)))) + + [_ (#FormS (#Cons type-fn args))] + (fold (_lux_: (-> AST AST AST) + (lambda' [arg type-fn] (` (#;AppT (~ type-fn) (~ arg))))) + (walk-type type-fn) + (map walk-type args)) + + _ + type)) + +(macro:' #export (type tokens) + (list [["lux" "doc"] (#TextM "## Takes a type expression and returns it's representation as data-structure. + (type (All [a] (Maybe (List a))))")]) + (_lux_case tokens + (#Cons type #Nil) + (do Monad + [type+ (macro-expand-all type)] + (_lux_case type+ + (#Cons type' #Nil) + (wrap (list (walk-type type'))) + + _ + (fail "The expansion of the type-syntax had to yield a single element."))) + + _ + (fail "Wrong syntax for type"))) + +(macro:' #export (: tokens) + (list [["lux" "doc"] (#TextM "## The type-annotation macro. + (: (List Int) (list 1 2 3))")]) + (_lux_case tokens + (#Cons type (#Cons value #Nil)) + (return (list (` (;_lux_: (type (~ type)) (~ value))))) + + _ + (fail "Wrong syntax for :"))) + +(macro:' #export (:! tokens) + (list [["lux" "doc"] (#TextM "## The type-coercion macro. + (:! Dinosaur (list 1 2 3))")]) + (_lux_case tokens + (#Cons type (#Cons value #Nil)) + (return (list (` (;_lux_:! (type (~ type)) (~ value))))) + + _ + (fail "Wrong syntax for :!"))) + +(def:''' (empty? xs) + #Nil + (All [a] (-> ($' List a) Bool)) + (_lux_case xs + #Nil true + _ false)) + +(do-template [ ] + [(def:''' ( xy) + #Nil + (All [a b] (-> (& a b) )) + (let' [[x y] xy] ))] + + [first a x] + [second b y]) + +(def:''' (unfold-type-def type-asts) + #Nil + (-> ($' List AST) ($' Lux (& AST ($' Maybe ($' List Text))))) + (_lux_case type-asts + (#Cons [_ (#RecordS pairs)] #;Nil) + (do Monad + [members (mapM Monad + (: (-> [AST AST] (Lux [Text AST])) + (lambda' [pair] + (_lux_case pair + [[_ (#TagS "" member-name)] member-type] + (return [member-name member-type]) + + _ + (fail "Wrong syntax for variant case.")))) + pairs)] + (return [(` (& (~@ (map second members)))) + (#Some (map first members))])) + + (#Cons type #Nil) + (_lux_case type + [_ (#TagS "" member-name)] + (return [(` #;UnitT) (#;Some (list member-name))]) + + [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))] + (return [(` (& (~@ member-types))) (#;Some (list member-name))]) + + _ + (return [type #None])) + + (#Cons case cases) + (do Monad + [members (mapM Monad + (: (-> AST (Lux [Text AST])) + (lambda' [case] + (_lux_case case + [_ (#TagS "" member-name)] + (return [member-name (` Unit)]) + + [_ (#FormS (#Cons [_ (#TagS "" member-name)] (#Cons member-type #Nil)))] + (return [member-name member-type]) + + [_ (#FormS (#Cons [_ (#TagS "" member-name)] member-types))] + (return [member-name (` (& (~@ member-types)))]) + + _ + (fail "Wrong syntax for variant case.")))) + (list& case cases))] + (return [(` (| (~@ (map second members)))) + (#Some (map first members))])) + + _ + (fail "Improper type-definition syntax"))) + +(def:''' (gensym prefix state) + #Nil + (-> Text ($' Lux AST)) + (_lux_case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (#Right {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed (n+ +1 seed) #expected expected + #cursor cursor + #scope-type-vars scope-type-vars} + (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))])))) + +(macro:' #export (Rec tokens) + (list [["lux" "doc"] (#TextM "## Parameter-less recursive types. + ## A name has to be given to the whole type, to use it within it's body. + (Rec Self + [Int (List Self)])")]) + (_lux_case tokens + (#Cons [_ (#SymbolS "" name)] (#Cons body #Nil)) + (let' [body' (replace-syntax (list [name (` (#AppT (~ (make-bound +0)) (~ (make-bound +1))))]) body)] + (return (list (` (#AppT (#UnivQ #Nil (~ body')) Void))))) + + _ + (fail "Wrong syntax for Rec"))) + +(macro:' #export (exec tokens) + (list [["lux" "doc"] (#TextM "## Sequential execution of expressions (great for side-effects). + (exec + (log! \"#1\") + (log! \"#2\") + (log! \"#3\") + \"YOLO\")")]) + (_lux_case (reverse tokens) + (#Cons value actions) + (let' [dummy (symbol$ ["" ""])] + (return (list (fold (_lux_: (-> AST AST AST) + (lambda' [pre post] (` (;_lux_case (~ pre) (~ dummy) (~ post))))) + value + actions)))) + + _ + (fail "Wrong syntax for exec"))) + +(macro:' (def:' tokens) + (let' [[export? tokens'] (_lux_case tokens + (#Cons [_ (#TagS "" "export")] tokens') + [true tokens'] + + _ + [false tokens]) + parts (: (Maybe [AST (List AST) (Maybe AST) AST]) + (_lux_case tokens' + (#Cons [_ (#FormS (#Cons name args))] (#Cons type (#Cons body #Nil))) + (#Some name args (#Some type) body) + + (#Cons name (#Cons type (#Cons body #Nil))) + (#Some name #Nil (#Some type) body) + + (#Cons [_ (#FormS (#Cons name args))] (#Cons body #Nil)) + (#Some name args #None body) + + (#Cons name (#Cons body #Nil)) + (#Some name #Nil #None body) + + _ + #None))] + (_lux_case parts + (#Some name args ?type body) + (let' [body' (_lux_case args + #Nil + body + + _ + (` (lambda' (~ name) [(~@ args)] (~ body)))) + body'' (_lux_case ?type + (#Some type) + (` (: (~ type) (~ body'))) + + #None + body')] + (return (list (` (;_lux_def (~ name) (~ body'') + (~ (if export? + (with-export-meta (tag$ ["lux" "Nil"])) + (tag$ ["lux" "Nil"])))))))) + + #None + (fail "Wrong syntax for def'")))) + +(def:' (rejoin-pair pair) + (-> [AST AST] (List AST)) + (let' [[left right] pair] + (list left right))) + +(def:''' (Nat->Text x) + #Nil + (-> Nat Text) + (_lux_proc ["nat" "encode"] [x])) + +(def:''' (Frac->Text x) + #Nil + (-> Frac Text) + (_lux_proc ["frac" "encode"] [x])) + +(def:' (ast-to-text ast) + (-> AST Text) + (_lux_case ast + [_ (#BoolS value)] + (->Text value) + + [_ (#NatS value)] + (Nat->Text value) + + [_ (#IntS value)] + (->Text value) + + [_ (#FracS value)] + (Frac->Text value) + + [_ (#RealS value)] + (->Text value) + + [_ (#CharS value)] + ($_ Text/append "#" "\"" (->Text value) "\"") + + [_ (#TextS value)] + ($_ Text/append "\"" value "\"") + + [_ (#SymbolS [prefix name])] + (if (Text/= "" prefix) + name + ($_ Text/append prefix ";" name)) + + [_ (#TagS [prefix name])] + (if (Text/= "" prefix) + ($_ Text/append "#" name) + ($_ Text/append "#" prefix ";" name)) + + [_ (#FormS xs)] + ($_ Text/append "(" (|> xs + (map ast-to-text) + (interpose " ") + reverse + (fold Text/append "")) ")") + + [_ (#TupleS xs)] + ($_ Text/append "[" (|> xs + (map ast-to-text) + (interpose " ") + reverse + (fold Text/append "")) "]") + + [_ (#RecordS kvs)] + ($_ Text/append "{" (|> kvs + (map (lambda' [kv] (_lux_case kv [k v] ($_ Text/append (ast-to-text k) " " (ast-to-text v))))) + (interpose " ") + reverse + (fold Text/append "")) "}") + )) + +(def:' (expander branches) + (-> (List AST) (Lux (List AST))) + (_lux_case branches + (#;Cons [_ (#FormS (#Cons [_ (#SymbolS macro-name)] macro-args))] + (#;Cons body + branches')) + (do Monad + [??? (macro? macro-name)] + (if ??? + (do Monad + [init-expansion (macro-expand-once (form$ (list& (symbol$ macro-name) (form$ macro-args) body branches')))] + (expander init-expansion)) + (do Monad + [sub-expansion (expander branches')] + (wrap (list& (form$ (list& (symbol$ macro-name) macro-args)) + body + sub-expansion))))) + + (#;Cons pattern (#;Cons body branches')) + (do Monad + [sub-expansion (expander branches')] + (wrap (list& pattern body sub-expansion))) + + #;Nil + (do Monad [] (wrap (list))) + + _ + (fail ($_ Text/append "\"lux;case\" expects an even number of tokens: " (|> branches + (map ast-to-text) + (interpose " ") + reverse + (fold Text/append "")))))) + +(macro:' #export (case tokens) + (list [["lux" "doc"] (#TextM "## The pattern-matching macro. + ## Allows the usage of macros within the patterns to provide custom syntax. + (case (: (List Int) (list 1 2 3)) + (#Cons x (#Cons y (#Cons z #Nil))) + (#Some ($_ * x y z)) + + _ + #None)")]) + (_lux_case tokens + (#Cons value branches) + (do Monad + [expansion (expander branches)] + (wrap (list (` (;_lux_case (~ value) (~@ expansion)))))) + + _ + (fail "Wrong syntax for case"))) + +(macro:' #export (^ tokens) + (list [["lux" "doc"] (#TextM "## Macro-expanding patterns. + ## It's a special macro meant to be used with case. + (case (: (List Int) (list 1 2 3)) + (^ (list x y z)) + (#Some ($_ * x y z)) + + _ + #None)")]) + (case tokens + (#Cons [_ (#FormS (#Cons pattern #Nil))] (#Cons body branches)) + (do Monad + [pattern+ (macro-expand-all pattern)] + (case pattern+ + (#Cons pattern' #Nil) + (wrap (list& pattern' body branches)) + + _ + (fail "^ can only expand to 1 pattern."))) + + _ + (fail "Wrong syntax for ^ macro"))) + +(macro:' #export (^or tokens) + (list [["lux" "doc"] (#TextM "## Or-patterns. + ## It's a special macro meant to be used with case. + (type: Weekday + (| #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday + #Sunday)) + + (def: (weekend? day) + (-> Weekday Bool) + (case day + (^or #Saturday #Sunday) + true + + _ + false))")]) + (case tokens + (^ (list& [_ (#FormS patterns)] body branches)) + (case patterns + #Nil + (fail "^or can't have 0 patterns") + + _ + (let' [pairs (|> patterns + (map (lambda' [pattern] (list pattern body))) + (List/join))] + (return (List/append pairs branches)))) + _ + (fail "Wrong syntax for ^or"))) + +(def:' (symbol? ast) + (-> AST Bool) + (case ast + [_ (#SymbolS _)] + true + + _ + false)) + +(macro:' #export (let tokens) + (list [["lux" "doc"] (#TextM "## Creates local bindings. + ## Can (optionally) use pattern-matching macros when binding. + (let [x (foo bar) + y (baz quux)] + (op x y))")]) + (case tokens + (^ (list [_ (#TupleS bindings)] body)) + (if (multiple? 2 (length bindings)) + (|> bindings as-pairs reverse + (fold (: (-> [AST AST] AST AST) + (lambda' [lr body'] + (let' [[l r] lr] + (if (symbol? l) + (` (;_lux_case (~ r) (~ l) (~ body'))) + (` (case (~ r) (~ l) (~ body'))))))) + body) + list + return) + (fail "let requires an even number of parts")) + + _ + (fail "Wrong syntax for let"))) + +(macro:' #export (lambda tokens) + (list [["lux" "doc"] (#TextM "## Syntax for creating functions. + ## Allows for giving the function itself a name, for the sake of recursion. + (: (All [a b] (-> a b a)) + (lambda [x y] x)) + + (: (All [a b] (-> a b a)) + (lambda const [x y] x))")]) + (case (: (Maybe [Ident AST (List AST) AST]) + (case tokens + (^ (list [_ (#TupleS (#Cons head tail))] body)) + (#Some ["" ""] head tail body) + + (^ (list [_ (#SymbolS ["" name])] [_ (#TupleS (#Cons head tail))] body)) + (#Some ["" name] head tail body) + + _ + #None)) + (#Some ident head tail body) + (let [g!blank (symbol$ ["" ""]) + g!name (symbol$ ident) + body+ (fold (: (-> AST AST AST) + (lambda' [arg body'] + (if (symbol? arg) + (` (;_lux_lambda (~ g!blank) (~ arg) (~ body'))) + (` (;_lux_lambda (~ g!blank) (~ g!blank) + (case (~ g!blank) (~ arg) (~ body'))))))) + body + (reverse tail))] + (return (list (if (symbol? head) + (` (;_lux_lambda (~ g!name) (~ head) (~ body+))) + (` (;_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) + + #None + (fail "Wrong syntax for lambda"))) + +(def:' (process-def-meta-value ast) + (-> AST (Lux AST)) + (case ast + [_ (#BoolS value)] + (return (form$ (list (tag$ ["lux" "BoolM"]) (bool$ value)))) + + [_ (#NatS value)] + (return (form$ (list (tag$ ["lux" "NatM"]) (nat$ value)))) + + [_ (#IntS value)] + (return (form$ (list (tag$ ["lux" "IntM"]) (int$ value)))) + + [_ (#FracS value)] + (return (form$ (list (tag$ ["lux" "FracM"]) (frac$ value)))) + + [_ (#RealS value)] + (return (form$ (list (tag$ ["lux" "RealM"]) (real$ value)))) + + [_ (#CharS value)] + (return (form$ (list (tag$ ["lux" "CharM"]) (char$ value)))) + + [_ (#TextS value)] + (return (form$ (list (tag$ ["lux" "TextM"]) (text$ value)))) + + [_ (#TagS [prefix name])] + (return (form$ (list (tag$ ["lux" "IdentM"]) (tuple$ (list (text$ prefix) (text$ name)))))) + + (^or [_ (#FormS _)] [_ (#SymbolS _)]) + (return ast) + + [_ (#TupleS xs)] + (do Monad + [=xs (mapM Monad process-def-meta-value xs)] + (wrap (form$ (list (tag$ ["lux" "ListM"]) (untemplate-list =xs))))) + + [_ (#RecordS kvs)] + (do Monad + [=xs (mapM Monad + (: (-> [AST AST] (Lux AST)) + (lambda [[k v]] + (case k + [_ (#TextS =k)] + (do Monad + [=v (process-def-meta-value v)] + (wrap (tuple$ (list (text$ =k) =v)))) + + _ + (fail (Text/append "Wrong syntax for DictM key: " (ast-to-text k)))))) + kvs)] + (wrap (form$ (list (tag$ ["lux" "DictM"]) (untemplate-list =xs))))) + )) + +(def:' (process-def-meta ast) + (-> AST (Lux AST)) + (case ast + [_ (#RecordS kvs)] + (do Monad + [=kvs (mapM Monad + (: (-> [AST AST] (Lux AST)) + (lambda [[k v]] + (case k + [_ (#TagS [pk nk])] + (do Monad + [=v (process-def-meta-value v)] + (wrap (tuple$ (list (tuple$ (list (text$ pk) (text$ nk))) + =v)))) + + _ + (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast)))))) + kvs)] + (wrap (untemplate-list =kvs))) + + _ + (fail (Text/append "Wrong syntax for Anns: " (ast-to-text ast))))) + +(def:' (with-func-args args meta) + (-> (List AST) AST AST) + (case args + #;Nil + meta + + _ + (` (#;Cons [["lux" "func-args"] + (#;ListM (list (~@ (map (lambda [arg] + (` (#;TextM (~ (text$ (ast-to-text arg)))))) + args))))] + (~ meta))))) + +(def:' (with-type-args args) + (-> (List AST) AST) + (` {#;type-args (#;ListM (list (~@ (map (lambda [arg] + (` (#;TextM (~ (text$ (ast-to-text arg)))))) + args))))})) + +(def:' Export-Level + Type + ($' Either + Unit ## Exported + Unit ## Hidden + )) + +(def:' (export-level^ tokens) + (-> (List AST) [(Maybe Export-Level) (List AST)]) + (case tokens + (#Cons [_ (#TagS [_ "export"])] tokens') + [(#;Some (#;Left [])) tokens'] + + (#Cons [_ (#TagS [_ "hidden"])] tokens') + [(#;Some (#;Right [])) tokens'] + + _ + [#;None tokens])) + +(def:' (export-level ?el) + (-> (Maybe Export-Level) (List AST)) + (case ?el + #;None + (list) + + (#;Some (#;Left [])) + (list (' #export)) + + (#;Some (#;Right [])) + (list (' #hidden)))) + +(macro:' #export (def: tokens) + (list [["lux" "doc"] (#TextM "## Defines global constants/functions. + (def: (rejoin-pair pair) + (-> [AST AST] (List AST)) + (let [[left right] pair] + (list left right))) + + (def: branching-exponent + Int + 5)")]) + (let [[export? tokens'] (export-level^ tokens) + parts (: (Maybe [AST (List AST) (Maybe AST) AST AST]) + (case tokens' + (^ (list [_ (#FormS (#Cons name args))] meta type body)) + (#Some name args (#Some type) body meta) + + (^ (list name meta type body)) + (#Some name #Nil (#Some type) body meta) + + (^ (list [_ (#FormS (#Cons name args))] type body)) + (#Some name args (#Some type) body (' {})) + + (^ (list name type body)) + (#Some name #Nil (#Some type) body (' {})) + + (^ (list [_ (#FormS (#Cons name args))] body)) + (#Some name args #None body (' {})) + + (^ (list name body)) + (#Some name #Nil #None body (' {})) + + _ + #None))] + (case parts + (#Some name args ?type body meta) + (let [body (case args + #Nil + body + + _ + (` (lambda (~ name) [(~@ args)] (~ body)))) + body (case ?type + (#Some type) + (` (: (~ type) (~ body))) + + #None + body)] + (do Monad + [=meta (process-def-meta meta)] + (return (list (` (;_lux_def (~ name) (~ body) (~ (with-func-args args + (case export? + #;None + =meta + + (#;Some (#;Left [])) + (with-export-meta =meta) + + (#;Some (#;Right [])) + (|> =meta + with-export-meta + with-hidden-meta) + ))))))))) + + #None + (fail "Wrong syntax for def")))) + +(def: (meta-ast-add addition meta) + (-> [AST AST] AST AST) + (case [addition meta] + [[name value] [cursor (#;RecordS pairs)]] + [cursor (#;RecordS (#;Cons [name value] pairs))] + + _ + meta)) + +(def: (meta-ast-merge addition base) + (-> AST AST AST) + (case addition + [cursor (#;RecordS pairs)] + (fold meta-ast-add base pairs) + + _ + base)) + +(macro:' #export (macro: tokens) + (list [["lux" "doc"] (#TextM "(macro: #export (ident-for tokens) + (case tokens + (^template [] + (^ (list [_ ( [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + ([#;SymbolS] [#;TagS]) + + _ + (fail \"Wrong syntax for ident-for\")))")]) + (let [[exported? tokens] (export-level^ tokens) + name+args+meta+body?? (: (Maybe [Ident (List AST) AST AST]) + (case tokens + (^ (list [_ (#;FormS (list& [_ (#SymbolS name)] args))] body)) + (#Some [name args (` {}) body]) + + (^ (list [_ (#;SymbolS name)] body)) + (#Some [name #Nil (` {}) body]) + + (^ (list [_ (#;FormS (list& [_ (#SymbolS name)] args))] [meta-rec-cursor (#;RecordS meta-rec-parts)] body)) + (#Some [name args [meta-rec-cursor (#;RecordS meta-rec-parts)] body]) + + (^ (list [_ (#;SymbolS name)] [meta-rec-cursor (#;RecordS meta-rec-parts)] body)) + (#Some [name #Nil [meta-rec-cursor (#;RecordS meta-rec-parts)] body]) + + _ + #None))] + (case name+args+meta+body?? + (#Some [name args meta body]) + (let [name (symbol$ name) + def-sig (case args + #;Nil name + _ (` ((~ name) (~@ args))))] + (return (list (` (;;def: (~@ (export-level exported?)) + (~ def-sig) + (~ (meta-ast-merge (` {#;macro? true}) + meta)) + + ;;Macro + (~ body)))))) + + + #None + (fail "Wrong syntax for macro:")))) + +(macro: #export (sig: tokens) + {#;doc "## Definition of signatures ala ML. + (sig: #export (Ord a) + (: (Eq a) + eq) + (: (-> a a Bool) + <) + (: (-> a a Bool) + <=) + (: (-> a a Bool) + >) + (: (-> a a Bool) + >=))"} + (let [[exported? tokens'] (export-level^ tokens) + ?parts (: (Maybe [Ident (List AST) AST (List AST)]) + (case tokens' + (^ (list& [_ (#FormS (list& [_ (#SymbolS name)] args))] [meta-rec-cursor (#;RecordS meta-rec-parts)] sigs)) + (#Some name args [meta-rec-cursor (#;RecordS meta-rec-parts)] sigs) + + (^ (list& [_ (#SymbolS name)] [meta-rec-cursor (#;RecordS meta-rec-parts)] sigs)) + (#Some name #Nil [meta-rec-cursor (#;RecordS meta-rec-parts)] sigs) + + (^ (list& [_ (#FormS (list& [_ (#SymbolS name)] args))] sigs)) + (#Some name args (` {}) sigs) + + (^ (list& [_ (#SymbolS name)] sigs)) + (#Some name #Nil (` {}) sigs) + + _ + #None))] + (case ?parts + (#Some name args meta sigs) + (do Monad + [name+ (normalize name) + sigs' (mapM Monad macro-expand sigs) + members (: (Lux (List [Text AST])) + (mapM Monad + (: (-> AST (Lux [Text AST])) + (lambda [token] + (case token + (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_:")] type [_ (#SymbolS ["" name])]))]) + (wrap [name type]) + + _ + (fail "Signatures require typed members!")))) + (List/join sigs'))) + #let [[_module _name] name+ + def-name (symbol$ name) + sig-type (record$ (map (: (-> [Text AST] [AST AST]) + (lambda [[m-name m-type]] + [(tag$ ["" m-name]) m-type])) + members)) + sig-meta (meta-ast-merge (` {#;sig? true}) + meta) + usage (case args + #;Nil + def-name + + _ + (` ((~ def-name) (~@ args))))]] + (return (list (` (;;type: (~@ (export-level exported?)) (~ usage) (~ sig-meta) (~ sig-type)))))) + + #None + (fail "Wrong syntax for sig:")))) + +(def: (find f xs) + (All [a b] + (-> (-> a (Maybe b)) (List a) (Maybe b))) + (case xs + #Nil + #None + + (#Cons x xs') + (case (f x) + #None + (find f xs') + + (#Some y) + (#Some y)))) + +(def: (last-index-of part text) + (-> Text Text Int) + (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:lastIndexOf:java.lang.String"] [text part])])) + +(def: (index-of part text) + (-> Text Text Int) + (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:indexOf:java.lang.String"] [text part])])) + +(def: (substring1 idx text) + (-> Int Text Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int"] [text (_lux_proc ["jvm" "l2i"] [idx])])) + +(def: (substring2 idx1 idx2 text) + (-> Int Int Text Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"] [text (_lux_proc ["jvm" "l2i"] [idx1]) (_lux_proc ["jvm" "l2i"] [idx2])])) + +(def: #export (log! message) + (-> Text Unit) + (_lux_proc ["jvm" "invokevirtual:java.io.PrintStream:println:java.lang.String"] + [(_lux_proc ["jvm" "getstatic:java.lang.System:out"] []) message])) + +(def: (split-text splitter input) + (-> Text Text (List Text)) + (let [idx (index-of splitter input)] + (if (i< idx 0) + (#Cons input #Nil) + (#Cons (substring2 0 idx input) + (split-text splitter (substring1 (i+ 1 idx) input)))))) + +(def: (split-module-contexts module) + (-> Text (List Text)) + (#Cons module (let [idx (last-index-of "/" module)] + (if (i< idx 0) + #Nil + (split-module-contexts (substring2 0 idx module)))))) + +(def: (split-module module) + (-> Text (List Text)) + (let [idx (index-of "/" module)] + (if (i< idx 0) + (list module) + (list& (substring2 0 idx module) (split-module (substring1 (i+ 1 idx) module)))))) + +(def: (at idx xs) + (All [a] + (-> Int (List a) (Maybe a))) + (case xs + #Nil + #None + + (#Cons x xs') + (if (i= idx 0) + (#Some x) + (at (i- idx 1) xs') + ))) + +(def: (beta-reduce env type) + (-> (List Type) Type Type) + (case type + (#SumT left right) + (#SumT (beta-reduce env left) (beta-reduce env right)) + + (#ProdT left right) + (#ProdT (beta-reduce env left) (beta-reduce env right)) + + (#AppT ?type-fn ?type-arg) + (#AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) + + (#UnivQ ?local-env ?local-def) + (case ?local-env + #Nil + (#UnivQ env ?local-def) + + _ + type) + + (#ExQ ?local-env ?local-def) + (case ?local-env + #Nil + (#ExQ env ?local-def) + + _ + type) + + (#LambdaT ?input ?output) + (#LambdaT (beta-reduce env ?input) (beta-reduce env ?output)) + + (#BoundT idx) + (case (at (_lux_proc ["nat" "to-int"] [idx]) env) + (#Some bound) + bound + + _ + type) + + (#NamedT name type) + (beta-reduce env type) + + _ + type + )) + +(def: (apply-type type-fn param) + (-> Type Type (Maybe Type)) + (case type-fn + (#UnivQ env body) + (#Some (beta-reduce (list& type-fn param env) body)) + + (#ExQ env body) + (#Some (beta-reduce (list& type-fn param env) body)) + + (#AppT F A) + (do Monad + [type-fn* (apply-type F A)] + (apply-type type-fn* param)) + + (#NamedT name type) + (apply-type type param) + + _ + #None)) + +(do-template [ ] + [(def: ( type) + (-> Type (List Type)) + (case type + ( left right) + (list& left ( right)) + + _ + (list type)))] + + [flatten-sum #;SumT] + [flatten-prod #;ProdT] + [flatten-lambda #;LambdaT] + [flatten-app #;AppT] + ) + +(def: (resolve-struct-type type) + (-> Type (Maybe (List Type))) + (case type + (#ProdT _) + (#Some (flatten-prod type)) + + (#AppT fun arg) + (do Monad + [output (apply-type fun arg)] + (resolve-struct-type output)) + + (#UnivQ _ body) + (resolve-struct-type body) + + (#ExQ _ body) + (resolve-struct-type body) + + (#NamedT name type) + (resolve-struct-type type) + + (#SumT _) + #None + + _ + (#Some (list type)))) + +(def: (find-module name) + (-> Text (Lux Module)) + (lambda [state] + (let [{#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case (get name modules) + (#Some module) + (#Right state module) + + _ + (#Left ($_ Text/append "Unknown module: " name)))))) + +(def: get-current-module + (Lux Module) + (do Monad + [module-name current-module-name] + (find-module module-name))) + +(def: (resolve-tag [module name]) + (-> Ident (Lux [Nat (List Ident) Bool Type])) + (do Monad + [=module (find-module module) + #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags-table #types types #module-anns _} =module]] + (case (get name tags-table) + (#Some output) + (return output) + + _ + (fail (Text/append "Unknown tag: " (Ident->Text [module name])))))) + +(def: (resolve-type-tags type) + (-> Type (Lux (Maybe [(List Ident) (List Type)]))) + (case type + (#AppT fun arg) + (resolve-type-tags fun) + + (#UnivQ env body) + (resolve-type-tags body) + + (#ExQ env body) + (resolve-type-tags body) + + (#NamedT [module name] _) + (do Monad + [=module (find-module module) + #let [{#module-hash _ #module-aliases _ #defs bindings #imports _ #tags tags #types types #module-anns _} =module]] + (case (get name types) + (#Some [tags exported? (#NamedT _ _type)]) + (case (resolve-struct-type _type) + (#Some members) + (return (#Some [tags members])) + + _ + (return #None)) + + _ + (return #None))) + + _ + (return #None))) + +(def: get-expected-type + (Lux Type) + (lambda [state] + (let [{#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case expected + (#Some type) + (#Right state type) + + #None + (#Left "Not expecting any type."))))) + +(macro: #export (struct tokens) + {#;doc "Not meant to be used directly. Prefer \"struct:\"."} + (do Monad + [tokens' (mapM Monad macro-expand tokens) + struct-type get-expected-type + tags+type (resolve-type-tags struct-type) + tags (: (Lux (List Ident)) + (case tags+type + (#Some [tags _]) + (return tags) + + _ + (fail "No tags available for type."))) + #let [tag-mappings (: (List [Text AST]) + (map (lambda [tag] [(second tag) (tag$ tag)]) + tags))] + members (mapM Monad + (: (-> AST (Lux [AST AST])) + (lambda [token] + (case token + (^ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value meta))]) + (case (get tag-name tag-mappings) + (#Some tag) + (wrap [tag value]) + + _ + (fail (Text/append "Unknown structure member: " tag-name))) + + _ + (fail "Invalid structure member.")))) + (List/join tokens'))] + (wrap (list (record$ members))))) + +(def: (Text/join parts) + (-> (List Text) Text) + (|> parts reverse (fold Text/append ""))) + +(macro: #export (struct: tokens) + {#;doc "## Definition of structures ala ML. + (struct: #export Ord (Ord Int) + (def: eq Eq) + (def: (< test subject) + (lux;< test subject)) + (def: (<= test subject) + (or (lux;< test subject) + (lux;= test subject))) + (def: (lux;> test subject) + (lux;> test subject)) + (def: (lux;>= test subject) + (or (lux;> test subject) + (lux;= test subject))))"} + (let [[exported? tokens'] (export-level^ tokens) + ?parts (: (Maybe [AST (List AST) AST AST (List AST)]) + (case tokens' + (^ (list& [_ (#FormS (list& name args))] type [meta-rec-cursor (#;RecordS meta-rec-parts)] defs)) + (#Some name args type [meta-rec-cursor (#;RecordS meta-rec-parts)] defs) + + (^ (list& name type [meta-rec-cursor (#;RecordS meta-rec-parts)] defs)) + (#Some name #Nil type [meta-rec-cursor (#;RecordS meta-rec-parts)] defs) + + (^ (list& [_ (#FormS (list& name args))] type defs)) + (#Some name args type (` {}) defs) + + (^ (list& name type defs)) + (#Some name #Nil type (` {}) defs) + + _ + #None))] + (case ?parts + (#Some [name args type meta defs]) + (case (case name + [_ (#;SymbolS ["" "_"])] + (case type + (^ [_ (#;FormS (list& [_ (#;SymbolS [_ sig-name])] sig-args))]) + (case (: (Maybe (List Text)) + (mapM Monad + (lambda [sa] + (case sa + [_ (#;SymbolS [_ arg-name])] + (#;Some arg-name) + + _ + #;None)) + sig-args)) + (^ (#;Some params)) + (#;Some (symbol$ ["" ($_ Text/append sig-name "<" (|> params (interpose ",") Text/join) ">")])) + + _ + #;None) + + _ + #;None) + + _ + (#;Some name) + ) + (#;Some name) + (let [usage (case args + #Nil + name + + _ + (` ((~ name) (~@ args))))] + (return (list (` (;;def: (~@ (export-level exported?)) (~ usage) + (~ (meta-ast-merge (` {#;struct? true}) + meta)) + (~ type) + (struct (~@ defs))))))) + + #;None + (fail "Struct must have a name other than \"_\"!")) + + #None + (fail "Wrong syntax for struct:")))) + +(def: #export (id x) + {#;doc "Identity function. Does nothing to it's argument and just returns it."} + (All [a] (-> a a)) + x) + +(do-template [
] + [(macro: #export ( tokens) + {#;doc } + (case (reverse tokens) + (^ (list& last init)) + (return (list (fold (: (-> AST AST AST) + (lambda [pre post] (` ))) + last + init))) + + _ + (fail )))] + + [and (if (~ pre) (~ post) false) "'and' requires >=1 clauses." "Short-circuiting \"and\"\n(and true false true) ## => false"] + [or (if (~ pre) true (~ post)) "'or' requires >=1 clauses." "Short-circuiting \"or\"\n(or true false true) ## => true"]) + +(macro: #export (type: tokens) + {#;doc "## The type-definition macro. + (type: (List a) + #Nil + (#Cons a (List a)))"} + (let [[exported? tokens'] (export-level^ tokens) + [rec? tokens'] (case tokens' + (#Cons [_ (#TagS [_ "rec"])] tokens') + [true tokens'] + + _ + [false tokens']) + parts (: (Maybe [Text (List AST) AST (List AST)]) + (case tokens' + (^ (list [_ (#SymbolS "" name)] [meta-cursor (#;RecordS meta-parts)] [type-cursor (#;RecordS type-parts)])) + (#Some [name #Nil [meta-cursor (#;RecordS meta-parts)] (list [type-cursor (#;RecordS type-parts)])]) + + (^ (list& [_ (#SymbolS "" name)] [meta-cursor (#;RecordS meta-parts)] type-ast1 type-asts)) + (#Some [name #Nil [meta-cursor (#;RecordS meta-parts)] (#;Cons type-ast1 type-asts)]) + + (^ (list& [_ (#SymbolS "" name)] type-asts)) + (#Some [name #Nil (` {}) type-asts]) + + (^ (list [_ (#FormS (#Cons [_ (#SymbolS "" name)] args))] [meta-cursor (#;RecordS meta-parts)] [type-cursor (#;RecordS type-parts)])) + (#Some [name args [meta-cursor (#;RecordS meta-parts)] (list [type-cursor (#;RecordS type-parts)])]) + + (^ (list& [_ (#FormS (#Cons [_ (#SymbolS "" name)] args))] [meta-cursor (#;RecordS meta-parts)] type-ast1 type-asts)) + (#Some [name args [meta-cursor (#;RecordS meta-parts)] (#;Cons type-ast1 type-asts)]) + + (^ (list& [_ (#FormS (#Cons [_ (#SymbolS "" name)] args))] type-asts)) + (#Some [name args (` {}) type-asts]) + + _ + #None))] + (case parts + (#Some name args meta type-asts) + (do Monad + [type+tags?? (unfold-type-def type-asts) + module-name current-module-name] + (let [type-name (symbol$ ["" name]) + [type tags??] type+tags?? + type-meta (: AST + (case tags?? + (#Some tags) + (` {#;tags [(~@ (map (: (-> Text AST) + (lambda' [tag] + (form$ (list (tag$ ["lux" "TextM"]) + (text$ tag))))) + tags))] + #;type? true}) + + _ + (` {#;type? true}))) + type' (: (Maybe AST) + (if rec? + (if (empty? args) + (let [g!param (symbol$ ["" ""]) + prime-name (symbol$ ["" (Text/append name "'")]) + type+ (replace-syntax (list [name (` ((~ prime-name) (~ g!param)))]) type)] + (#Some (` ((All (~ prime-name) [(~ g!param)] (~ type+)) + Void)))) + #None) + (case args + #Nil + (#Some type) + + _ + (#Some (` (All (~ type-name) [(~@ args)] (~ type)))))))] + (case type' + (#Some type'') + (return (list (` (;;def: (~@ (export-level exported?)) (~ type-name) + (~ ($_ meta-ast-merge (with-type-args args) + (if rec? (' {#;type-rec? true}) (' {})) + type-meta + meta)) + Type + (#;NamedT [(~ (text$ module-name)) + (~ (text$ name))] + (type (~ type''))))))) + + #None + (fail "Wrong syntax for type:")))) + + #None + (fail "Wrong syntax for type:")) + )) + +(type: Referrals + #All + (#Only (List Text)) + (#Exclude (List Text)) + #Nothing) + +(type: Openings + [Text (List Ident)]) + +(type: Refer + {#refer-defs Referrals + #refer-open (List Openings)}) + +(type: Importation + {#import-name Text + #import-alias (Maybe Text) + #import-refer Refer}) + +(def: (extract-defs defs) + (-> (List AST) (Lux (List Text))) + (mapM Monad + (: (-> AST (Lux Text)) + (lambda [def] + (case def + [_ (#SymbolS ["" name])] + (return name) + + _ + (fail "only/exclude requires symbols.")))) + defs)) + +(def: (parse-alias tokens) + (-> (List AST) (Lux [(Maybe Text) (List AST)])) + (case tokens + (^ (list& [_ (#TagS "" "as")] [_ (#SymbolS "" alias)] tokens')) + (return [(#Some alias) tokens']) + + _ + (return [#None tokens]))) + +(def: (parse-referrals tokens) + (-> (List AST) (Lux [Referrals (List AST)])) + (case tokens + (^ (list& [_ (#TagS ["" "refer"])] referral tokens')) + (case referral + [_ (#TagS "" "all")] + (return [#All tokens']) + + (^ [_ (#FormS (list& [_ (#TagS ["" "only"])] defs))]) + (do Monad + [defs' (extract-defs defs)] + (return [(#Only defs') tokens'])) + + (^ [_ (#FormS (list& [_ (#TagS ["" "exclude"])] defs))]) + (do Monad + [defs' (extract-defs defs)] + (return [(#Exclude defs') tokens'])) + + _ + (fail "Incorrect syntax for referral.")) + + _ + (return [#Nothing tokens]))) + +(def: (split-with' p ys xs) + (All [a] + (-> (-> a Bool) (List a) (List a) [(List a) (List a)])) + (case xs + #Nil + [ys xs] + + (#Cons x xs') + (if (p x) + (split-with' p (list& x ys) xs') + [ys xs]))) + +(def: (split-with p xs) + (All [a] + (-> (-> a Bool) (List a) [(List a) (List a)])) + (let [[ys' xs'] (split-with' p #Nil xs)] + [(reverse ys') xs'])) + +(def: (parse-short-referrals tokens) + (-> (List AST) (Lux [Referrals (List AST)])) + (case tokens + (^ (list& [_ (#TagS "" "+")] tokens')) + (let [[defs tokens'] (split-with symbol? tokens')] + (do Monad + [defs' (extract-defs defs)] + (return [(#Only defs') tokens']))) + + (^ (list& [_ (#TagS "" "-")] tokens')) + (let [[defs tokens'] (split-with symbol? tokens')] + (do Monad + [defs' (extract-defs defs)] + (return [(#Exclude defs') tokens']))) + + (^ (list& [_ (#TagS "" "*")] tokens')) + (return [#All tokens']) + + _ + (return [#Nothing tokens]))) + +(def: (extract-symbol syntax) + (-> AST (Lux Ident)) + (case syntax + [_ (#SymbolS ident)] + (return ident) + + _ + (fail "Not a symbol."))) + +(def: (parse-openings tokens) + (-> (List AST) (Lux [(List Openings) (List AST)])) + (case tokens + (^ (list& [_ (#TagS "" "open")] [_ (#FormS parts)] tokens')) + (if (|> parts + (map (: (-> AST Bool) + (lambda [part] + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true + + _ + false)))) + (fold (lambda [r l] (and l r)) true)) + (let [openings (fold (: (-> AST (List Openings) (List Openings)) + (lambda [part openings] + (case part + [_ (#TextS prefix)] + (list& [prefix (list)] openings) + + [_ (#SymbolS struct-name)] + (case openings + #Nil + (list ["" (list struct-name)]) + + (#Cons [prefix structs] openings') + (#Cons [prefix (#Cons struct-name structs)] openings')) + + _ + openings))) + (: (List Openings) (list)) + parts)] + (return [openings tokens'])) + (fail "Expected all parts of opening form to be of either prefix (text) or struct (symbol).")) + + _ + (return [(list) tokens]))) + +(def: (parse-short-openings parts) + (-> (List AST) (Lux [(List Openings) (List AST)])) + (if (|> parts + (map (: (-> AST Bool) + (lambda [part] + (case part + (^or [_ (#TextS _)] [_ (#SymbolS _)]) + true + + _ + false)))) + (fold (lambda [r l] (and l r)) true)) + (let [openings (fold (: (-> AST (List Openings) (List Openings)) + (lambda [part openings] + (case part + [_ (#TextS prefix)] + (list& [prefix (list)] openings) + + [_ (#SymbolS struct-name)] + (case openings + #Nil + (list ["" (list struct-name)]) + + (#Cons [prefix structs] openings') + (#Cons [prefix (#Cons struct-name structs)] openings')) + + _ + openings))) + (: (List Openings) (list)) + parts)] + (return [openings (list)])) + (fail "Expected all parts of opening form to be of either prefix (text) or struct (symbol)."))) + +(def: (decorate-sub-importations super-name) + (-> Text (List Importation) (List Importation)) + (map (: (-> Importation Importation) + (lambda [importation] + (let [{#import-name _name + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}} importation] + {#import-name ($_ Text/append super-name "/" _name) + #import-alias _alias + #import-refer {#refer-defs _referrals + #refer-open _openings}}))))) + +(def: (replace pattern value template) + (-> Text Text Text Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"] [template pattern value])) + +(def: (clean-module module) + (-> Text (Lux Text)) + (do Monad + [module-name current-module-name] + (case (split-module module) + (^ (list& "." parts)) + (return (|> (list& module-name parts) (interpose "/") reverse (fold Text/append ""))) + + parts + (let [[ups parts'] (split-with (Text/= "..") parts) + num-ups (length ups)] + (if (i= num-ups 0) + (return module) + (case (at num-ups (split-module-contexts module-name)) + #None + (fail (Text/append "Can't clean module: " module)) + + (#Some top-module) + (return (|> (list& top-module parts') (interpose "/") reverse (fold Text/append "")))) + ))) + )) + +(def: (parse-imports imports) + (-> (List AST) (Lux (List Importation))) + (do Monad + [imports' (mapM Monad + (: (-> AST (Lux (List Importation))) + (lambda [token] + (case token + [_ (#SymbolS "" m-name)] + (do Monad + [m-name (clean-module m-name)] + (wrap (list [m-name #None {#refer-defs #All #refer-open (list)}]))) + + (^ [_ (#FormS (list& [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + alias+extra (parse-alias extra) + #let [[alias extra] alias+extra] + referral+extra (parse-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-openings extra) + #let [[openings extra] openings+extra] + sub-imports (parse-imports extra) + #let [sub-imports (decorate-sub-importations m-name sub-imports)]] + (wrap (case [referral alias openings] + [#Nothing #None #Nil] sub-imports + _ (list& {#import-name m-name + #import-alias alias + #import-refer {#refer-defs referral + #refer-open openings}} + sub-imports)))) + + (^ [_ (#TupleS (list& [_ (#TextS alias)] [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + referral+extra (parse-short-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-short-openings extra) + #let [[openings extra] openings+extra]] + (wrap (list {#import-name m-name + #import-alias (#;Some (replace ";" m-name alias)) + #import-refer {#refer-defs referral + #refer-open openings}}))) + + (^ [_ (#TupleS (list& [_ (#SymbolS "" m-name)] extra))]) + (do Monad + [m-name (clean-module m-name) + referral+extra (parse-short-referrals extra) + #let [[referral extra] referral+extra] + openings+extra (parse-short-openings extra) + #let [[openings extra] openings+extra]] + (wrap (list {#import-name m-name + #import-alias (#;Some m-name) + #import-refer {#refer-defs referral + #refer-open openings}}))) + + _ + (do Monad + [current-module current-module-name] + (fail (Text/append "Wrong syntax for import @ " current-module)))))) + imports)] + (wrap (List/join imports')))) + +(def: (exported-defs module state) + (-> Text (Lux (List Text))) + (let [modules (case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + modules)] + (case (get module modules) + (#Some =module) + (let [to-alias (map (: (-> [Text Def] + (List Text)) + (lambda [[name [def-type def-meta def-value]]] + (case [(get-meta ["lux" "export?"] def-meta) + (get-meta ["lux" "hidden?"] def-meta)] + [(#Some (#BoolM true)) #;None] + (list name) + + _ + (list)))) + (let [{#module-hash _ #module-aliases _ #defs defs #imports _ #tags tags #types types #module-anns _} =module] + defs))] + (#Right state (List/join to-alias))) + + #None + (#Left ($_ Text/append "Unknown module: " module))) + )) + +(def: (filter p xs) + (All [a] (-> (-> a Bool) (List a) (List a))) + (case xs + #;Nil + (list) + + (#;Cons x xs') + (if (p x) + (#;Cons x (filter p xs')) + (filter p xs')))) + +(def: (is-member? cases name) + (-> (List Text) Text Bool) + (let [output (fold (lambda [case prev] + (or prev + (Text/= case name))) + false + cases)] + output)) + +(def: (try-both f x1 x2) + (All [a b] + (-> (-> a (Maybe b)) a a (Maybe b))) + (case (f x1) + #;None (f x2) + (#;Some y) (#;Some y))) + +(def: (find-in-env name state) + (-> Text Compiler (Maybe Type)) + (case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + (find (: (-> Scope (Maybe Type)) + (lambda [env] + (case env + {#name _ #inner-closures _ #locals {#counter _ #mappings locals} #closure {#counter _ #mappings closure}} + (try-both (find (: (-> [Text Analysis] (Maybe Type)) + (lambda [[bname [[type _] _]]] + (if (Text/= name bname) + (#Some type) + #None)))) + locals + closure)))) + scopes))) + +(def: (find-def-type name state) + (-> Ident Compiler (Maybe Type)) + (let [[v-prefix v-name] name + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case (get v-prefix modules) + #None + #None + + (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _}) + (case (get v-name defs) + #None + #None + + (#Some [def-type def-meta def-value]) + (#Some def-type))))) + +(def: (find-def-value name state) + (-> Ident (Lux [Type Unit])) + (let [[v-prefix v-name] name + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} state] + (case (get v-prefix modules) + #None + (#Left (Text/append "Unknown definition: " (Ident->Text name))) + + (#Some {#defs defs #module-hash _ #module-aliases _ #imports _ #tags tags #types types #module-anns _}) + (case (get v-name defs) + #None + (#Left (Text/append "Unknown definition: " (Ident->Text name))) + + (#Some [def-type def-meta def-value]) + (#Right [state [def-type def-value]]))))) + +(def: (find-type ident) + (-> Ident (Lux Type)) + (do Monad + [#let [[module name] ident] + current-module current-module-name] + (lambda [state] + (if (Text/= "" module) + (case (find-in-env name state) + (#Some struct-type) + (#Right state struct-type) + + _ + (case (find-def-type [current-module name] state) + (#Some struct-type) + (#Right state struct-type) + + _ + (#Left ($_ Text/append "Unknown var: " (Ident->Text ident))))) + (case (find-def-type ident state) + (#Some struct-type) + (#Right state struct-type) + + _ + (#Left ($_ Text/append "Unknown var: " (Ident->Text ident))))) + ))) + +(def: (zip2 xs ys) + (All [a b] (-> (List a) (List b) (List [a b]))) + (case xs + (#Cons x xs') + (case ys + (#Cons y ys') + (list& [x y] (zip2 xs' ys')) + + _ + (list)) + + _ + (list))) + +(def: (use-field prefix [module name] type) + (-> Text Ident Type (Lux [AST AST])) + (do Monad + [output (resolve-type-tags type) + pattern (: (Lux AST) + (case output + (#Some [tags members]) + (do Monad + [slots (mapM Monad + (: (-> [Ident Type] (Lux [AST AST])) + (lambda [[sname stype]] (use-field prefix sname stype))) + (zip2 tags members))] + (return (record$ slots))) + + #None + (return (symbol$ ["" (Text/append prefix name)]))))] + (return [(tag$ [module name]) pattern]))) + +(def: (Type/show type) + (-> Type Text) + (case type + (#HostT name params) + (case params + #;Nil + name + + _ + ($_ Text/append "(" name " " (|> params (map Type/show) (interpose " ") reverse (fold Text/append "")) ")")) + + #VoidT + "Void" + + #UnitT + "Unit" + + (#SumT _) + ($_ Text/append "(| " (|> (flatten-sum type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") + + (#ProdT _) + ($_ Text/append "[" (|> (flatten-prod type) (map Type/show) (interpose " ") reverse (fold Text/append "")) "]") + + (#LambdaT _) + ($_ Text/append "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") + + (#BoundT id) + (Nat->Text id) + + (#VarT id) + ($_ Text/append "⌈v:" (->Text id) "⌋") + + (#ExT id) + ($_ Text/append "⟨e:" (->Text id) "⟩") + + (#UnivQ env body) + ($_ Text/append "(All " (Type/show body) ")") + + (#ExQ env body) + ($_ Text/append "(Ex " (Type/show body) ")") + + (#AppT _) + ($_ Text/append "(" (|> (flatten-app type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") + + (#NamedT [prefix name] _) + ($_ Text/append prefix ";" name) + )) + +(macro: #hidden (^open' tokens) + (case tokens + (^ (list [_ (#SymbolS name)] [_ (#TextS prefix)] body)) + (do Monad + [struct-type (find-type name) + output (resolve-type-tags struct-type)] + (case output + (#Some [tags members]) + (do Monad + [slots (mapM Monad (: (-> [Ident Type] (Lux [AST AST])) + (lambda [[sname stype]] (use-field prefix sname stype))) + (zip2 tags members)) + #let [pattern (record$ slots)]] + (return (list (` (;_lux_case (~ (symbol$ name)) (~ pattern) (~ body)))))) + + _ + (fail (Text/append "Can only \"open\" structs: " (Type/show struct-type))))) + + _ + (fail "Wrong syntax for ^open"))) + +(macro: #export (^open tokens) + {#;doc "## Same as the \"open\" macro, but meant to be used as a pattern-matching macro for generating local bindings. + ## Can optionally take a \"prefix\" text for the generated local bindings. + (def: #export (range (^open) from to) + (All [a] (-> (Enum a) a a (List a))) + (range' <= succ from to))"} + (case tokens + (^ (list& [_ (#FormS (list [_ (#TextS prefix)]))] body branches)) + (do Monad + [g!temp (gensym "temp")] + (return (list& g!temp (` (^open' (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) + + (^ (list& [_ (#FormS (list))] body branches)) + (return (list& (` (;;^open "")) body branches)) + + _ + (fail "Wrong syntax for ^open"))) + +(macro: #export (cond tokens) + {#;doc "## Branching structures with multiple test conditions. + (cond (even? num) \"even\" + (odd? num) \"odd\" + ## else-branch + \"???\")"} + (if (i= 0 (i% (length tokens) 2)) + (fail "cond requires an even number of arguments.") + (case (reverse tokens) + (^ (list& else branches')) + (return (list (fold (: (-> [AST AST] AST AST) + (lambda [branch else] + (let [[right left] branch] + (` (if (~ left) (~ right) (~ else)))))) + else + (as-pairs branches')))) + + _ + (fail "Wrong syntax for cond")))) + +(def: (enumerate' idx xs) + (All [a] (-> Nat (List a) (List [Nat a]))) + (case xs + (#Cons x xs') + (#Cons [idx x] (enumerate' (n+ +1 idx) xs')) + + #Nil + #Nil)) + +(def: (enumerate xs) + (All [a] (-> (List a) (List [Nat a]))) + (enumerate' +0 xs)) + +(macro: #export (get@ tokens) + {#;doc "## Accesses the value of a record at a given tag. + (get@ #field my-record) + + ## Can also work with multiple levels of nesting: + (get@ [#foo #bar #baz] my-record) + + ## And, if only the slot/path is given, generates an + ## accessor function: + (let [getter (get@ [#foo #bar #baz])] + (getter my-record))"} + (case tokens + (^ (list [_ (#TagS slot')] record)) + (do Monad + [slot (normalize slot') + output (resolve-tag slot) + #let [[idx tags exported? type] output] + g!_ (gensym "_") + g!output (gensym "")] + (case (resolve-struct-type type) + (#Some members) + (let [pattern (record$ (map (: (-> [Ident [Nat Type]] [AST AST]) + (lambda [[[r-prefix r-name] [r-idx r-type]]] + [(tag$ [r-prefix r-name]) (if (n= idx r-idx) + g!output + g!_)])) + (zip2 tags (enumerate members))))] + (return (list (` (;_lux_case (~ record) (~ pattern) (~ g!output)))))) + + _ + (fail "get@ can only use records."))) + + (^ (list [_ (#TupleS slots)] record)) + (return (list (fold (: (-> AST AST AST) + (lambda [slot inner] + (` (;;get@ (~ slot) (~ inner))))) + record + slots))) + + (^ (list selector)) + (do Monad + [g!record (gensym "record")] + (wrap (list (` (lambda [(~ g!record)] (;;get@ (~ selector) (~ g!record))))))) + + _ + (fail "Wrong syntax for get@"))) + +(def: (open-field prefix [module name] source type) + (-> Text Ident AST Type (Lux (List AST))) + (do Monad + [output (resolve-type-tags type) + #let [source+ (` (get@ (~ (tag$ [module name])) (~ source)))]] + (case output + (#Some [tags members]) + (do Monad + [decls' (mapM Monad + (: (-> [Ident Type] (Lux (List AST))) + (lambda [[sname stype]] (open-field prefix sname source+ stype))) + (zip2 tags members))] + (return (List/join decls'))) + + _ + (return (list (` (;_lux_def (~ (symbol$ ["" (Text/append prefix name)])) (~ source+) + #Nil))))))) + +(macro: #export (open tokens) + {#;doc "## Opens a structure and generates a definition for each of its members (including nested members). + ## For example: + (open Number \"i:\") + ## Will generate: + (def: i:+ (:: Number +)) + (def: i:- (:: Number -)) + (def: i:* (:: Number *)) + ..."} + (case tokens + (^ (list& [_ (#SymbolS struct-name)] tokens')) + (do Monad + [@module current-module-name + #let [prefix (case tokens' + (^ (list [_ (#TextS prefix)])) + prefix + + _ + "")] + struct-type (find-type struct-name) + output (resolve-type-tags struct-type) + #let [source (symbol$ struct-name)]] + (case output + (#Some [tags members]) + (do Monad + [decls' (mapM Monad (: (-> [Ident Type] (Lux (List AST))) + (lambda [[sname stype]] (open-field prefix sname source stype))) + (zip2 tags members))] + (return (List/join decls'))) + + _ + (fail (Text/append "Can only \"open\" structs: " (Type/show struct-type))))) + + _ + (fail "Wrong syntax for open"))) + +(macro: #export (|>. tokens) + {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. + (|> (map ->Text) (interpose \" \") (fold Text/append \"\")) + ## => + (lambda [] + (fold Text/append \"\" + (interpose \" \" + (map ->Text ))))"} + (do Monad + [g!arg (gensym "arg")] + (return (list (` (lambda [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) + +(def: (imported-by? import-name module-name) + (-> Text Text (Lux Bool)) + (do Monad + [module (find-module module-name) + #let [{#module-hash _ #module-aliases _ #defs _ #imports imports #tags _ #types _ #module-anns _} module]] + (wrap (is-member? imports import-name)))) + +(macro: #export (default tokens state) + {#;doc "## Allows you to provide a default value that will be used + ## if a (Maybe x) value turns out to be #;Some. + (default 20 (#;Some 10)) => 10 + + (default 20 #;None) => 20"} + (case tokens + (^ (list else maybe)) + (let [g!temp (: AST [["" -1 -1] (#;SymbolS ["" ""])]) + code (` (case (~ maybe) + (#;Some (~ g!temp)) + (~ g!temp) + + #;None + (~ else)))] + (#;Right [state (list code)])) + + _ + (#;Left "Wrong syntax for ?"))) + +(def: (read-refer module-name options) + (-> Text (List AST) (Lux Refer)) + (do Monad + [referral+options (parse-referrals options) + #let [[referral options] referral+options] + openings+options (parse-openings options) + #let [[openings options] openings+options] + current-module current-module-name + #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) + (lambda [module-name all-defs referred-defs] + (mapM Monad + (: (-> Text (Lux Unit)) + (lambda [_def] + (if (is-member? all-defs _def) + (return []) + (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + referred-defs)))]] + (case options + #;Nil + (wrap {#refer-defs referral + #refer-open openings}) + + _ + (fail ($_ Text/append "Wrong syntax for refer @ " current-module + "\n" (|> options + (map ast-to-text) + (interpose " ") + (fold Text/append ""))))))) + +(def: (write-refer module-name [r-defs r-opens]) + (-> Text Refer (Lux (List AST))) + (do Monad + [current-module current-module-name + #let [test-referrals (: (-> Text (List Text) (List Text) (Lux (List Unit))) + (lambda [module-name all-defs referred-defs] + (mapM Monad + (: (-> Text (Lux Unit)) + (lambda [_def] + (if (is-member? all-defs _def) + (return []) + (fail ($_ Text/append _def " is not defined in module " module-name " @ " current-module))))) + referred-defs)))] + defs' (case r-defs + #All + (exported-defs module-name) + + (#Only +defs) + (do Monad + [*defs (exported-defs module-name) + _ (test-referrals module-name *defs +defs)] + (wrap +defs)) + + (#Exclude -defs) + (do Monad + [*defs (exported-defs module-name) + _ (test-referrals module-name *defs -defs)] + (wrap (filter (|>. (is-member? -defs) not) *defs))) + + #Nothing + (wrap (list))) + #let [defs (map (: (-> Text AST) + (lambda [def] + (` (;_lux_def (~ (symbol$ ["" def])) + (~ (symbol$ [module-name def])) + (#Cons [["lux" "alias"] (#IdentM [(~ (text$ module-name)) (~ (text$ def))])] + #Nil))))) + defs') + openings (join-map (: (-> Openings (List AST)) + (lambda [[prefix structs]] + (map (lambda [[_ name]] (` (open (~ (symbol$ [module-name name])) (~ (text$ prefix))))) + structs))) + r-opens)]] + (wrap (List/append defs openings)) + )) + +(macro: #export (refer tokens) + (case tokens + (^ (list& [_ (#TextS module-name)] options)) + (do Monad + [=refer (read-refer module-name options)] + (write-refer module-name =refer)) + + _ + (fail "Wrong syntax for refer"))) + +(def: (refer-to-ast module-name [r-defs r-opens]) + (-> Text Refer AST) + (let [=defs (: (List AST) + (case r-defs + #All + (list (' #refer) (' #all)) + + (#Only defs) + (list (' #refer) (`' (#only (~@ (map (|>. [""] symbol$) + defs))))) + + (#Exclude defs) + (list (' #refer) (`' (#exclude (~@ (map (|>. [""] symbol$) + defs))))) + + #Nothing + (list))) + =opens (join-map (lambda [[prefix structs]] + (list& (text$ prefix) (map symbol$ structs))) + r-opens)] + (` (;;refer (~ (text$ module-name)) + (~@ =defs) + (~' #open) ((~@ =opens)))))) + +(macro: #export (module: tokens) + {#;doc "## Examples + (;module: {#;doc \"Some documentation...\"} + lux + (lux (control (monad #as M #refer #all)) + (data (text #open (\"Text/\" Monoid)) + (struct (list #open (\"List/\" Monad))) + maybe + (ident #open (\"Ident/\" Codec))) + meta + (macro ast)) + (.. (type #open (\"\" Eq)))) + + (;module: {#;doc \"Some documentation...\"} + lux + (lux (control [\"M\" monad #*]) + (data [text \"Text/\" Monoid] + (struct [list \"List/\" Monad]) + maybe + [ident \"Ident/\" Codec]) + meta + (macro ast)) + (.. [type \"\" Eq]))"} + (do Monad + [#let [[_meta _imports] (: [(List [AST AST]) (List AST)] + (case tokens + (^ (list& [_ (#RecordS _meta)] _imports)) + [_meta _imports] + + _ + [(list) tokens]))] + imports (parse-imports _imports) + #let [=imports (map (: (-> Importation AST) + (lambda [[m-name m-alias =refer]] + (` [(~ (text$ m-name)) (~ (text$ (default "" m-alias)))]))) + imports) + =refers (map (: (-> Importation AST) + (lambda [[m-name m-alias =refer]] + (refer-to-ast m-name =refer))) + imports)] + =meta (process-def-meta (record$ (list& [(` #;imports) (` [(~@ =imports)])] + _meta))) + #let [=module (` (;_lux_module (~ =meta)))]] + (wrap (#;Cons =module =refers)))) + +(macro: #export (:: tokens) + {#;doc "## Allows accessing the value of a structure's member. + (:: Codec encode) + + ## Also allows using that value as a function. + (:: Codec encode 123)"} + (case tokens + (^ (list struct [_ (#SymbolS member)])) + (return (list (` (let [(^open) (~ struct)] (~ (symbol$ member)))))) + + (^ (list& struct [_ (#SymbolS member)] args)) + (return (list (` ((let [(^open) (~ struct)] (~ (symbol$ member))) (~@ args))))) + + _ + (fail "Wrong syntax for ::"))) + +(macro: #export (set@ tokens) + {#;doc "## Sets the value of a record at a given tag. + (set@ #name \"Lux\" lang) + + ## Can also work with multiple levels of nesting: + (set@ [#foo #bar #baz] value my-record) + + ## And, if only the slot/path and (optionally) the value are given, generates a + ## mutator function: + (let [setter (set@ [#foo #bar #baz] value)] + (setter my-record)) + + (let [setter (set@ [#foo #bar #baz])] + (setter value my-record))"} + (case tokens + (^ (list [_ (#TagS slot')] value record)) + (do Monad + [slot (normalize slot') + output (resolve-tag slot) + #let [[idx tags exported? type] output]] + (case (resolve-struct-type type) + (#Some members) + (do Monad + [pattern' (mapM Monad + (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) + (lambda [[r-slot-name [r-idx r-type]]] + (do Monad + [g!slot (gensym "")] + (return [r-slot-name r-idx g!slot])))) + (zip2 tags (enumerate members)))] + (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (lambda [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) r-var])) + pattern')) + output (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (lambda [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) (if (n= idx r-idx) + value + r-var)])) + pattern'))] + (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + + _ + (fail "set@ can only use records."))) + + (^ (list [_ (#TupleS slots)] value record)) + (case slots + #;Nil + (fail "Wrong syntax for set@") + + _ + (do Monad + [bindings (mapM Monad + (: (-> AST (Lux AST)) + (lambda [_] (gensym "temp"))) + slots) + #let [pairs (zip2 slots bindings) + update-expr (fold (: (-> [AST AST] AST AST) + (lambda [[s b] v] + (` (;;set@ (~ s) (~ v) (~ b))))) + value + (reverse pairs)) + [_ accesses'] (fold (: (-> [AST AST] [AST (List (List AST))] [AST (List (List AST))]) + (lambda [[new-slot new-binding] [old-record accesses']] + [(` (get@ (~ new-slot) (~ new-binding))) + (#;Cons (list new-binding old-record) accesses')])) + [record (: (List (List AST)) #;Nil)] + pairs) + accesses (List/join (reverse accesses'))]] + (wrap (list (` (let [(~@ accesses)] + (~ update-expr))))))) + + (^ (list selector value)) + (do Monad + [g!record (gensym "record")] + (wrap (list (` (lambda [(~ g!record)] (;;set@ (~ selector) (~ value) (~ g!record))))))) + + (^ (list selector)) + (do Monad + [g!value (gensym "value") + g!record (gensym "record")] + (wrap (list (` (lambda [(~ g!value) (~ g!record)] (;;set@ (~ selector) (~ g!value) (~ g!record))))))) + + _ + (fail "Wrong syntax for set@"))) + +(macro: #export (update@ tokens) + {#;doc "## Modifies the value of a record at a given tag, based on some function. + (update@ #age inc person) + + ## Can also work with multiple levels of nesting: + (update@ [#foo #bar #baz] func my-record) + + ## And, if only the slot/path and (optionally) the value are given, generates a + ## mutator function: + (let [updater (update@ [#foo #bar #baz] func)] + (updater my-record)) + + (let [updater (update@ [#foo #bar #baz])] + (updater func my-record))"} + (case tokens + (^ (list [_ (#TagS slot')] fun record)) + (do Monad + [slot (normalize slot') + output (resolve-tag slot) + #let [[idx tags exported? type] output]] + (case (resolve-struct-type type) + (#Some members) + (do Monad + [pattern' (mapM Monad + (: (-> [Ident [Nat Type]] (Lux [Ident Nat AST])) + (lambda [[r-slot-name [r-idx r-type]]] + (do Monad + [g!slot (gensym "")] + (return [r-slot-name r-idx g!slot])))) + (zip2 tags (enumerate members)))] + (let [pattern (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (lambda [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) r-var])) + pattern')) + output (record$ (map (: (-> [Ident Nat AST] [AST AST]) + (lambda [[r-slot-name r-idx r-var]] + [(tag$ r-slot-name) (if (n= idx r-idx) + (` ((~ fun) (~ r-var))) + r-var)])) + pattern'))] + (return (list (` (;_lux_case (~ record) (~ pattern) (~ output))))))) + + _ + (fail "update@ can only use records."))) + + (^ (list [_ (#TupleS slots)] fun record)) + (case slots + #;Nil + (fail "Wrong syntax for update@") + + _ + (do Monad + [g!record (gensym "record") + g!temp (gensym "temp")] + (wrap (list (` (let [(~ g!record) (~ record) + (~ g!temp) (get@ [(~@ slots)] (~ g!record))] + (set@ [(~@ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) + + (^ (list selector fun)) + (do Monad + [g!record (gensym "record")] + (wrap (list (` (lambda [(~ g!record)] (;;update@ (~ selector) (~ fun) (~ g!record))))))) + + (^ (list selector)) + (do Monad + [g!fun (gensym "fun") + g!record (gensym "record")] + (wrap (list (` (lambda [(~ g!fun) (~ g!record)] (;;update@ (~ selector) (~ g!fun) (~ g!record))))))) + + _ + (fail "Wrong syntax for update@"))) + +(macro: #export (^template tokens) + {#;doc "## It's similar to do-template, but meant to be used during pattern-matching. + (def: (beta-reduce env type) + (-> (List Type) Type Type) + (case type + (#;HostT name params) + (#;HostT name (List/map (beta-reduce env) params)) + + (^template [] + ( left right) + ( (beta-reduce env left) (beta-reduce env right))) + ([#;SumT] [#;ProdT]) + + (^template [] + ( left right) + ( (beta-reduce env left) (beta-reduce env right))) + ([#;LambdaT] + [#;AppT]) + + (^template [] + ( old-env def) + (case old-env + #;Nil + ( env def) + + _ + type)) + ([#;UnivQ] + [#;ExQ]) + + (#;BoundT idx) + (default type (list;at idx env)) + + (#;NamedT name type) + (beta-reduce env type) + + _ + type + ))"} + (case tokens + (^ (list& [_ (#FormS (list& [_ (#TupleS bindings)] templates))] + [_ (#FormS data)] + branches)) + (case (: (Maybe (List AST)) + (do Monad + [bindings' (mapM Monad get-name bindings) + data' (mapM Monad tuple->list data)] + (if (every? (i= (length bindings')) (map length data')) + (let [apply (: (-> RepEnv (List AST)) + (lambda [env] (map (apply-template env) templates)))] + (|> data' + (join-map (. apply (make-env bindings'))) + wrap)) + #;None))) + (#Some output) + (return (List/append output branches)) + + #None + (fail "Wrong syntax for ^template")) + + _ + (fail "Wrong syntax for ^template"))) + +(do-template [ ] + [(def: #export ( n) + (-> ) + (_lux_proc ["jvm" ] [n]))] + + [real-to-int Real Int "d2l"] + [int-to-real Int Real "l2d"] + ) + +(do-template [ <=-name> <=> + <<-doc> <<=-doc> <>-doc> <>=-doc>] + [(def: #export (<=-name> test subject) + {#;doc } + (-> Bool) + (_lux_proc [ <=>] [subject test])) + + (def: #export ( test subject) + {#;doc <<-doc>} + (-> Bool) + (_lux_proc [ ] [subject test])) + + (def: #export ( test subject) + {#;doc <<=-doc>} + (-> Bool) + (or (_lux_proc [ ] [subject test]) + (_lux_proc [ <=>] [subject test]))) + + (def: #export ( test subject) + {#;doc <>-doc>} + (-> Bool) + (_lux_proc [ ] [test subject])) + + (def: #export ( test subject) + {#;doc <>=-doc>} + (-> Bool) + (or (_lux_proc [ ] [test subject]) + (_lux_proc [ <=>] [subject test])))] + + [ Nat "nat" =+ "=" <+ <=+ "<" >+ >=+ + "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."] + + [ Int "jvm" = "leq" < <= "llt" > >= + "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] + + [Frac "frac" =.. "=" <.. <=.. "<" >.. >=.. + "Fractional equality." "Fractional less-than." "Fractional less-than-equal." "Fractional greater-than." "Fractional greater-than-equal."] + + [Real "jvm" =. "deq" <. <=. "dlt" >. >=. + "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] + ) + +(do-template [ ] + [(def: #export ( param subject) + {#;doc } + (-> ) + (_lux_proc [subject param]))] + + [ Nat ++ ["nat" "+"] "Nat(ural) addition."] + [ Nat -+ ["nat" "-"] "Nat(ural) substraction."] + [ Nat *+ ["nat" "*"] "Nat(ural) multiplication."] + [ Nat /+ ["nat" "/"] "Nat(ural) division."] + [ Nat %+ ["nat" "%"] "Nat(ural) remainder."] + + [ Int + ["jvm" "ladd"] "Int(eger) addition."] + [ Int - ["jvm" "lsub"] "Int(eger) substraction."] + [ Int * ["jvm" "lmul"] "Int(eger) multiplication."] + [ Int / ["jvm" "ldiv"] "Int(eger) division."] + [ Int % ["jvm" "lrem"] "Int(eger) remainder."] + + [Frac +.. ["frac" "+"] "Frac(tional) addition."] + [Frac -.. ["frac" "-"] "Frac(tional) substraction."] + [Frac *.. ["frac" "*"] "Frac(tional) multiplication."] + [Frac /.. ["frac" "/"] "Frac(tional) division."] + [Frac %.. ["frac" "%"] "Frac(tional) remainder."] + + [Real +. ["jvm" "dadd"] "Real addition."] + [Real -. ["jvm" "dsub"] "Real substraction."] + [Real *. ["jvm" "dmul"] "Real multiplication."] + [Real /. ["jvm" "ddiv"] "Real division."] + [Real %. ["jvm" "drem"] "Real remainder."] + ) + +(do-template [ ] + [(def: #export ( left right) + {#;doc } + (-> ) + (if ( right left) + left + right))] + + [min+ Nat <+ "Nat(ural) minimum."] + [max+ Nat >+ "Nat(ural) maximum."] + + [min Int < "Int(eger) minimum."] + [max Int > "Int(eger) maximum."] + + [min.. Frac <.. "Frac(tional) minimum."] + [max.. Frac >.. "Frac(tional) maximum."] + + [min. Real <. "Real minimum."] + [max. Real >. "Real minimum."] + ) + +(def: (find-baseline-column ast) + (-> AST Int) + (case ast + (^template [] + [[_ _ column] ( _)] + column) + ([#BoolS] + [#NatS] + [#IntS] + [#FracS] + [#RealS] + [#CharS] + [#TextS] + [#SymbolS] + [#TagS]) + + (^template [] + [[_ _ column] ( parts)] + (fold min column (map find-baseline-column parts))) + ([#FormS] + [#TupleS]) + + [[_ _ column] (#RecordS pairs)] + (fold min column + (List/append (map (. find-baseline-column first) pairs) + (map (. find-baseline-column second) pairs))) + )) + +(type: Doc-Fragment + (#Doc-Comment Text) + (#Doc-Example AST)) + +(def: (identify-doc-fragment ast) + (-> AST Doc-Fragment) + (case ast + [_ (#;TextS comment)] + (#Doc-Comment comment) + + _ + (#Doc-Example ast))) + +(def: (Char/encode x) + (-> Char Text) + (let [as-text (case x + #"\t" "\\t" + #"\b" "\\b" + #"\n" "\\n" + #"\r" "\\r" + #"\f" "\\f" + #"\"" "\\\"" + #"\\" "\\\\" + _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))] + ($_ Text/append "#\"" as-text "\""))) + +(def: (Text/encode original) + (-> Text Text) + (let [escaped (|> original + (replace "\t" "\\t") + (replace "\b" "\\b") + (replace "\n" "\\n") + (replace "\r" "\\r") + (replace "\f" "\\f") + (replace "\"" "\\\"") + (replace "\\" "\\\\") + )] + ($_ Text/append "\"" escaped "\""))) + +(do-template [ ] + [(def: #export + (-> Int Int) + (i+ ))] + + [inc 1] + [dec -1]) + +(def: tag->Text + (-> Ident Text) + (. (Text/append "#") Ident->Text)) + +(def: (repeat n x) + (All [a] (-> Int a (List a))) + (if (i> n 0) + (#;Cons x (repeat (i+ -1 n) x)) + #;Nil)) + +(def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) + (-> Int Cursor Cursor Text) + (if (i= old-line new-line) + (Text/join (repeat (i- new-column old-column) " ")) + (let [extra-lines (Text/join (repeat (i- new-line old-line) "\n")) + space-padding (Text/join (repeat (i- new-column baseline) " "))] + (Text/append extra-lines space-padding)))) + +(def: (Text/size x) + (-> Text Int) + (_lux_proc ["jvm" "i2l"] + [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])])) + +(def: (Text/trim x) + (-> Text Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.String:trim:"] [x])) + +(def: (update-cursor [file line column] ast-text) + (-> Cursor Text Cursor) + [file line (i+ column (Text/size ast-text))]) + +(def: (delim-update-cursor [file line column]) + (-> Cursor Cursor) + [file line (inc column)]) + +(def: rejoin-all-pairs + (-> (List [AST AST]) (List AST)) + (. List/join (map rejoin-pair))) + +(def: (doc-example->Text prev-cursor baseline example) + (-> Cursor Int AST [Cursor Text]) + (case example + (^template [ ] + [new-cursor ( value)] + (let [as-text ( value)] + [(update-cursor new-cursor as-text) + (Text/append (cursor-padding baseline prev-cursor new-cursor) + as-text)])) + ([#BoolS ->Text] + [#NatS Nat->Text] + [#IntS ->Text] + [#FracS Frac->Text] + [#RealS ->Text] + [#CharS Char/encode] + [#TextS Text/encode] + [#SymbolS Ident->Text] + [#TagS tag->Text]) + + (^template [ ] + [group-cursor ( parts)] + (let [[group-cursor' parts-text] (fold (lambda [part [last-cursor text-accum]] + (let [[part-cursor part-text] (doc-example->Text last-cursor baseline part)] + [part-cursor (Text/append text-accum part-text)])) + [(delim-update-cursor group-cursor) ""] + ( parts))] + [(delim-update-cursor group-cursor') + ($_ Text/append (cursor-padding baseline prev-cursor group-cursor) + + parts-text + )])) + ([#FormS "(" ")" id] + [#TupleS "[" "]" id] + [#RecordS "{" "}" rejoin-all-pairs]) + )) + +(def: (with-baseline baseline [file line column]) + (-> Int Cursor Cursor) + [file line baseline]) + +(def: (doc-fragment->Text fragment) + (-> Doc-Fragment Text) + (case fragment + (#Doc-Comment comment) + (|> comment + (split-text "\n") + (map (lambda [line] ($_ Text/append "## " line "\n"))) + Text/join) + + (#Doc-Example example) + (let [baseline (find-baseline-column example) + [cursor _] example + [_ text] (doc-example->Text (with-baseline baseline cursor) baseline example)] + (Text/append text "\n\n")))) + +(macro: #export (doc tokens) + {#;doc "Creates code documentation, embedding text as comments and properly formatting the forms it's being given. + + ## For Example: + (doc + \"Allows arbitrary looping, using the \\\"recur\\\" form to re-start the loop. + Can be used in monadic code to create monadic loops.\" + (loop [count 0 + x init] + (if (< 10 count) + (recur (inc count) (f x)) + x)))"} + (return (list (` (#;TextM (~ (|> tokens + (map (. doc-fragment->Text identify-doc-fragment)) + Text/join + Text/trim + text$))))))) + +(def: (interleave xs ys) + (All [a] (-> (List a) (List a) (List a))) + (case xs + #Nil + #Nil + + (#Cons x xs') + (case ys + #Nil + #Nil + + (#Cons y ys') + (list& x y (interleave xs' ys'))))) + +(def: (type->ast type) + (-> Type AST) + (case type + (#HostT name params) + (` (#HostT (~ (text$ name)) (~ (untemplate-list (map type->ast params))))) + + #VoidT + (` #VoidT) + + #UnitT + (` #UnitT) + + (^template [] + ( left right) + (` ( (~ (type->ast left)) (~ (type->ast right))))) + ([#SumT] [#ProdT]) + + (#LambdaT in out) + (` (#LambdaT (~ (type->ast in)) (~ (type->ast out)))) + + (#BoundT idx) + (` (#BoundT (~ (nat$ idx)))) + + (#VarT id) + (` (#VarT (~ (nat$ id)))) + + (#ExT id) + (` (#ExT (~ (nat$ id)))) + + (#UnivQ env type) + (let [env' (untemplate-list (map type->ast env))] + (` (#UnivQ (~ env') (~ (type->ast type))))) + + (#ExQ env type) + (let [env' (untemplate-list (map type->ast env))] + (` (#ExQ (~ env') (~ (type->ast type))))) + + (#AppT fun arg) + (` (#AppT (~ (type->ast fun)) (~ (type->ast arg)))) + + (#NamedT [module name] type) + (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->ast type)))) + )) + +(macro: #export (loop tokens) + {#;doc (doc "Allows arbitrary looping, using the \"recur\" form to re-start the loop." + "Can be used in monadic code to create monadic loops." + (loop [count 0 + x init] + (if (< 10 count) + (recur (inc count) (f x)) + x)))} + (case tokens + (^ (list [_ (#TupleS bindings)] body)) + (let [pairs (as-pairs bindings) + vars (map first pairs) + inits (map second pairs)] + (if (every? symbol? inits) + (do Monad + [inits' (: (Lux (List Ident)) + (case (mapM Monad get-ident inits) + (#Some inits') (return inits') + #None (fail "Wrong syntax for loop"))) + init-types (mapM Monad find-type inits') + expected get-expected-type] + (return (list (` ((;_lux_: (-> (~@ (map type->ast init-types)) + (~ (type->ast expected))) + (lambda (~ (symbol$ ["" "recur"])) [(~@ vars)] + (~ body))) + (~@ inits)))))) + (do Monad + [aliases (mapM Monad + (: (-> AST (Lux AST)) + (lambda [_] (gensym ""))) + inits)] + (return (list (` (let [(~@ (interleave aliases inits))] + (;loop [(~@ (interleave vars aliases))] + (~ body))))))))) + + _ + (fail "Wrong syntax for loop"))) + +(macro: #export (^slots tokens) + {#;doc (doc "Allows you to extract record members as local variables with the same names." + "For example:" + (let [(^slots [#foo #bar #baz]) quux] + (f foo bar baz)))} + (case tokens + (^ (list& [_ (#FormS (list [_ (#TupleS (list& hslot' tslots'))]))] body branches)) + (do Monad + [slots (: (Lux [Ident (List Ident)]) + (case (: (Maybe [Ident (List Ident)]) + (do Monad + [hslot (get-tag hslot') + tslots (mapM Monad get-tag tslots')] + (wrap [hslot tslots]))) + (#Some slots) + (return slots) + + #None + (fail "Wrong syntax for ^slots"))) + #let [[hslot tslots] slots] + hslot (normalize hslot) + tslots (mapM Monad normalize tslots) + output (resolve-tag hslot) + g!_ (gensym "_") + #let [[idx tags exported? type] output + slot-pairings (map (: (-> Ident [Text AST]) + (lambda [[module name]] [name (symbol$ ["" name])])) + (list& hslot tslots)) + pattern (record$ (map (: (-> Ident [AST AST]) + (lambda [[module name]] + (let [tag (tag$ [module name])] + (case (get name slot-pairings) + (#Some binding) [tag binding] + #None [tag g!_])))) + tags))]] + (return (list& pattern body branches))) + + _ + (fail "Wrong syntax for ^slots"))) + +(def: (place-tokens label tokens target) + (-> Text (List AST) AST (Maybe (List AST))) + (case target + (^or [_ (#BoolS _)] [_ (#NatS _)] [_ (#IntS _)] [_ (#FracS _)] [_ (#RealS _)] [_ (#CharS _)] [_ (#TextS _)] [_ (#TagS _)]) + (#Some (list target)) + + [_ (#SymbolS [prefix name])] + (if (and (Text/= "" prefix) + (Text/= label name)) + (#Some tokens) + (#Some (list target))) + + (^template [ ] + [_ ( elems)] + (do Monad + [placements (mapM Monad (place-tokens label tokens) elems)] + (wrap (list ( (List/join placements)))))) + ([#TupleS tuple$] + [#FormS form$]) + + [_ (#RecordS pairs)] + (do Monad + [=pairs (mapM Monad + (: (-> [AST AST] (Maybe [AST AST])) + (lambda [[slot value]] + (do Monad + [slot' (place-tokens label tokens slot) + value' (place-tokens label tokens value)] + (case [slot' value'] + (^ [(list =slot) (list =value)]) + (wrap [=slot =value]) + + _ + #None)))) + pairs)] + (wrap (list (record$ =pairs)))) + )) + +(macro: #export (let% tokens) + {#;doc (doc "Controlled macro-expansion." + "Bind an arbitraty number of ASTs resulting from macro-expansion to local bindings." + "Wherever a binding appears, the bound ASTs will be spliced in there." + (test: "AST operations & structures" + (let% [ (do-template [ ] + [(compare ) + (compare (:: AST/Show show )) + (compare true (:: Eq = ))] + + [(bool true) "true" [["" -1 -1] (#;BoolS true)]] + [(bool false) "false" [_ (#;BoolS false)]] + [(int 123) "123" [_ (#;IntS 123)]] + [(real 123.0) "123.0" [_ (#;RealS 123.0)]] + [(char #"\n") "#\"\\n\"" [_ (#;CharS #"\n")]] + [(text "\n") "\"\\n\"" [_ (#;TextS "\n")]] + [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;TagS ["yolo" "lol"])]] + [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;SymbolS ["yolo" "lol"])]] + [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;FormS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] + [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;TupleS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] + [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;RecordS (list [[_ (#;BoolS true)] [_ (#;IntS 123)]]))])] + [(local-tag "lol") "#lol" [_ (#;TagS ["" "lol"])]] + [(local-symbol "lol") "lol" [_ (#;SymbolS ["" "lol"])]] + )] + (test-all ))))} + (case tokens + (^ (list& [_ (#TupleS bindings)] bodies)) + (case bindings + (^ (list& [_ (#SymbolS ["" var-name])] macro-expr bindings')) + (do Monad + [expansion (macro-expand-once macro-expr)] + (case (place-tokens var-name expansion (` (;let% [(~@ bindings')] (~@ bodies)))) + (#Some output) + (wrap output) + + _ + (fail "[let%] Improper macro expansion."))) + + #Nil + (return bodies) + + _ + (fail "Wrong syntax for let%")) + + _ + (fail "Wrong syntax for let%"))) + +(def: (flatten-alias type) + (-> Type Type) + (case type + (^template [] + (#NamedT ["lux" ] _) + type) + (["Bool"] + ["Nat"] + ["Int"] + ["Frac"] + ["Real"] + ["Char"] + ["Text"]) + + (#NamedT _ type') + type' + + _ + type)) + +(def: (anti-quote-def name) + (-> Ident (Lux AST)) + (do Monad + [type+value (find-def-value name) + #let [[type value] type+value]] + (case (flatten-alias type) + (^template [ ] + (#NamedT ["lux" ] _) + (wrap ( (:! value)))) + (["Bool" Bool bool$] + ["Nat" Nat nat$] + ["Int" Int int$] + ["Frac" Frac frac$] + ["Real" Real real$] + ["Char" Char char$] + ["Text" Text text$]) + + _ + (fail (Text/append "Can't anti-quote type: " (Ident->Text name)))))) + +(def: (anti-quote token) + (-> AST (Lux AST)) + (case token + [_ (#SymbolS [def-prefix def-name])] + (if (Text/= "" def-prefix) + (:: Monad return token) + (anti-quote-def [def-prefix def-name])) + + (^template [] + [meta ( parts)] + (do Monad + [=parts (mapM Monad anti-quote parts)] + (wrap [meta ( =parts)]))) + ([#FormS] + [#TupleS]) + + [meta (#RecordS pairs)] + (do Monad + [=pairs (mapM Monad + (: (-> [AST AST] (Lux [AST AST])) + (lambda [[slot value]] + (do Monad + [=value (anti-quote value)] + (wrap [slot =value])))) + pairs)] + (wrap [meta (#RecordS =pairs)])) + + _ + (:: Monad return token) + )) + +(macro: #export (^~ tokens) + {#;doc (doc "Use global defs with simple values, such as text, int, real, bool and char, in place of literals in patterns." + "The definitions must be properly-qualified (though you may use one of the short-cuts Lux provides)." + (def: (empty?' node) + (All [K V] (-> (Node K V) Bool)) + (case node + (^~ (#Base ;;clean-bitmap _)) + true + + _ + false)))} + (case tokens + (^ (list& [_ (#FormS (list pattern))] body branches)) + (do Monad + [module-name current-module-name + pattern+ (macro-expand-all pattern)] + (case pattern+ + (^ (list pattern')) + (do Monad + [pattern'' (anti-quote pattern')] + (wrap (list& pattern'' body branches))) + + _ + (fail "^~ can only expand to 1 pattern."))) + + _ + (fail "Wrong syntax for ^~"))) + +(type: MultiLevelCase + [AST (List [AST AST])]) + +(def: (case-level^ level) + (-> AST (Lux [AST AST])) + (case level + (^ [_ (#;RecordS (list [expr binding]))]) + (return [expr binding]) + + _ + (return [level (` true)]) + )) + +(def: (multi-level-case^ levels) + (-> (List AST) (Lux MultiLevelCase)) + (case levels + #;Nil + (fail "Multi-level patterns can't be empty.") + + (#;Cons init extras) + (do Monad + [extras' (mapM Monad case-level^ extras)] + (wrap [init extras'])))) + +(def: (multi-level-case$ g!_ [[init-pattern levels] body]) + (-> AST [MultiLevelCase AST] (List AST)) + (let [inner-pattern-body (fold (lambda [[calculation pattern] success] + (` (case (~ calculation) + (~ pattern) + (~ success) + + (~ g!_) + #;None))) + (` (#;Some (~ body))) + (: (List [AST AST]) (reverse levels)))] + (list init-pattern inner-pattern-body))) + +(macro: #export (^=> tokens) + {#;doc (doc "Multi-level pattern matching." + "Useful in situations where the result of a branch depends on further refinements on the values being matched." + "For example:" + (case (split (size static) uri) + (^=> (#;Some [chunk uri']) {(Text/= static chunk) true}) + (match-uri endpoint? parts' uri') + + _ + (#;Left (format "Static part " (%t static) " doesn't match URI: " uri))) + + "Short-cuts can be taken when using boolean tests." + "The example above can be rewritten as..." + (case (split (size static) uri) + (^=> (#;Some [chunk uri']) (Text/= static chunk)) + (match-uri endpoint? parts' uri') + + _ + (#;Left (format "Static part " (%t static) " doesn't match URI: " uri))))} + (case tokens + (^ (list& [_meta (#;FormS levels)] body next-branches)) + (do Monad + [mlc (multi-level-case^ levels) + expected get-expected-type + g!temp (gensym "temp")] + (let [output (list g!temp + (` (;_lux_case (;_lux_: (#;AppT Maybe (~ (type->ast expected))) + (case (~ g!temp) + (~@ (multi-level-case$ g!temp [mlc body])) + + (~ g!temp) + #;None)) + (#;Some (~ g!temp)) + (~ g!temp) + + #;None + (case (~ g!temp) + (~@ next-branches)))))] + (wrap output))) + + _ + (fail "Wrong syntax for ^=>"))) + +(macro: #export (ident-for tokens) + {#;doc (doc "Given a symbol or a tag, gives back a 2 tuple with the prefix and name parts, both as Text." + (ident-for #;doc) + "=>" + ["lux" "doc"])} + (case tokens + (^template [] + (^ (list [_ ( [prefix name])])) + (return (list (` [(~ (text$ prefix)) (~ (text$ name))])))) + ([#;SymbolS] [#;TagS]) + + _ + (fail "Wrong syntax for ident-for"))) + +(do-template [ <%> <=> <0> <2>] + [(def: #export ( n) + (-> Bool) + (<=> <0> (<%> n <2>))) + + (def: #export ( n) + (-> Bool) + (not ( n)))] + + [Nat even?+ odd?+ n% n= +0 +2] + [Int even? odd? i% i= 0 2]) + +(def: (get-scope-type-vars state) + (Lux (List Nat)) + (case state + {#info info #source source #modules modules + #scopes scopes #type-vars types #host host + #seed seed #expected expected #cursor cursor + #scope-type-vars scope-type-vars} + (#Right state scope-type-vars) + )) + +(def: (list-at idx xs) + (All [a] (-> Int (List a) (Maybe a))) + (case xs + #;Nil + #;None + + (#;Cons x xs') + (if (i= 0 idx) + (#;Some x) + (list-at (dec idx) xs')))) + +(macro: #export ($ tokens) + (case tokens + (^ (list [_ (#IntS idx)])) + (do Monad + [stvs get-scope-type-vars] + (case (list-at idx (reverse stvs)) + (#;Some var-id) + (wrap (list (` (#ExT (~ (nat$ var-id)))))) + + #;None + (fail (Text/append "Indexed-type doesn't exist: " (->Text idx))))) + + _ + (fail "Wrong syntax for $"))) + +(def: #export (== left right) + {#;doc (doc "Tests whether the 2 values are identical (not just \"equal\")." + "This one should succeed:" + (let [value 5] + (== 5 5)) + + "This one should fail:" + (== 5 (+ 2 3)))} + (All [a] (-> a a Bool)) + (_lux_proc ["lux" "=="] [left right])) + +(macro: #export (^@ tokens) + {#;doc (doc "Allows you to simultaneously bind and de-structure a value." + (def: (hash (^@ set [a/Hash _])) + (List/fold (lambda [elem acc] (+ (:: a/Hash hash elem) acc)) + 0 + (->List set))))} + (case tokens + (^ (list& [_meta (#;FormS (list [_ (#;SymbolS ["" name])] pattern))] body branches)) + (let [g!whole (symbol$ ["" name])] + (return (list& g!whole + (` (case (~ g!whole) (~ pattern) (~ body))) + branches))) + + _ + (fail "Wrong syntax for ^@"))) + +(macro: #export (^|> tokens) + (case tokens + (^ (list& [_meta (#;FormS (list [_ (#;SymbolS ["" name])] [_ (#;TupleS steps)]))] body branches)) + (let [g!name (symbol$ ["" name])] + (return (list& g!name + (` (let [(~ g!name) (|> (~ g!name) (~@ steps))] + (~ body))) + branches))) + + _ + (fail "Wrong syntax for ^|>"))) + +(macro: #export (:!! tokens) + {#;doc (doc "Coerces the given expression to the type of whatever is expected." + (: Dinosaur (:!! (list 1 2 3))))} + (case tokens + (^ (list expr)) + (do Monad + [type get-expected-type] + (wrap (list (` (;_lux_:! (~ (type->ast type)) (~ expr)))))) + + _ + (fail "Wrong syntax for :!!"))) + +(def: #export (error! message) + {#;doc (doc "Causes an error, with the given error message." + (error! "OH NO!"))} + (-> Text Bottom) + (_lux_proc ["jvm" "throw"] [(_lux_proc ["jvm" "new:java.lang.Error:java.lang.String"] [message])])) + +(def: #hidden hack_Text/append + (-> Text Text Text) + Text/append) + +(def: get-cursor + (Lux Cursor) + (lambda [state] + (let [{#;info info #;source source #;modules modules #;scopes scopes + #;type-vars types #;host host #;seed seed + #;expected expected #;cursor cursor + #;scope-type-vars scope-type-vars} state] + (#;Right [state cursor])))) + +(macro: #export (with-cursor tokens) + {#;doc (doc "Given some text, appends to it a prefix for identifying where the text comes from." + "For example:" + (with-cursor (format "User: " user-id)) + "Would be the same as:" + (format "[the-module,the-line,the-column] " (format "User: " user-id)))} + (case tokens + (^ (list message)) + (do Monad + [cursor get-cursor] + (let [[module line column] cursor + cursor-prefix ($_ hack_Text/append "[" module "," (->Text line) "," (->Text column) "] ")] + (wrap (list (` (hack_Text/append (~ (text$ cursor-prefix)) (~ message))))))) + + _ + (fail "Wrong syntax for @"))) + +(macro: #export (undefined tokens) + {#;doc (doc "Meant to be used as a stand-in for functions with undefined implementations." + (def: (square x) + (-> Int Int) + (undefined)))} + (case tokens + #;Nil + (return (list (` (error! (with-cursor "Undefined behavior."))))) + + _ + (fail "Wrong syntax for undefined"))) + +(macro: #export (@pre tokens) + (case tokens + (^ (list test expr)) + (return (list (` (if (~ test) + (~ expr) + (error! (with-cursor (~ (text$ (Text/append "Pre-condition failed: " (ast-to-text test)))))))))) + + _ + (fail "Wrong syntax for @pre"))) + +(macro: #export (@post tokens) + (case tokens + (^ (list test pattern expr)) + (do Monad + [g!output (gensym "") + exp-type get-expected-type] + (wrap (list (` (let [(~ g!output) (: (~ (type->ast exp-type)) (~ expr)) + (~ pattern) (~ g!output)] + (if (~ test) + (~ g!output) + (error! (with-cursor (~ (text$ (Text/append "Post-condition failed: " (ast-to-text test)))))))))))) + + _ + (fail "Wrong syntax for @post"))) + +(do-template [ ] + [(def: #export ( input) + (-> ) + (_lux_proc [input]))] + + [int-to-nat ["int" "to-nat"] Int Nat] + [nat-to-int ["nat" "to-int"] Nat Int] + + [real-to-frac ["real" "to-frac"] Real Frac] + [frac-to-real ["frac" "to-real"] Frac Real] + ) + +(do-template [ ] + [(def: #export + (-> Nat Nat) + ( +1))] + + [inc+ ++] + [dec+ -+]) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux new file mode 100644 index 000000000..d9039df13 --- /dev/null +++ b/stdlib/source/lux/cli.lux @@ -0,0 +1,271 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + [lux #- not] + (lux (control functor + applicative + monad) + (data (struct (list #as list #open ("List/" Monoid Monad))) + (text #as text #open ("Text/" Monoid)) + error + (sum #as sum)) + (codata [io]) + [compiler #+ with-gensyms Functor Monad] + (macro [ast] + ["s" syntax #+ syntax: Syntax]))) + +## [Types] +(type: #export (CLI a) + (-> (List Text) (Error [(List Text) a]))) + +## [Utils] +(def: (run' opt inputs) + (All [a] (-> (CLI a) (List Text) (Error [(List Text) a]))) + (opt inputs)) + +## [Structures] +(struct: #export _ (Functor CLI) + (def: (map f ma inputs) + (case (ma inputs) + (#;Left msg) (#;Left msg) + (#;Right [inputs' datum]) (#;Right [inputs' (f datum)])))) + +(struct: #export _ (Applicative CLI) + (def: functor Functor) + + (def: (wrap a inputs) + (#;Right [inputs a])) + + (def: (apply ff fa inputs) + (case (ff inputs) + (#;Right [inputs' f]) + (case (fa inputs') + (#;Right [inputs'' a]) + (#;Right [inputs'' (f a)]) + + (#;Left msg) + (#;Left msg)) + + (#;Left msg) + (#;Left msg)) + )) + +(struct: #export _ (Monad CLI) + (def: applicative Applicative) + + (def: (join mma inputs) + (case (mma inputs) + (#;Left msg) (#;Left msg) + (#;Right [inputs' ma]) (ma inputs')))) + +## [Combinators] +(def: #export any + {#;doc "Just returns the next input without applying any logic."} + (CLI Text) + (lambda [inputs] + (case inputs + (#;Cons arg inputs') + (#;Right [inputs' arg]) + + _ + (#;Left "Can't extract from empty arguments.")))) + +(def: #export (parse parser option) + {#;doc "Parses the next input with a parsing function."} + (All [a] (-> (-> Text (Error a)) (CLI Text) (CLI a))) + (lambda [inputs] + (case (option inputs) + (#;Right [inputs' input]) + (case (parser input) + (#;Right value) + (#;Right [inputs' value]) + + (#;Left parser-error) + (#;Left parser-error)) + + (#;Left option-error) + (#;Left option-error) + ))) + +(def: #export (option names) + {#;doc "Checks that a given option (with multiple possible names) has a value."} + (-> (List Text) (CLI Text)) + (lambda [inputs] + (let [[pre post] (list;split-with (. ;not (list;member? text;Eq names)) inputs)] + (case post + #;Nil + (#;Left ($_ Text/append "Missing option (" (text;join-with " " names) ")")) + + (^ (list& _ value post')) + (#;Right [(List/append pre post') value]) + + _ + (#;Left ($_ Text/append "Option lacks value (" (text;join-with " " names) ")")) + )))) + +(def: #export (flag names) + {#;doc "Checks that a given flag (with multiple possible names) is set."} + (-> (List Text) (CLI Bool)) + (lambda [inputs] + (let [[pre post] (list;split-with (. ;not (list;member? text;Eq names)) inputs)] + (case post + #;Nil + (#;Right [pre false]) + + (#;Cons _ post') + (#;Right [(List/append pre post') true]))))) + +(def: #export end + {#;doc "Ensures there are no more inputs."} + (CLI Unit) + (lambda [inputs] + (case inputs + #;Nil (#;Right [inputs []]) + _ (#;Left (Text/append "Unknown parameters: " (text;join-with " " inputs)))))) + +(def: #export (assert test message) + (-> Bool Text (CLI Unit)) + (lambda [inputs] + (if test + (#;Right [inputs []]) + (#;Left message)))) + +(def: #export (opt opt) + {#;doc "Optionality combinator."} + (All [a] + (-> (CLI a) (CLI (Maybe a)))) + (lambda [inputs] + (case (opt inputs) + (#;Left _) (#;Right [inputs #;None]) + (#;Right [inputs' x]) (#;Right [inputs' (#;Some x)])))) + +(def: #export (seq optL optR) + {#;doc "Sequencing combinator."} + (All [a b] (-> (CLI a) (CLI b) (CLI [a b]))) + (do Monad + [l optL + r optR] + (wrap [l r]))) + +(def: #export (alt optL optR) + {#;doc "Heterogeneous alternative combinator."} + (All [a b] (-> (CLI a) (CLI b) (CLI (| a b)))) + (lambda [inputs] + (case (optL inputs) + (#;Left msg) + (case (optR inputs) + (#;Left _) + (#;Left msg) + + (#;Right [inputs' r]) + (#;Right [inputs' (sum;right r)])) + + (#;Right [inputs' l]) + (#;Right [inputs' (sum;left l)])))) + +(def: #export (not opt) + (All [a] (-> (CLI a) (CLI Unit))) + (lambda [inputs] + (case (opt inputs) + (#;Left msg) + (#;Right [inputs []]) + + _ + (#;Left "Expected to fail; yet succeeded.")))) + +(def: #export (some opt) + {#;doc "0-or-more combinator."} + (All [a] + (-> (CLI a) (CLI (List a)))) + (lambda [inputs] + (case (opt inputs) + (#;Left _) (#;Right [inputs (list)]) + (#;Right [inputs' x]) (run' (do Monad + [xs (some opt)] + (wrap (list& x xs))) + inputs')))) + +(def: #export (many opt) + {#;doc "1-or-more combinator."} + (All [a] + (-> (CLI a) (CLI (List a)))) + (do Monad + [x opt + xs (some opt)] + (wrap (list& x xs)))) + +(def: #export (either pl pr) + {#;doc "Homogeneous alternative combinator."} + (All [a] + (-> (CLI a) (CLI a) (CLI a))) + (lambda [inputs] + (case (pl inputs) + (#;Left _) (pr inputs) + output output))) + +(def: #export (run opt inputs) + (All [a] (-> (CLI a) (List Text) (Error a))) + (case (opt inputs) + (#;Left msg) + (#;Left msg) + + (#;Right [_ value]) + (#;Right value))) + +## [Syntax] +(type: Program-Args + (#Raw-Program-Args Text) + (#Parsed-Program-Args (List [Text AST]))) + +(def: program-args^ + (Syntax Program-Args) + (s;alt s;local-symbol + (s;form (s;some (s;either (do s;Monad + [name s;local-symbol] + (wrap [name (` any)])) + (s;record (s;seq s;local-symbol s;any))))))) + +(syntax: #export (program: {args program-args^} body) + {#;doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)." + "Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module." + (program: all-args + (do Monad + [foo init-program + bar (do-something all-args)] + (wrap []))) + + (program: (name) + (io (log! (Text/append "Hello, " name)))) + + (program: ([config config^]) + (do Monad + [data (init-program config)] + (do-something data))))} + (case args + (#Raw-Program-Args args) + (wrap (list (` (;_lux_program (~ (ast;symbol ["" args])) + (~ body))))) + + (#Parsed-Program-Args args) + (with-gensyms [g!args g!_ g!output g!message] + (wrap (list (` (;_lux_program (~ g!args) + (case ((: (CLI (io;IO Unit)) + (do Monad + [(~@ (|> args + (List/map (lambda [[name parser]] + (list (ast;symbol ["" name]) parser))) + List/join)) + (~ g!_) end] + ((~' wrap) (~ body)))) + (~ g!args)) + (#;Right [(~ g!_) (~ g!output)]) + (~ g!output) + + (#;Left (~ g!message)) + (error! (~ g!message)) + ))) + ))) + )) diff --git a/stdlib/source/lux/codata/cont.lux b/stdlib/source/lux/codata/cont.lux new file mode 100644 index 000000000..b851d417c --- /dev/null +++ b/stdlib/source/lux/codata/cont.lux @@ -0,0 +1,64 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (macro (ast #as ast)) + (control (functor #as F #refer #all) + (applicative #as A #refer #all) + (monad #as M #refer #all)) + (data (struct list))) + (.. function)) + +## [Types] +(type: #export (Cont a) + (All [b] + (-> (-> a b) b))) + +## [Syntax] +(macro: #export (@lazy tokens state) + {#;doc (doc "Delays the evaluation of an expression, by wrapping it in a continuation 'thunk'." + (@lazy (some-computation some-input)))} + (case tokens + (^ (list value)) + (let [blank (ast;symbol ["" ""])] + (#;Right [state (list (` (;lambda [(~ blank)] ((~ blank) (~ value)))))])) + + _ + (#;Left "Wrong syntax for @lazy"))) + +## [Functions] +(def: #export (call/cc f) + {#;doc "Call with current continuation."} + (All [a b c] (Cont (-> a (Cont b c)) (Cont a c))) + (lambda [k] + (f (lambda [a _] + (k a)) + k))) + +(def: #export (run thunk) + {#;doc "Forces a continuation thunk to be evaluated."} + (All [a] + (-> (Cont a) a)) + (thunk id)) + +## [Structs] +(struct: #export _ (Functor Cont) + (def: (map f ma) + (lambda [k] (ma (. k f))))) + +(struct: #export _ (Applicative Cont) + (def: functor Functor) + + (def: (wrap a) + (@lazy a)) + + (def: (apply ff fa) + (@lazy ((run ff) (run fa))))) + +(struct: #export _ (Monad Cont) + (def: applicative Applicative) + + (def: join run)) diff --git a/stdlib/source/lux/codata/env.lux b/stdlib/source/lux/codata/env.lux new file mode 100644 index 000000000..8883b4a66 --- /dev/null +++ b/stdlib/source/lux/codata/env.lux @@ -0,0 +1,65 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + ["M" monad #*]))) + +## [Types] +(type: #export (Env r a) + (-> r a)) + +## [Structures] +(struct: #export Functor (All [r] (Functor (Env r))) + (def: (map f fa) + (lambda [env] + (f (fa env))))) + +(struct: #export Applicative (All [r] (Applicative (Env r))) + (def: functor Functor) + + (def: (wrap x) + (lambda [env] x)) + + (def: (apply ff fa) + (lambda [env] + ((ff env) (fa env))))) + +(struct: #export Monad (All [r] (Monad (Env r))) + (def: applicative Applicative) + + (def: (join mma) + (lambda [env] + (mma env env)))) + +## [Values] +(def: #export ask + {#;doc "Get the value of the environment."} + (All [r] (Env r r)) + (lambda [env] env)) + +(def: #export (local change env-proc) + {#;doc "Run computation with a locally-modified environment."} + (All [r a] (-> (-> r r) (Env r a) (Env r a))) + (|>. change env-proc)) + +(def: #export (run env env-proc) + (All [r a] (-> r (Env r a) a)) + (env-proc env)) + +(struct: #export (EnvT Monad) + (All [M e] (-> (Monad M) (Monad (All [a] (Env e (M a)))))) + (def: applicative (compA Applicative (get@ #M;applicative Monad))) + (def: (join eMeMa) + (lambda [env] + (do Monad + [eMa (run env eMeMa)] + (run env eMa))))) + +(def: #export lift-env + (All [M e a] (-> (M a) (Env e (M a)))) + (:: Monad wrap)) diff --git a/stdlib/source/lux/codata/function.lux b/stdlib/source/lux/codata/function.lux new file mode 100644 index 000000000..fba5528a8 --- /dev/null +++ b/stdlib/source/lux/codata/function.lux @@ -0,0 +1,23 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control monoid))) + +## [Functions] +(def: #export (const x y) + (All [a b] (-> a (-> b a))) + x) + +(def: #export (flip f) + (All [a b c] + (-> (-> a b c) (-> b a c))) + (lambda [x y] (f y x))) + +## [Structures] +(struct: #export Monoid (Monoid (All [a] (-> a a))) + (def: unit id) + (def: append .)) diff --git a/stdlib/source/lux/codata/io.lux b/stdlib/source/lux/codata/io.lux new file mode 100644 index 000000000..1398dfae5 --- /dev/null +++ b/stdlib/source/lux/codata/io.lux @@ -0,0 +1,56 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + monad) + (data (struct list)))) + +## [Types] +(type: #export (IO a) + (-> Void a)) + +## [Syntax] +(macro: #export (io tokens state) + {#;doc (doc + "Delays the evaluation of an expression, by wrapping it in an IO 'thunk'." + "Great for wrapping side-effecting computations (which won't be performed until the IO is \"run\")." + (io (exec + (log! msg) + "Some value...")))} + (case tokens + (^ (list value)) + (let [blank (: AST [["" -1 -1] (#;SymbolS ["" ""])])] + (#;Right [state (list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))])) + + _ + (#;Left "Wrong syntax for io"))) + +## [Structures] +(struct: #export _ (Functor IO) + (def: (map f ma) + (io (f (ma (:! Void [])))))) + +(struct: #export _ (Applicative IO) + (def: functor Functor) + + (def: (wrap x) + (io x)) + + (def: (apply ff fa) + (io ((ff (:! Void [])) (fa (:! Void [])))))) + +(struct: #export _ (Monad IO) + (def: applicative Applicative) + + (def: (join mma) + (io ((mma (:! Void [])) (:! Void []))))) + +## [Functions] +(def: #export (run action) + (All [a] (-> (IO a) a)) + (action (:! Void []))) diff --git a/stdlib/source/lux/codata/state.lux b/stdlib/source/lux/codata/state.lux new file mode 100644 index 000000000..82e9b40fd --- /dev/null +++ b/stdlib/source/lux/codata/state.lux @@ -0,0 +1,114 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + ["A" applicative #*] + ["M" monad #*]))) + +## [Types] +(type: #export (State s a) + (-> s [s a])) + +## [Structures] +(struct: #export Functor (All [s] (Functor (State s))) + (def: (map f ma) + (lambda [state] + (let [[state' a] (ma state)] + [state' (f a)])))) + +(struct: #export Applicative (All [s] (Applicative (State s))) + (def: functor Functor) + + (def: (wrap a) + (lambda [state] + [state a])) + + (def: (apply ff fa) + (lambda [state] + (let [[state' f] (ff state) + [state'' a] (fa state')] + [state'' (f a)])))) + +(struct: #export Monad (All [s] (Monad (State s))) + (def: applicative Applicative) + + (def: (join mma) + (lambda [state] + (let [[state' ma] (mma state)] + (ma state'))))) + +## [Values] +(def: #export get + (All [s] (State s s)) + (lambda [state] + [state state])) + +(def: #export (put new-state) + (All [s] (-> s (State s Unit))) + (lambda [state] + [new-state []])) + +(def: #export (update change) + (All [s] (-> (-> s s) (State s Unit))) + (lambda [state] + [(change state) []])) + +(def: #export (use user) + {#;doc "Run function on current state."} + (All [s a] (-> (-> s a) (State s a))) + (lambda [state] + [state (user state)])) + +(def: #export (local change action) + {#;doc "Run computation with a locally-modified state."} + (All [s a] (-> (-> s s) (State s a) (State s a))) + (lambda [state] + (let [[state' output] (action (change state))] + [state output]))) + +(def: #export (run state action) + (All [s a] (-> s (State s a) [s a])) + (action state)) + +(struct: (Functor Functor) + (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) + (def: (map f sfa) + (lambda [state] + (:: Functor map (lambda [[s a]] [s (f a)]) + (sfa state))))) + +(struct: (Applicative Monad) + (All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a])))))) + (def: functor (Functor (get@ [#M;applicative #A;functor] + Monad))) + + (def: (wrap a) + (lambda [state] + (:: Monad wrap [state a]))) + + (def: (apply sFf sFa) + (lambda [state] + (do Monad + [[state f] (sFf state) + [state a] (sFa state)] + (wrap [state (f a)]))))) + +(struct: #export (StateT Monad) + (All [M s] (-> (Monad M) (Monad (All [a] (-> s (M [s a])))))) + (def: applicative (Applicative Monad)) + (def: (join sMsMa) + (lambda [state] + (do Monad + [[state' sMa] (sMsMa state)] + (sMa state'))))) + +(def: #export (lift-state Monad ma) + (All [M s a] (-> (Monad M) (M a) (-> s (M [s a])))) + (lambda [state] + (do Monad + [a ma] + (wrap [state a])))) diff --git a/stdlib/source/lux/codata/struct/stream.lux b/stdlib/source/lux/codata/struct/stream.lux new file mode 100644 index 000000000..8814ec460 --- /dev/null +++ b/stdlib/source/lux/codata/struct/stream.lux @@ -0,0 +1,135 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + monad + comonad) + [compiler #+ with-gensyms] + (macro ["s" syntax #+ syntax: Syntax]) + (data (struct [list "List/" Monad]) + bool) + (codata [cont #+ @lazy Cont]))) + +## [Types] +(type: #export (Stream a) + (Cont [a (Stream a)])) + +## [Utils] +(def: (cycle' x xs init full) + (All [a] + (-> a (List a) a (List a) (Stream a))) + (case xs + #;Nil (@lazy [x (cycle' init full init full)]) + (#;Cons x' xs') (@lazy [x (cycle' x' xs' init full)]))) + +## [Functions] +(def: #export (iterate f x) + (All [a] + (-> (-> a a) a (Stream a))) + (@lazy [x (iterate f (f x))])) + +(def: #export (repeat x) + (All [a] + (-> a (Stream a))) + (@lazy [x (repeat x)])) + +(def: #export (cycle xs) + (All [a] + (-> (List a) (Maybe (Stream a)))) + (case xs + #;Nil #;None + (#;Cons x xs') (#;Some (cycle' x xs' x xs')))) + +(do-template [ ] + [(def: #export ( s) + (All [a] (-> (Stream a) )) + (let [[h t] (cont;run s)] + ))] + + [head a h] + [tail (Stream a) t]) + +(def: #export (at idx s) + (All [a] (-> Nat (Stream a) a)) + (let [[h t] (cont;run s)] + (if (>+ +0 idx) + (at (dec+ idx) t) + h))) + +(do-template [ ] + [(def: #export ( pred xs) + (All [a] + (-> (Stream a) (List a))) + (let [[x xs'] (cont;run xs)] + (if + (list& x ( xs')) + (list)))) + + (def: #export ( pred xs) + (All [a] + (-> (Stream a) (Stream a))) + (let [[x xs'] (cont;run xs)] + (if + ( xs') + xs))) + + (def: #export ( pred xs) + (All [a] + (-> (Stream a) [(List a) (Stream a)])) + (let [[x xs'] (cont;run xs)] + (if + (let [[tail next] ( xs')] + [(#;Cons [x tail]) next]) + [(list) xs])))] + + [take-while drop-while split-with (-> a Bool) (pred x) pred] + [take drop split Nat (>+ +0 pred) (dec+ pred)] + ) + +(def: #export (unfold step init) + (All [a b] + (-> (-> a [a b]) a (Stream b))) + (let [[next x] (step init)] + (@lazy [x (unfold step next)]))) + +(def: #export (filter p xs) + (All [a] (-> (-> a Bool) (Stream a) (Stream a))) + (let [[x xs'] (cont;run xs)] + (if (p x) + (@lazy [x (filter p xs')]) + (filter p xs')))) + +(def: #export (partition p xs) + (All [a] (-> (-> a Bool) (Stream a) [(Stream a) (Stream a)])) + [(filter p xs) (filter (complement p) xs)]) + +## [Structures] +(struct: #export _ (Functor Stream) + (def: (map f fa) + (let [[h t] (cont;run fa)] + (@lazy [(f h) (map f t)])))) + +(struct: #export _ (CoMonad Stream) + (def: functor Functor) + (def: unwrap head) + (def: (split wa) + (let [[head tail] (cont;run wa)] + (@lazy [wa (split tail)])))) + +## [Pattern-matching] +(syntax: #export (^stream& {patterns (s;form (s;many s;any))} body {branches (s;some s;any)}) + {#;doc (doc "Allows destructuring of streams in pattern-matching expressions." + "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." + (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] + (func x y z)))} + (with-gensyms [g!s] + (let [body+ (` (let [(~@ (List/join (List/map (lambda [pattern] + (list (` [(~ pattern) (~ g!s)]) + (` (cont;run (~ g!s))))) + patterns)))] + (~ body)))] + (wrap (list& g!s body+ branches))))) diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux new file mode 100644 index 000000000..d7b072a56 --- /dev/null +++ b/stdlib/source/lux/compiler.lux @@ -0,0 +1,559 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: {#;doc "Functions for extracting information from the state of the compiler."} + lux + (lux (macro [ast]) + (control functor + applicative + monad) + (data (struct [list #* "List/" Monoid Monad]) + [number] + [text "Text/" Monoid Eq] + [product] + [ident "Ident/" Codec] + maybe + error))) + +## (type: (Lux a) +## (-> Compiler (Error [Compiler a]))) + +(struct: #export _ (Functor Lux) + (def: (map f fa) + (lambda [state] + (case (fa state) + (#;Left msg) + (#;Left msg) + + (#;Right [state' a]) + (#;Right [state' (f a)]))))) + +(struct: #export _ (Applicative Lux) + (def: functor Functor) + + (def: (wrap x) + (lambda [state] + (#;Right [state x]))) + + (def: (apply ff fa) + (lambda [state] + (case (ff state) + (#;Right [state' f]) + (case (fa state') + (#;Right [state'' a]) + (#;Right [state'' (f a)]) + + (#;Left msg) + (#;Left msg)) + + (#;Left msg) + (#;Left msg))))) + +(struct: #export _ (Monad Lux) + (def: applicative Applicative) + + (def: (join mma) + (lambda [state] + (case (mma state) + (#;Left msg) + (#;Left msg) + + (#;Right [state' ma]) + (ma state'))))) + +(def: (get k plist) + (All [a] + (-> Text (List [Text a]) (Maybe a))) + (case plist + #;Nil + #;None + + (#;Cons [k' v] plist') + (if (Text/= k k') + (#;Some v) + (get k plist')))) + +(def: #export (run' compiler action) + (All [a] (-> Compiler (Lux a) (Error [Compiler a]))) + (action compiler)) + +(def: #export (run compiler action) + (All [a] (-> Compiler (Lux a) (Error a))) + (case (action compiler) + (#;Left error) + (#;Left error) + + (#;Right [_ output]) + (#;Right output))) + +(def: #export (either left right) + (All [a] (-> (Lux a) (Lux a) (Lux a))) + (lambda [compiler] + (case (left compiler) + (#;Left error) + (right compiler) + + (#;Right [compiler' output]) + (#;Right [compiler' output])))) + +(def: #export (assert test message) + (-> Bool Text (Lux Unit)) + (lambda [compiler] + (if test + (#;Right [compiler []]) + (#;Left message)))) + +(def: #export (fail msg) + (All [a] + (-> Text (Lux a))) + (lambda [_] + (#;Left msg))) + +(def: #export (find-module name) + (-> Text (Lux Module)) + (lambda [state] + (case (get name (get@ #;modules state)) + (#;Some module) + (#;Right [state module]) + + _ + (#;Left ($_ Text/append "Unknown module: " name))))) + +(def: #export current-module-name + (Lux Text) + (lambda [state] + (case (list;last (get@ #;scopes state)) + (#;Some scope) + (case (get@ #;name scope) + (#;Cons m-name #;Nil) + (#;Right [state m-name]) + + _ + (#;Left "Improper name for scope.")) + + _ + (#;Left "Empty environment!") + ))) + +(def: #export current-module + (Lux Module) + (do Monad + [this-module-name current-module-name] + (find-module this-module-name))) + +(def: #export (get-ann tag meta) + (-> Ident Anns (Maybe Ann-Value)) + (let [[p n] tag] + (case meta + (#;Cons [[p' n'] dmv] meta') + (if (and (Text/= p p') + (Text/= n n')) + (#;Some dmv) + (get-ann tag meta')) + + #;Nil + #;None))) + +(do-template [ ] + [(def: #export ( tag meta) + (-> Ident Anns (Maybe )) + (case (get-ann tag meta) + (#;Some ( value)) + (#;Some value) + + _ + #;None))] + + [get-bool-ann #;BoolM Bool] + [get-int-ann #;IntM Int] + [get-real-ann #;RealM Real] + [get-char-ann #;CharM Char] + [get-text-ann #;TextM Text] + [get-ident-ann #;IdentM Ident] + [get-list-ann #;ListM (List Ann-Value)] + [get-dict-ann #;DictM (List [Text Ann-Value])] + ) + +(def: #export (get-doc meta) + (-> Anns (Maybe Text)) + (get-text-ann ["lux" "doc"] meta)) + +(def: #export (flag-set? flag-name meta) + (-> Ident Anns Bool) + (case (get-ann flag-name meta) + (#;Some (#;BoolM true)) + true + + _ + false)) + +(do-template [ ] + [(def: #export + (-> Anns Bool) + (flag-set? (ident-for )))] + + [export? #;export?] + [hidden? #;hidden?] + [macro? #;macro?] + [type? #;type?] + [struct? #;struct?] + [type-rec? #;type-rec?] + [sig? #;sig?] + ) + +(do-template [ ] + [(def: ( dmv) + (-> Ann-Value (Maybe )) + (case dmv + ( actual-value) + (#;Some actual-value) + + _ + #;None))] + + [try-mlist #;ListM (List Ann-Value)] + [try-mtext #;TextM Text] + ) + +(do-template [ ] + [(def: #export ( meta) + (-> Anns (List Text)) + (default (list) + (do Monad + [_args (get-ann (ident-for ) meta) + args (try-mlist _args)] + (mapM @ try-mtext args))))] + + [func-args #;func-args] + [type-args #;type-args] + ) + +(def: (find-macro' modules this-module module name) + (-> (List [Text Module]) Text Text Text + (Maybe Macro)) + (do Monad + [$module (get module modules) + [def-type def-anns def-value] (: (Maybe Def) (|> (: Module $module) (get@ #;defs) (get name)))] + (if (and (macro? def-anns) + (or (export? def-anns) (Text/= module this-module))) + (#;Some (:! Macro def-value)) + (case (get-ann ["lux" "alias"] def-anns) + (#;Some (#;IdentM [r-module r-name])) + (find-macro' modules this-module r-module r-name) + + _ + #;None)))) + +(def: #export (find-macro ident) + (-> Ident (Lux (Maybe Macro))) + (do Monad + [this-module current-module-name] + (let [[module name] ident] + (: (Lux (Maybe Macro)) + (lambda [state] + (#;Right [state (find-macro' (get@ #;modules state) this-module module name)])))))) + +(def: #export (normalize ident) + (-> Ident (Lux Ident)) + (case ident + ["" name] + (do Monad + [module-name current-module-name] + (wrap [module-name name])) + + _ + (:: Monad wrap ident))) + +(def: #export (macro-expand-once syntax) + (-> AST (Lux (List AST))) + (case syntax + [_ (#;FormS (#;Cons [[_ (#;SymbolS macro-name)] args]))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (case ?macro + (#;Some macro) + (macro args) + + #;None + (:: Monad wrap (list syntax)))) + + _ + (:: Monad wrap (list syntax)))) + +(def: #export (macro-expand syntax) + (-> AST (Lux (List AST))) + (case syntax + [_ (#;FormS (#;Cons [[_ (#;SymbolS macro-name)] args]))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (case ?macro + (#;Some macro) + (do Monad + [expansion (macro args) + expansion' (mapM Monad macro-expand expansion)] + (wrap (:: Monad join expansion'))) + + #;None + (:: Monad wrap (list syntax)))) + + _ + (:: Monad wrap (list syntax)))) + +(def: #export (macro-expand-all syntax) + (-> AST (Lux (List AST))) + (case syntax + [_ (#;FormS (#;Cons [[_ (#;SymbolS macro-name)] args]))] + (do Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (case ?macro + (#;Some macro) + (do Monad + [expansion (macro args) + expansion' (mapM Monad macro-expand-all expansion)] + (wrap (:: Monad join expansion'))) + + #;None + (do Monad + [parts' (mapM Monad macro-expand-all (list& (ast;symbol macro-name) args))] + (wrap (list (ast;form (:: Monad join parts'))))))) + + [_ (#;FormS (#;Cons [harg targs]))] + (do Monad + [harg+ (macro-expand-all harg) + targs+ (mapM Monad macro-expand-all targs)] + (wrap (list (ast;form (List/append harg+ (:: Monad join (: (List (List AST)) targs+))))))) + + [_ (#;TupleS members)] + (do Monad + [members' (mapM Monad macro-expand-all members)] + (wrap (list (ast;tuple (:: Monad join members'))))) + + _ + (:: Monad wrap (list syntax)))) + +(def: #export (gensym prefix) + (-> Text (Lux AST)) + (lambda [state] + (#;Right [(update@ #;seed inc+ state) + (ast;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec encode (get@ #;seed state)))])]))) + +(def: (get-local-symbol ast) + (-> AST (Lux Text)) + (case ast + [_ (#;SymbolS [_ name])] + (:: Monad wrap name) + + _ + (fail (Text/append "AST is not a local symbol: " (ast;ast-to-text ast))))) + +(macro: #export (with-gensyms tokens) + {#;doc (doc "Creates new symbols and offers them to the body expression." + (syntax: #export (synchronized lock body) + (with-gensyms [g!lock g!body g!_] + (wrap (list (` (let [(~ g!lock) (~ lock) + (~ g!_) (;_jvm_monitorenter (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) (;_jvm_monitorexit (~ g!lock))] + (~ g!body))))) + )))} + (case tokens + (^ (list [_ (#;TupleS symbols)] body)) + (do Monad + [symbol-names (mapM @ get-local-symbol symbols) + #let [symbol-defs (List/join (List/map (: (-> Text (List AST)) + (lambda [name] (list (ast;symbol ["" name]) (` (gensym (~ (ast;text name))))))) + symbol-names))]] + (wrap (list (` (do Monad + [(~@ symbol-defs)] + (~ body)))))) + + _ + (fail "Wrong syntax for with-gensyms"))) + +(def: #export (macro-expand-1 token) + (-> AST (Lux AST)) + (do Monad + [token+ (macro-expand token)] + (case token+ + (^ (list token')) + (wrap token') + + _ + (fail "Macro expanded to more than 1 element.")))) + +(def: #export (module-exists? module) + (-> Text (Lux Bool)) + (lambda [state] + (#;Right [state (case (get module (get@ #;modules state)) + (#;Some _) + true + + #;None + false)]))) + +(def: (try-both f x1 x2) + (All [a b] + (-> (-> a (Maybe b)) a a (Maybe b))) + (case (f x1) + #;None (f x2) + (#;Some y) (#;Some y))) + +(def: #export (find-var-type name) + (-> Text (Lux Type)) + (lambda [state] + (let [test (: (-> [Text Analysis] Bool) + (|>. product;left (Text/= name)))] + (case (do Monad + [scope (find (lambda [env] + (or (any? test (get@ [#;locals #;mappings] env)) + (any? test (get@ [#;closure #;mappings] env)))) + (get@ #;scopes state)) + [_ [[type _] _]] (try-both (find test) + (get@ [#;locals #;mappings] scope) + (get@ [#;closure #;mappings] scope))] + (wrap type)) + (#;Some var-type) + (#;Right [state var-type]) + + #;None + (#;Left ($_ Text/append "Unknown variable: " name)))))) + +(def: #export (find-def name) + (-> Ident (Lux Def)) + (lambda [state] + (case (: (Maybe Def) + (do Monad + [#let [[v-prefix v-name] name] + (^slots [#;defs]) (get v-prefix (get@ #;modules state))] + (get v-name defs))) + (#;Some _meta) + (#;Right [state _meta]) + + _ + (#;Left ($_ Text/append "Unknown definition: " (Ident/encode name)))))) + +(def: #export (find-def-type name) + (-> Ident (Lux Type)) + (do Monad + [[def-type def-data def-value] (find-def name)] + (wrap def-type))) + +(def: #export (find-type name) + (-> Ident (Lux Type)) + (do Monad + [#let [[_ _name] name]] + (either (find-var-type _name) + (do @ + [name (normalize name)] + (find-def-type name))))) + +(def: #export (find-type-def name) + (-> Ident (Lux Type)) + (do Monad + [[def-type def-data def-value] (find-def name)] + (wrap (:! Type def-value)))) + +(def: #export (defs module-name) + (-> Text (Lux (List [Text Def]))) + (lambda [state] + (case (get module-name (get@ #;modules state)) + #;None (#;Left ($_ Text/append "Unknown module: " module-name)) + (#;Some module) (#;Right [state (get@ #;defs module)]) + ))) + +(def: #export (exports module-name) + (-> Text (Lux (List [Text Def]))) + (do Monad + [defs (defs module-name)] + (wrap (filter (lambda [[name [def-type def-anns def-value]]] + (and (export? def-anns) + (not (hidden? def-anns)))) + defs)))) + +(def: #export modules + (Lux (List Text)) + (lambda [state] + (|> state + (get@ #;modules) + (List/map product;left) + [state] + #;Right))) + +(def: #export (tags-of type-name) + (-> Ident (Lux (List Ident))) + (do Monad + [#let [[module name] type-name] + module (find-module module)] + (case (get name (get@ #;types module)) + (#;Some [tags _]) + (wrap tags) + + _ + (wrap (list))))) + +(def: #export cursor + (Lux Cursor) + (lambda [state] + (#;Right [state (get@ #;cursor state)]))) + +(def: #export expected-type + (Lux Type) + (lambda [state] + (case (get@ #;expected state) + (#;Some type) + (#;Right [state type]) + + #;None + (#;Left "Not expecting any type.")))) + +(def: #export (imported-modules module-name) + (-> Text (Lux (List Text))) + (do Monad + [(^slots [#;imports]) (find-module module-name)] + (wrap imports))) + +(def: #export (resolve-tag (^@ tag [module name])) + (-> Ident (Lux [Nat (List Ident) Type])) + (do Monad + [=module (find-module module) + this-module-name current-module-name] + (case (get name (get@ #;tags =module)) + (#;Some [idx tag-list exported? type]) + (if (or exported? + (Text/= this-module-name module)) + (wrap [idx tag-list type]) + (fail ($_ Text/append "Can't access tag: " (Ident/encode tag) " from module " this-module-name))) + + _ + (fail ($_ Text/append "Unknown tag: " (Ident/encode tag)))))) + +(def: #export locals + (Lux (List (List [Text Type]))) + (lambda [state] + (case (list;inits (get@ #;scopes state)) + #;None + (#;Left "No local environment") + + (#;Some scopes) + (#;Right [state + (List/map (|>. (get@ [#;locals #;mappings]) + (List/map (lambda [[name [[type cursor] analysis]]] + [name type]))) + scopes)])))) + +(def: #export (un-alias def-name) + (-> Ident (Lux Ident)) + (do Monad + [def-name (normalize def-name) + [_ def-anns _] (find-def def-name)] + (case (get-ann (ident-for #;alias) def-anns) + (#;Some (#;IdentM real-def-name)) + (wrap real-def-name) + + _ + (wrap def-name)))) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux new file mode 100644 index 000000000..1eb3cee21 --- /dev/null +++ b/stdlib/source/lux/concurrency/actor.lux @@ -0,0 +1,278 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control monad) + (codata [io #- run] + function) + (data error + text/format + (struct [list "List/" Monoid Monad]) + [product] + [number "Nat/" Codec]) + [compiler #+ with-gensyms] + (macro [ast] + ["s" syntax #+ syntax: Syntax] + (syntax [common])) + [type]) + (.. [promise #+ Monad] + [stm #+ Monad] + [frp])) + +## [Types] +(type: #export (Actor s m) + {#mailbox (stm;Var m) + #kill-signal (promise;Promise Unit) + #obituary (promise;Promise [(Maybe Text) s (List m)])}) + +(type: #export (Proc s m) + {#step (-> (Actor s m) (-> m s (promise;Promise (Error s)))) + #end (-> (Maybe Text) s (promise;Promise Unit))}) + +## [Values] +(def: #export (spawn init [proc on-death]) + {#;doc "Given a procedure and initial state, launches an actor and returns it."} + (All [s m] (-> s (Proc s m) (IO (Actor s m)))) + (io (let [mailbox (stm;var (:! ($ 1) [])) + kill-signal (promise;promise Unit) + obituary (promise;promise [(Maybe Text) ($ 0) (List ($ 1))]) + self {#mailbox mailbox + #kill-signal kill-signal + #obituary obituary} + mailbox-chan (io;run (stm;follow "\tmailbox\t" mailbox)) + proc (proc self) + |mailbox| (stm;var mailbox-chan) + _ (:: Monad map + (lambda [_] + (io;run (do Monad + [mb (stm;read! |mailbox|)] + (frp;close mb)))) + kill-signal) + process (loop [state init + messages mailbox-chan] + (do Monad + [?messages+ messages] + (case ?messages+ + ## No kill-signal so far, so I may proceed... + (#;Some [message messages']) + (do Monad + [#let [_ (io;run (stm;write! messages' |mailbox|))] + ?state' (proc message state)] + (case ?state' + (#;Left error) + (do @ + [#let [_ (io;run (promise;resolve [] kill-signal)) + _ (io;run (frp;close messages')) + death-message (#;Some error)] + _ (on-death death-message state) + remaining-messages (frp;consume messages')] + (wrap [death-message state (#;Cons message remaining-messages)])) + + (#;Right state') + (recur state' messages'))) + + ## Otherwise, clean-up and return current state. + #;None + (do Monad + [#let [_ (io;run (frp;close messages)) + death-message #;None] + _ (on-death death-message state)] + (wrap [death-message state (list)])))))] + self))) + +(def: #export poison + {#;doc "Immediately kills the given actor (if it's not already dead)."} + (All [s m] (-> (Actor s m) (io;IO Bool))) + (|>. (get@ #kill-signal) (promise;resolve []))) + +(def: #export (alive? actor) + (All [s m] (-> (Actor s m) Bool)) + (case [(promise;poll (get@ #kill-signal actor)) + (promise;poll (get@ #obituary actor))] + [#;None #;None] + true + + _ + false)) + +(def: #export (send message actor) + (All [s m] (-> m (Actor s m) (promise;Promise Bool))) + (if (alive? actor) + (exec (io;run (stm;write! message (get@ #mailbox actor))) + (:: Monad wrap true)) + (:: Monad wrap false))) + +(def: #export (keep-alive init proc) + {#;doc "Given initial-state and a procedure, launches and actor that will reboot if it dies of errors. + However, it can still be killed."} + (All [s m] (-> s (Proc s m) (IO (Actor s m)))) + (io (let [ka-actor (: (Actor (Actor ($ 0) ($ 1)) ($ 1)) + (io;run (spawn (io;run (spawn init proc)) + {#step (lambda [*self* message server] + (do Monad + [was-sent? (send message server)] + (if was-sent? + (wrap (#;Right server)) + (do @ + [[?cause state unprocessed-messages] (get@ #obituary server)] + (exec (log! (format "ACTOR DIED:\n" (default "" ?cause) "\n RESTARTING")) + (do @ + [#let [new-server (io;run (spawn state proc)) + mailbox (get@ #mailbox new-server)] + _ (promise;future (mapM io;Monad ((flip stm;write!) mailbox) (#;Cons message unprocessed-messages)))] + (wrap (#;Right new-server)))) + )))) + #end (lambda [_ server] (exec (io;run (poison server)) + (:: Monad wrap [])))})))] + (update@ #obituary (: (-> (promise;Promise [(Maybe Text) (Actor ($ 0) ($ 1)) (List ($ 1))]) + (promise;Promise [(Maybe Text) ($ 0) (List ($ 1))])) + (lambda [process] + (do Monad + [[_ server unprocessed-messages-0] process + [cause state unprocessed-messages-1] (get@ #obituary server)] + (wrap [cause state (List/append unprocessed-messages-0 unprocessed-messages-1)])))) + ka-actor)))) + +## [Syntax] +(type: Method + {#name Text + #vars (List Text) + #args (List [Text AST]) + #return AST + #body AST}) + +(def: method^ + (Syntax Method) + (s;form (do s;Monad + [_ (s;symbol! ["" "method:"]) + vars (s;default (list) (s;tuple (s;some s;local-symbol))) + [name args] (s;form ($_ s;seq + s;local-symbol + (s;many common;typed-arg) + )) + return s;any + body s;any] + (wrap {#name name + #vars vars + #args args + #return return + #body body})))) + +(def: stop^ + (Syntax AST) + (s;form (do s;Monad + [_ (s;symbol! ["" "stop:"])] + s;any))) + +(def: actor-decl^ + (Syntax [(List Text) Text (List [Text AST])]) + (s;seq (s;default (list) (s;tuple (s;some s;local-symbol))) + (s;either (s;form (s;seq s;local-symbol (s;many common;typed-arg))) + (s;seq s;local-symbol (:: s;Monad wrap (list)))))) + +(def: (actor-def-decl [_vars _name _args] return-type) + (-> [(List Text) Text (List [Text AST])] AST (List AST)) + (let [decl (` ((~ (ast;symbol ["" (format _name "//new")])) (~@ (List/map (|>. product;left [""] ast;symbol) _args)))) + base-type (` (-> (~@ (List/map product;right _args)) + (~ return-type))) + type (case _vars + #;Nil + base-type + + _ + (` (All [(~@ (List/map (|>. [""] ast;symbol) _vars))] + (~ base-type))))] + (list decl + type))) + +(syntax: #export (actor: {_ex-lev common;export-level} + {(^@ decl [_vars _name _args]) actor-decl^} + state-type + {methods (s;many method^)} + {?stop (s;opt stop^)}) + {#;doc (doc "Allows defining an actor, with a set of methods that can be called on it." + "The methods can return promisehronous outputs." + "The methods can access the actor's state through the *state* variable." + "The methods can also access the actor itself through the *self* variable." + + (actor: #export Adder + Int + + (method: (count! {to-add Int}) + [Int Int] + (if (>= 0 to-add) + (do Monad + [#let [new-state (+ to-add *state*)]] + (wrap (#;Right [new-state [*state* new-state]]))) + (do Monad + [] + (wrap (#;Left "Can't add negative numbers!"))))) + ))} + (with-gensyms [g!message g!error g!return g!error g!output] + (let [g!state-name (ast;symbol ["" (format _name "//STATE")]) + g!protocol-name (ast;symbol ["" (format _name "//PROTOCOL")]) + g!self (ast;symbol ["" "*self*"]) + g!state (ast;symbol ["" "*state*"]) + g!cause (ast;symbol ["" "*cause*"]) + g!stop-body (default (` (:: promise;Monad (~' wrap) [])) ?stop) + protocol (List/map (lambda [(^slots [#name #vars #args #return #body])] + (` ((~ (ast;tag ["" name])) [(~@ (List/map product;right args))] (promise;Promise (~ return))))) + methods) + protocol-pm (List/map (: (-> Method [AST AST]) + (lambda [(^slots [#name #vars #args #return #body])] + (let [arg-names (|> (list;size args) (list;range+ +1) (List/map (|>. Nat/encode [""] ast;symbol))) + body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (promise;Promise (Error [(~ g!state-name) (~ return)]))) + (lambda (~ (ast;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] ast;symbol) args))] + (do promise;Monad + [] + (~ body)))))] + [(` [[(~@ arg-names)] (~ g!return)]) + (` (do promise;Monad + [(~ g!output) ((~ body-func) (~ g!state) (~@ arg-names))] + (case (~ g!output) + (#;Right [(~ g!state) (~ g!output)]) + (exec (io;run (promise;resolve (~ g!output) (~ g!return))) + ((~' wrap) (#;Right (~ g!state)))) + + (#;Left (~ g!error)) + ((~' wrap) (#;Left (~ g!error)))) + ))]))) + methods) + g!proc (` {#step (lambda [(~ g!self) (~ g!message) (~ g!state)] + (case (~ g!message) + (~@ (if (=+ +1 (list;size protocol-pm)) + (List/join (List/map (lambda [[pattern clause]] + (list pattern clause)) + protocol-pm)) + (List/join (List/map (lambda [[method [pattern clause]]] + (list (` ((~ (ast;tag ["" (get@ #name method)])) (~ pattern))) + clause)) + (list;zip2 methods protocol-pm))))) + )) + #end (lambda [(~ g!cause) (~ g!state)] + (do promise;Monad + [] + (~ g!stop-body)))}) + g!actor-name (ast;symbol ["" _name]) + g!methods (List/map (: (-> Method AST) + (lambda [(^slots [#name #vars #args #return #body])] + (let [arg-names (|> (list;size args) (list;range+ +1) (List/map (|>. Nat/encode [""] ast;symbol))) + type (` (-> (~@ (List/map product;right args)) + (~ g!actor-name) + (promise;Promise (~ return))))] + (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~@ arg-names) (~ g!self)) + (~ type) + (let [(~ g!output) (promise;promise (~ return))] + (exec (send ((~ (ast;tag ["" name])) [[(~@ arg-names)] (~ g!output)]) (~ g!self)) + (~ g!output)))))))) + methods)] + (wrap (list& (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!state-name) (~ state-type))) + (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!protocol-name) (~@ protocol))) + (` (type: (~@ (common;gen-export-level _ex-lev)) (~ g!actor-name) (Actor (~ g!state-name) (~ g!protocol-name)))) + (` (def: (~@ (common;gen-export-level _ex-lev)) (~@ (actor-def-decl decl (` (Proc (~ g!state-name) (~ g!protocol-name))))) + (~ g!proc))) + g!methods)) + ))) diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux new file mode 100644 index 000000000..3905ee7ca --- /dev/null +++ b/stdlib/source/lux/concurrency/atom.lux @@ -0,0 +1,41 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io #- run]) + host) + ) + +(jvm-import (java.util.concurrent.atomic.AtomicReference V) + (new [V]) + (compareAndSet [V V] boolean) + (get [] V)) + +(type: #export (Atom a) + (AtomicReference a)) + +(def: #export (atom value) + (All [a] (-> a (Atom a))) + (AtomicReference.new [value])) + +(def: #export (get atom) + (All [a] (-> (Atom a) (IO a))) + (io (AtomicReference.get [] atom))) + +(def: #export (compare-and-swap old new atom) + (All [a] (-> a a (Atom a) (IO Bool))) + (io (AtomicReference.compareAndSet [old new] atom))) + +(def: #export (update f atom) + (All [a] (-> (-> a a) (Atom a) (IO Unit))) + (io (let [old (AtomicReference.get [] atom)] + (if (AtomicReference.compareAndSet [old (f old)] atom) + [] + (io;run (update f atom)))))) + +(def: #export (set value atom) + (All [a] (-> a (Atom a) (IO Unit))) + (update (lambda [_] value) atom)) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux new file mode 100644 index 000000000..0efa9f837 --- /dev/null +++ b/stdlib/source/lux/concurrency/frp.lux @@ -0,0 +1,194 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + monad + eq) + (codata [io #- run] + function) + (data (struct [list]) + text/format) + [compiler] + (macro ["s" syntax #+ syntax: Syntax])) + (.. ["&" promise])) + +## [Types] +(type: #export (Chan a) + (&;Promise (Maybe [a (Chan a)]))) + +## [Syntax] +(syntax: #export (chan {?type (s;opt s;any)}) + {#;doc (doc "Makes an uninitialized Chan (in this case, of Unit)." + (chan Unit))} + (case ?type + (#;Some type) + (wrap (list (` (: (Chan (~ type)) + (&;promise))))) + + #;None + (wrap (list (` (&;promise)))))) + +## [Values] +(def: #export (filter p xs) + (All [a] (-> (-> a Bool) (Chan a) (Chan a))) + (do &;Monad + [?x+xs xs] + (case ?x+xs + #;None (wrap #;None) + (#;Some [x xs']) (if (p x) + (wrap (#;Some [x (filter p xs')])) + (filter p xs'))))) + +(def: #export (write value chan) + (All [a] (-> a (Chan a) (IO (Maybe (Chan a))))) + (case (&;poll chan) + (^template [ ] + + (do Monad + [#let [new-tail (&;promise)] + done? (&;resolve (#;Some [value new-tail]) )] + (if done? + (wrap (#;Some new-tail)) + (write value )))) + ([#;None chan] + [(#;Some (#;Some [_ chan'])) chan']) + + _ + (:: Monad wrap #;None) + )) + +(def: #export (close chan) + (All [a] (-> (Chan a) (IO Bool))) + (case (&;poll chan) + (^template [ ] + + (do Monad + [done? (&;resolve #;None )] + (if done? + (wrap true) + (close )))) + ([#;None chan] + [(#;Some (#;Some [_ chan'])) chan']) + + _ + (:: Monad wrap false) + )) + +(def: (pipe' input output) + (All [a] (-> (Chan a) (Chan a) (&;Promise Unit))) + (do &;Monad + [?x+xs input] + (case ?x+xs + #;None (wrap []) + (#;Some [x input']) (case (io;run (write x output)) + #;None + (wrap []) + + (#;Some output') + (pipe' input' output'))))) + +(def: #export (pipe input output) + (All [a] (-> (Chan a) (Chan a) (&;Promise Unit))) + (do &;Monad + [_ (pipe' input output)] + (exec (io;run (close output)) + (wrap [])))) + +(def: #export (merge xss) + (All [a] (-> (List (Chan a)) (Chan a))) + (let [output (chan ($ 0))] + (exec (do &;Monad + [_ (mapM @ (lambda [input] (pipe' input output)) xss)] + (exec (io;run (close output)) + (wrap []))) + output))) + +(def: #export (fold f init xs) + (All [a b] (-> (-> b a (&;Promise a)) a (Chan b) (&;Promise a))) + (do &;Monad + [?x+xs xs] + (case ?x+xs + #;None (wrap init) + (#;Some [x xs']) (do @ + [init' (f x init)] + (fold f init' xs'))))) + +(def: (no-dups' eq last-one xs) + (All [a] (-> (Eq a) a (Chan a) (Chan a))) + (let [(^open) eq] + (do &;Monad + [?x+xs xs] + (case ?x+xs + #;None (wrap #;None) + (#;Some [x xs']) (if (= x last-one) + (no-dups' eq last-one xs') + (wrap (#;Some [x (no-dups' eq x xs')]))))))) + +(def: #export (no-dups eq xs) + {#;doc "Multiple consecutive equal values in the input channel will just be single values in the output channel."} + (All [a] (-> (Eq a) (Chan a) (Chan a))) + (let [(^open) eq] + (do &;Monad + [?x+xs xs] + (case ?x+xs + #;None (wrap #;None) + (#;Some [x xs']) (wrap (#;Some [x (no-dups' eq x xs')])))))) + +(def: #export (consume xs) + (All [a] (-> (Chan a) (&;Promise (List a)))) + (do &;Monad + [?x+xs' xs] + (case ?x+xs' + #;None + (wrap #;Nil) + + (#;Some [x xs']) + (do @ + [=xs (consume xs')] + (wrap (#;Cons x =xs)))))) + +(def: #export (as-chan !x) + (All [a] (-> (&;Promise a) (Chan a))) + (do &;Monad + [x !x] + (wrap (#;Some [x (wrap #;None)])))) + +## [Structures] +(struct: #export _ (Functor Chan) + (def: (map f xs) + (:: &;Functor map + (lambda [?x+xs] + (case ?x+xs + #;None #;None + (#;Some [x xs']) (#;Some [(f x) (map f xs')]))) + xs))) + +(struct: #export _ (Applicative Chan) + (def: functor Functor) + + (def: (wrap a) + (let [(^open) &;Monad] + (wrap (#;Some [a (wrap #;None)])))) + + (def: (apply ff fa) + (let [fb (chan ($ 1))] + (exec (let [(^open) Functor] + (map (lambda [f] (pipe (map f fa) fb)) + ff)) + fb)))) + +(struct: #export _ (Monad Chan) + (def: applicative Applicative) + + (def: (join mma) + (let [output (chan ($ 0))] + (exec (let [(^open) Functor] + (map (lambda [ma] + (pipe ma output)) + mma)) + output)))) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux new file mode 100644 index 000000000..b765acc4d --- /dev/null +++ b/stdlib/source/lux/concurrency/promise.lux @@ -0,0 +1,233 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (data (struct [list #* "" Functor]) + number + text/format + error) + (codata [io #- run] + function) + (control functor + applicative + monad) + [compiler] + (macro ["s" syntax #+ syntax: Syntax]) + (concurrency [atom #+ Atom atom]) + host + )) + +(jvm-import java.lang.Runtime + (#static getRuntime [] Runtime) + (availableProcessors [] int)) + +(jvm-import java.lang.Runnable) + +(jvm-import java.lang.Thread + (new [Runnable]) + (start [] void)) + +(jvm-import java.util.concurrent.Executor + (execute [Runnable] void)) + +(jvm-import java.util.concurrent.TimeUnit + (#enum MILLISECONDS)) + +(jvm-import (java.util.concurrent.ScheduledFuture a)) + +(jvm-import java.util.concurrent.ScheduledThreadPoolExecutor + (new [int]) + (schedule [Runnable long TimeUnit] (ScheduledFuture Object))) + +(def: #export concurrency-level + Nat + (|> (Runtime.getRuntime []) + (Runtime.availableProcessors []) + int-to-nat)) + +(def: executor + ScheduledThreadPoolExecutor + (ScheduledThreadPoolExecutor.new [(nat-to-int concurrency-level)])) + +(syntax: (runnable expr) + (wrap (list (`' (object [java.lang.Runnable] + [] + (java.lang.Runnable (run) void + (exec (~ expr) + []))))))) + +(type: (Promise-State a) + {#value (Maybe a) + #observers (List (-> a (IO Unit)))}) + +(type: #export (Promise a) + {#;doc "Represents values produced by promisehronous computations (unlike IO, which is synchronous)."} + (Atom (Promise-State a))) + +(def: #hidden (promise' ?value) + (All [a] (-> (Maybe a) (Promise a))) + (atom {#value ?value + #observers (list)})) + +(syntax: #export (promise {?type (s;opt s;any)}) + {#;doc (doc "Makes an uninitialized Promise (in this example, of Unit)." + (promise Unit))} + (case ?type + (#;Some type) + (wrap (list (` (: (Promise (~ type)) + (promise' #;None))))) + + #;None + (wrap (list (` (promise' #;None)))))) + +(def: #export (poll promise) + {#;doc "Checks whether an Promise's value has already been resolved."} + (All [a] (-> (Promise a) (Maybe a))) + (|> (atom;get promise) + io;run + (get@ #value))) + +(def: #export (resolve value promise) + {#;doc "Sets an Promise's value if it hasn't been done yet."} + (All [a] (-> a (Promise a) (IO Bool))) + (do Monad + [old (atom;get promise)] + (case (get@ #value old) + (#;Some _) + (wrap false) + + #;None + (do @ + [#let [new (set@ #value (#;Some value) old)] + succeeded? (atom;compare-and-swap old new promise)] + (if succeeded? + (do @ + [_ (mapM @ (lambda [f] (f value)) + (get@ #observers old))] + (wrap true)) + (resolve value promise)))))) + +(def: (await f promise) + (All [a] (-> (-> a (IO Unit)) (Promise a) Unit)) + (let [old (io;run (atom;get promise))] + (case (get@ #value old) + (#;Some value) + (io;run (f value)) + + #;None + (let [new (update@ #observers (|>. (#;Cons f)) old)] + (if (io;run (atom;compare-and-swap old new promise)) + [] + (await f promise)))))) + +(struct: #export _ (Functor Promise) + (def: (map f fa) + (let [fb (promise ($ 1))] + (exec (await (lambda [a] (do Monad + [_ (resolve (f a) fb)] + (wrap []))) + fa) + fb)))) + +(struct: #export _ (Applicative Promise) + (def: functor Functor) + + (def: (wrap a) + (atom {#value (#;Some a) + #observers (list)})) + + (def: (apply ff fa) + (let [fb (promise ($ 1))] + (exec (await (lambda [f] + (io (await (lambda [a] (do Monad + [_ (resolve (f a) fb)] + (wrap []))) + fa))) + ff) + fb)) + )) + +(struct: #export _ (Monad Promise) + (def: applicative Applicative) + + (def: (join mma) + (let [ma (promise ($ 0))] + (exec (await (lambda [ma'] + (io (await (lambda [a'] + (do Monad + [_ (resolve a' ma)] + (wrap []))) + ma'))) + mma) + ma)))) + +(def: #export (seq left right) + {#;doc "Sequencing combinator."} + (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) + (do Monad + [a left + b right] + (wrap [a b]))) + +(def: #export (alt left right) + {#;doc "Heterogeneous alternative combinator."} + (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) + (let [a|b (promise (Either ($ 0) ($ 1)))] + (let% [ (do-template [ ] + [(await (lambda [value] + (do Monad + [_ (resolve ( value) a|b)] + (wrap []))) + )] + + [left #;Left] + [right #;Right] + )] + (exec + a|b)))) + +(def: #export (either left right) + {#;doc "Homogeneous alternative combinator."} + (All [a] (-> (Promise a) (Promise a) (Promise a))) + (let [left||right (promise ($ 0))] + (let% [ (do-template [] + [(await [(lambda [value] + (do Monad + [_ (resolve value left||right)] + (wrap [])))] + )] + + [left] + [right] + )] + (exec + left||right)))) + +(def: #export (future computation) + {#;doc "Runs computation on it's own process and returns an Promise that will eventually host it's result."} + (All [a] (-> (IO a) (Promise a))) + (let [!out (promise ($ 0))] + (exec (Thread.start [] (Thread.new [(runnable (io;run (resolve (io;run computation) + !out)))])) + !out))) + +(def: #export (wait time) + (-> Nat (Promise Unit)) + (let [!out (promise Unit)] + (exec (ScheduledThreadPoolExecutor.schedule [(runnable (io;run (resolve [] !out))) + (nat-to-int time) + TimeUnit.MILLISECONDS] + executor) + !out))) + +(def: #export (time-out time promise) + (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) + (alt (wait time) promise)) + +(def: #export (delay time value) + {#;doc "Delivers a value after a certain period has passed."} + (All [a] (-> Nat a (Promise a))) + (:: Functor map (const value) (wait time))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux new file mode 100644 index 000000000..80633a41e --- /dev/null +++ b/stdlib/source/lux/concurrency/stm.lux @@ -0,0 +1,237 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + monad) + (codata [io #- run]) + (data (struct [list #* "List/" Functor] + [dict #+ Dict]) + [product] + [text] + text/format) + host + [compiler] + (macro [ast] + ["s" syntax #+ syntax: Syntax]) + (concurrency [atom #+ Atom atom] + [promise #+ Promise "Promise/" Monad] + [frp]) + )) + +(type: (Var-State a) + {#value a + #observers (Dict Text (-> a (IO Unit)))}) + +(type: #export (Var a) + (Atom (Var-State a))) + +(type: (Tx-Frame a) + {#var (Var a) + #original a + #current a}) + +(type: Tx + (List (Ex [a] (Tx-Frame a)))) + +(type: #export (STM a) + (-> Tx [Tx a])) + +(def: #export (var value) + (All [a] (-> a (Var a))) + (atom;atom {#value value + #observers (dict;new text;Hash)})) + +(def: raw-read + (All [a] (-> (Var a) a)) + (|>. atom;get io;run (get@ #value))) + +(def: (find-var-value var tx) + (All [a] (-> (Var a) Tx (Maybe a))) + (:! (Maybe ($ 0)) + (find (: (-> (Ex [a] (Tx-Frame a)) + (Maybe Unit)) + (lambda [[_var _original _current]] + (:! (Maybe Unit) + (if (== (:! (Var Unit) var) + (:! (Var Unit) _var)) + (#;Some _current) + #;None)))) + tx))) + +(def: #export (read var) + (All [a] (-> (Var a) (STM a))) + (lambda [tx] + (case (find-var-value var tx) + (#;Some value) + [tx value] + + #;None + (let [value (raw-read var)] + [(#;Cons [var value value] tx) + value])))) + +(def: #export (read! var) + {#;doc "Reads var immediately, without going through a transaction."} + (All [a] (-> (Var a) (IO a))) + (|> var + atom;get + (:: Functor map (get@ #value)))) + +(def: (update-tx-value var value tx) + (All [a] (-> (Var a) a Tx Tx)) + (case tx + #;Nil + #;Nil + + (#;Cons [_var _original _current] tx') + (if (== (:! (Var ($ 0)) var) + (:! (Var ($ 0)) _var)) + (#;Cons [(:! (Var ($ 0)) _var) + (:! ($ 0) _original) + (:! ($ 0) _current)] + tx') + (#;Cons [_var _original _current] + (update-tx-value var value tx'))) + )) + +(def: #export (write value var) + (All [a] (-> a (Var a) (STM Unit))) + (lambda [tx] + (case (find-var-value var tx) + (#;Some _) + [(update-tx-value var value tx) + []] + + #;None + [(#;Cons [var (raw-read var) value] tx) + []]))) + +(def: #export (write! new-value var) + {#;doc "Writes value to var immediately, without going through a transaction."} + (All [a] (-> a (Var a) (IO Unit))) + (do Monad + [old (atom;get var) + #let [old-value (get@ #value old) + new (set@ #value new-value old)] + succeeded? (atom;compare-and-swap old new var)] + (if succeeded? + (do @ + [_ (|> old + (get@ #observers) + dict;values + (mapM @ (lambda [f] (f new-value))))] + (wrap [])) + (write! new-value var)))) + +(def: #export (unfollow label target) + (All [a] (-> Text (Var a) (IO Unit))) + (do Monad + [[value observers] (atom;get target)] + (atom;set [value (dict;remove label observers)] + target))) + +(def: #export (follow label target) + {#;doc "Creates a channel (identified by a given text) that will receive all changes to the value of the given var."} + (All [a] (-> Text (Var a) (IO (frp;Chan a)))) + (let [head (frp;chan ($ 0)) + chan-var (var head) + observer (lambda [value] + (case (io;run (|> chan-var raw-read (frp;write value))) + #;None + ## By closing the output Chan, the + ## observer becomes obsolete. + (unfollow label chan-var) + + (#;Some tail') + (write! tail' chan-var)))] + (do Monad + [_ (atom;update (lambda [[value observers]] + [value (dict;put label observer observers)]) + target)] + (wrap head)))) + +(struct: #export _ (Functor STM) + (def: (map f fa) + (lambda [tx] + (let [[tx' a] (fa tx)] + [tx' (f a)])))) + +(struct: #export _ (Applicative STM) + (def: functor Functor) + + (def: (wrap a) + (lambda [tx] [tx a])) + + (def: (apply ff fa) + (lambda [tx] + (let [[tx' f] (ff tx) + [tx'' a] (fa tx')] + [tx'' (f a)])))) + +(struct: #export _ (Monad STM) + (def: applicative Applicative) + + (def: (join mma) + (lambda [tx] + (let [[tx' ma] (mma tx)] + (ma tx'))))) + +(def: #export (update! f var) + (All [a] (-> (-> a a) (Var a) (Promise [a a]))) + (promise;future (io (loop [_ []] + (let [(^@ state [value observers]) (io;run (atom;get var)) + value' (f value)] + (if (io;run (atom;compare-and-swap state + [value' observers] + var)) + [value value'] + (recur []))))))) + +(def: #export (update f var) + (All [a] (-> (-> a a) (Var a) (STM [a a]))) + (do Monad + [a (read var) + #let [a' (f a)] + _ (write a' var)] + (wrap [a a']))) + +(def: (can-commit? tx) + (-> Tx Bool) + (every? (lambda [[_var _original _current]] + (== _original (raw-read _var))) + tx)) + +(def: (commit-var [_var _original _current]) + (-> (Ex [a] (Tx-Frame a)) Unit) + (if (== _original _current) + [] + (io;run (write! _current _var)))) + +(def: fresh-tx Tx (list)) + +(def: (commit' output stm-proc) + (All [a] (-> (Promise a) (STM a) (Promise Unit))) + (promise;future (io (let [[finished-tx value] (stm-proc fresh-tx)] + (if (can-commit? finished-tx) + (exec (List/map commit-var finished-tx) + (io;run (promise;resolve value output)) + []) + (exec (commit' output stm-proc) + [])) + )))) + +(def: #export (commit stm-proc) + {#;doc "Commits a transaction and returns its result (asynchronously). + + Note that a transaction may be re-run an indeterminate number of times if other transactions involving the same variables successfully commit first. + + For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} + (All [a] (-> (STM a) (Promise a))) + (let [output (promise;promise)] + (exec (commit' output stm-proc) + output))) diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux new file mode 100644 index 000000000..5d4cad0c0 --- /dev/null +++ b/stdlib/source/lux/control/applicative.lux @@ -0,0 +1,33 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (.. ["F" functor])) + +(sig: #export (Applicative f) + (: (F;Functor f) + functor) + (: (All [a] + (-> a (f a))) + wrap) + (: (All [a b] + (-> (f (-> a b)) (f a) (f b))) + apply)) + +(def: #export (compA Applicative Applicative) + (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a)))))) + (struct (def: functor (F;compF (get@ #functor Applicative) + (get@ #functor Applicative))) + (def: wrap + (|>. (:: Applicative wrap) (:: Applicative wrap))) + (def: (apply fgf fgx) + (let [applyF (:: Applicative apply) + applyG (:: Applicative apply)] + ($_ applyF + (:: Applicative wrap applyG) + fgf + fgx))) + )) diff --git a/stdlib/source/lux/control/bounded.lux b/stdlib/source/lux/control/bounded.lux new file mode 100644 index 000000000..291c4d8b6 --- /dev/null +++ b/stdlib/source/lux/control/bounded.lux @@ -0,0 +1,14 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux) + +## Signatures +(sig: #export (Bounded a) + (: a + top) + + (: a + bottom)) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux new file mode 100644 index 000000000..e9833ccc9 --- /dev/null +++ b/stdlib/source/lux/control/codec.lux @@ -0,0 +1,28 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux control/monad + data/error)) + +## [Signatures] +(sig: #export (Codec m a) + (: (-> a m) + encode) + (: (-> m (Error a)) + decode)) + +## [Values] +(def: #export (<.> (^open "bc:") (^open "ab:")) + (All [a b c] (-> (Codec c b) (Codec b a) (Codec c a))) + (struct + (def: encode (|>. ab:encode bc:encode)) + + (def: (decode cy) + (do Monad + [by (bc:decode cy)] + (ab:decode by))) + )) diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux new file mode 100644 index 000000000..801dbb479 --- /dev/null +++ b/stdlib/source/lux/control/comonad.lux @@ -0,0 +1,54 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + ["F" ../functor] + [lux/data/struct/list #* "" Fold]) + +## [Signatures] +(sig: #export (CoMonad w) + (: (F;Functor w) + functor) + (: (All [a] + (-> (w a) a)) + unwrap) + (: (All [a] + (-> (w a) (w (w a)))) + split)) + +## [Syntax] +(macro: #export (be tokens state) + {#;doc (doc "A co-monadic parallel to the \"do\" macro." + (let [square (lambda [n] (* n n))] + (be CoMonad + [inputs (iterate inc 2)] + (square (head inputs)))))} + (case tokens + (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) + (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])]) + g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) + g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])]) + body' (fold (: (-> [AST AST] AST AST) + (lambda [binding body'] + (let [[var value] binding] + (case var + [_ (#;TagS ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) (~ g!split) ((~ g!map) (lambda [(~ var)] (~ body'))))) + )))) + body + (reverse (as-pairs bindings)))] + (#;Right [state (#;Cons (` (;_lux_case (~ comonad) + (~ g!@) + (;_lux_case (~ g!@) + {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} + (~ body')))) + #;Nil)])) + + _ + (#;Left "Wrong syntax for be"))) diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux new file mode 100644 index 000000000..cbd24c7f9 --- /dev/null +++ b/stdlib/source/lux/control/effect.lux @@ -0,0 +1,315 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux + (lux (control ["F" functor] + applicative + monad) + (codata [io #- run]) + (data (struct [list "List/" Monad]) + [number "Nat/" Codec] + text/format + error) + [compiler] + [macro] + (macro [ast] + ["s" syntax #+ syntax: Syntax] + (syntax [common])) + [type] + (type ["tc" check]))) + +## [Type] +(type: #export (Eff F a) + (#Pure a) + (#Effect (F (Eff F a)))) + +(sig: #export (Handler E M) + (: (All [a] (-> (Eff E a) (M a))) + handle)) + +## [Values] +(struct: #export (Functor dsl) + (All [F] (-> (F;Functor F) (F;Functor (Eff F)))) + (def: (map f ea) + (case ea + (#Pure a) + (#Pure (f a)) + + (#Effect value) + (#Effect (:: dsl map (map f) value))))) + +(struct: #export (Applicative dsl) + (All [F] (-> (F;Functor F) (Applicative (Eff F)))) + (def: functor (Functor dsl)) + + (def: (wrap a) + (#Pure a)) + + (def: (apply ef ea) + (case [ef ea] + [(#Pure f) (#Pure a)] + (#Pure (f a)) + + [(#Pure f) (#Effect fa)] + (#Effect (:: dsl map + (:: (Functor dsl) map f) + fa)) + + [(#Effect ff) _] + (#Effect (:: dsl map + (lambda [f] (apply f ea)) + ff)) + ))) + +(struct: #export (Monad dsl) + (All [F] (-> (F;Functor F) (Monad (Eff F)))) + (def: applicative (Applicative dsl)) + + (def: (join efefa) + (case efefa + (#Pure efa) + (case efa + (#Pure a) + (#Pure a) + + (#Effect fa) + (#Effect fa)) + + (#Effect fefa) + (#Effect (:: dsl map + (:: (Monad dsl) join) + fefa)) + ))) + +(type: (@| L R) + (All [a] (| (L a) (R a)))) + +(def: #export (combine-functors left right) + (All [L R] + (-> (F;Functor L) (F;Functor R) + (F;Functor (@| L R)))) + (struct + (def: (map f l|r) + (case l|r + (+0 l) (+0 (:: left map f l)) + (+1 r) (+1 (:: right map f r))) + ))) + +(def: #export (combine-handlers Monad left right) + (All [L R M] + (-> (Monad M) + (Handler L M) (Handler R M) + (Handler (@| L R) M))) + (struct + (def: (handle el|r) + (case el|r + (#Pure x) + (:: Monad wrap x) + + (#Effect l|r) + (case l|r + (#;Left l) (:: left handle (#Effect l)) + (#;Right r) (:: right handle (#Effect r)) + )) + ))) + +## [Syntax] +(syntax: #export (||E {effects (s;some s;any)}) + (do @ + [g!a (compiler;gensym "g!a") + #let [effects@a (List/map (lambda [eff] (` ((~ eff) (~ g!a)))) + effects)]] + (wrap (list (` (All [(~ g!a)] + (| (~@ effects@a)))) + )))) + +(syntax: #export (||F {functors (s;many s;any)}) + (wrap (list (` ($_ ;;combine-functors (~@ functors)))))) + +(syntax: #export (||H monad {handlers (s;many s;any)}) + (do @ + [g!combiner (compiler;gensym "")] + (wrap (list (` (let [(~ g!combiner) (;;combine-handlers (~ monad))] + ($_ (~ g!combiner) (~@ handlers)))))))) + +(type: Op + {#name Text + #inputs (List AST) + #output AST}) + +(def: op^ + (Syntax Op) + (s;form (s;either ($_ s;seq + s;local-symbol + (s;tuple (s;some s;any)) + s;any) + ($_ s;seq + s;local-symbol + (:: s;Monad wrap (list)) + s;any)))) + +(syntax: #export (effect: {exp-lvl common;export-level} + {name s;local-symbol} + {ops (s;many op^)}) + (do @ + [g!output (compiler;gensym "g!output") + #let [op-types (List/map (lambda [op] + (let [g!tag (ast;tag ["" (get@ #name op)]) + g!inputs (` [(~@ (get@ #inputs op))]) + g!output (` (-> (~ (get@ #output op)) (~ g!output)))] + (` ((~ g!tag) (~ g!inputs) (~ g!output))))) + ops) + type-name (ast;symbol ["" name]) + type-def (` (type: (~@ (common;gen-export-level exp-lvl)) + ((~ type-name) (~ g!output)) + (~@ op-types))) + op-tags (List/map (|>. (get@ #name) [""] ast;tag (list) ast;tuple) + ops) + functor-def (` (struct: (~@ (common;gen-export-level exp-lvl)) (~' _) (F;Functor (~ type-name)) + (def: ((~' map) (~' f) (~' fa)) + (case (~' fa) + (^template [(~' )] + ((~' ) (~' params) (~' cont)) + ((~' ) (~' params) (. (~' f) (~' cont)))) + ((~@ op-tags)))) + )) + function-defs (List/map (lambda [op] + (let [g!name (ast;symbol ["" (get@ #name op)]) + g!tag (ast;tag ["" (get@ #name op)]) + g!params (: (List AST) + (case (list;size (get@ #inputs op)) + +0 (list) + s (|> (list;range+ +0 (dec+ s)) + (List/map (|>. Nat/encode + (format "_") + [""] + ast;symbol)))))] + (` (def: (~@ (common;gen-export-level exp-lvl)) ((~ g!name) (~@ g!params)) + (-> (~@ (get@ #inputs op)) + ((~ type-name) (~ (get@ #output op)))) + ((~ g!tag) [(~@ g!params)] ;id))))) + ops)]] + (wrap (list& type-def + functor-def + function-defs)))) + +(type: Translation + {#effect Ident + #base AST + #monad AST}) + +(def: translation^ + (Syntax Translation) + (s;form (do s;Monad + [_ (s;symbol! ["" "=>"])] + (s;seq s;symbol + (s;tuple (s;seq s;any + s;any)))))) + +(syntax: #export (handler: {exp-lvl common;export-level} + {name s;local-symbol} + {[effect base monad] translation^} + {defs (s;many (common;def *compiler*))}) + (do @ + [(^@ effect [e-module _]) (compiler;un-alias effect) + g!input (compiler;gensym "g!input") + g!cont (compiler;gensym "g!cont") + g!value (compiler;gensym "value") + #let [g!cases (|> defs + (List/map (lambda [def] + (let [g!tag (ast;tag [e-module (get@ #common;def-name def)]) + g!args (List/map (|>. [""] ast;symbol) + (get@ #common;def-args def)) + eff-calc (case (get@ #common;def-type def) + #;None + (get@ #common;def-value def) + + (#;Some type) + (` (: (~ type) (~ (get@ #common;def-value def))))) + invocation (case g!args + #;Nil + eff-calc + + _ + (` ((~ eff-calc) (~@ g!args))))] + (list (` ((~ g!tag) [(~@ g!args)] (~ g!cont))) + (` (do (~ monad) + [(~ g!value) (~ invocation)] + ((~' handle) ((~ g!cont) (~ g!value))))) + )))) + List/join)]] + (wrap (list (` (struct: (~@ (common;gen-export-level exp-lvl)) (~ (ast;symbol ["" name])) + (;;Handler (~ (ast;symbol effect)) (~ base)) + (def: ((~' handle) (~ g!input)) + (case (~ g!input) + (#Pure (~ g!input)) + (:: (~ monad) (~' wrap) (~ g!input)) + + (#Effect (~ g!input)) + (case (~ g!input) + (~@ g!cases)))))))))) + +(syntax: #export (with-handler handler body) + (wrap (list (` (:: (~ handler) (~' handle) (~ body)))))) + +(def: (un-apply type-app) + (-> Type Type) + (case type-app + (#;AppT effect value) + effect + + _ + (error! (format "Wrong type format: " (type;type-to-text type-app))))) + +(def: (clean-effect effect) + (-> Type Type) + (case effect + (#;UnivQ env body) + (#;UnivQ (list) body) + + _ + (error! (format "Wrong effect format: " (type;type-to-text effect))))) + +(def: g!functor AST (ast;symbol ["" "%E"])) + +(syntax: #export (doE functor {bindings (s;tuple (s;some s;any))} body) + (do @ + [g!output (compiler;gensym "")] + (wrap (list (` (let [(~ g!functor) (~ functor)] + (do (Monad (~ g!functor)) + [(~@ bindings) + (~ g!output) (~ body)] + ((~' wrap) (~ g!output))))))))) + +(syntax: #export (lift {value (s;alt s;symbol + s;any)}) + (case value + (#;Left var) + (do @ + [input (compiler;find-type var) + output compiler;expected-type] + (case [input output] + (^=> [(#;AppT eff0 _) (#;AppT stackT0 recT0)] + {(type;apply-type stackT0 recT0) (#;Some unfoldT0)} + {stackT0 (^ (#;AppT (#;NamedT (ident-for ;;Eff) _) + stackT1))} + {(type;apply-type stackT1 recT0) (#;Some unfoldT1)} + {(list;find (lambda [[idx effect]] + (if (tc;checks? (clean-effect effect) eff0) + (#;Some idx) + #;None)) + (|> unfoldT1 type;flatten-sum (List/map un-apply) list;enumerate)) + (#;Some idx)}) + (wrap (list (` (#;;Effect (:: (~ g!functor) (~' map) (~' wrap) ((~ (ast;int (nat-to-int idx))) + (~ (ast;symbol var)))))))) + + _ + (compiler;fail (format "Invalid type to lift: " (type;type-to-text output))))) + + (#;Right node) + (do @ + [g!value (compiler;gensym "")] + (wrap (list (` (let [(~ g!value) (~ node)] + (;;lift (~ g!value))))))))) diff --git a/stdlib/source/lux/control/enum.lux b/stdlib/source/lux/control/enum.lux new file mode 100644 index 000000000..63c041f95 --- /dev/null +++ b/stdlib/source/lux/control/enum.lux @@ -0,0 +1,24 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux + (lux/control [ord])) + +## [Signatures] +(sig: #export (Enum e) + (: (ord;Ord e) ord) + (: (-> e e) succ) + (: (-> e e) pred)) + +## [Functions] +(def: (range' <= succ from to) + (All [a] (-> (-> a a Bool) (-> a a) a a (List a))) + (if (<= to from) + (#;Cons from (range' <= succ (succ from) to)) + #;Nil)) + +(def: #export (range (^open) from to) + (All [a] (-> (Enum a) a a (List a))) + (range' <= succ from to)) diff --git a/stdlib/source/lux/control/eq.lux b/stdlib/source/lux/control/eq.lux new file mode 100644 index 000000000..357780fcd --- /dev/null +++ b/stdlib/source/lux/control/eq.lux @@ -0,0 +1,29 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux) + +(sig: #export (Eq a) + (: (-> a a Bool) + =)) + +(def: #export (conj left right) + (All [l r] (-> (Eq l) (Eq r) (Eq [l r]))) + (struct (def: (= [a b] [x y]) + (and (:: left = a x) + (:: right = b y))))) + +(def: #export (disj left right) + (All [l r] (-> (Eq l) (Eq r) (Eq (| l r)))) + (struct (def: (= a|b x|y) + (case [a|b x|y] + [(+0 a) (+0 x)] + (:: left = a x) + + [(+1 b) (+1 y)] + (:: right = b y) + + _ + false)))) diff --git a/stdlib/source/lux/control/fold.lux b/stdlib/source/lux/control/fold.lux new file mode 100644 index 000000000..6e56dacee --- /dev/null +++ b/stdlib/source/lux/control/fold.lux @@ -0,0 +1,12 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux) + +## [Signatures] +(sig: #export (Fold F) + (: (All [a b] + (-> (-> b a a) a (F b) a)) + fold)) diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux new file mode 100644 index 000000000..711c5ae16 --- /dev/null +++ b/stdlib/source/lux/control/functor.lux @@ -0,0 +1,16 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux) + +(sig: #export (Functor f) + (: (All [a b] + (-> (-> a b) (f a) (f b))) + map)) + +(def: #export (compF Functor Functor) + (All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a)))))) + (struct (def: (map f fga) + (:: Functor map (:: Functor map f) fga)))) diff --git a/stdlib/source/lux/control/hash.lux b/stdlib/source/lux/control/hash.lux new file mode 100644 index 000000000..d8ae926ad --- /dev/null +++ b/stdlib/source/lux/control/hash.lux @@ -0,0 +1,15 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (.. eq)) + +## [Signatures] +(sig: #export (Hash a) + (: (Eq a) + eq) + (: (-> a Nat) + hash)) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux new file mode 100644 index 000000000..71a873704 --- /dev/null +++ b/stdlib/source/lux/control/monad.lux @@ -0,0 +1,142 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (.. (functor #as F) + (applicative #as A))) + +## [Utils] +(def: (fold f init xs) + (All [a b] + (-> (-> b a a) a (List b) a)) + (case xs + #;Nil + init + + (#;Cons x xs') + (fold f (f x init) xs'))) + +(def: (map f xs) + (All [a b] + (-> (-> a b) (List a) (List b))) + (case xs + #;Nil + #;Nil + + (#;Cons x xs') + (#;Cons (f x) (map f xs')))) + +(def: (reverse xs) + (All [a] + (-> (List a) (List a))) + (fold (lambda [head tail] (#;Cons head tail)) + #;Nil + xs)) + +(def: (as-pairs xs) + (All [a] (-> (List a) (List [a a]))) + (case xs + (#;Cons x1 (#;Cons x2 xs')) + (#;Cons [x1 x2] (as-pairs xs')) + + _ + #;Nil)) + +## [Signatures] +(sig: #export (Monad m) + (: (A;Applicative m) + applicative) + (: (All [a] + (-> (m (m a)) (m a))) + join)) + +## [Syntax] +(macro: #export (do tokens state) + {#;doc (doc "Macro for easy concatenation of monadic operations." + (do Monad + [y (f1 x) + z (f2 z)] + (wrap (f3 z))))} + (case tokens + (#;Cons monad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) + (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])]) + g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) + g!join (: AST [["" -1 -1] (#;SymbolS ["" " join "])]) + g!apply (: AST [["" -1 -1] (#;SymbolS ["" " apply "])]) + body' (fold (: (-> [AST AST] AST AST) + (lambda [binding body'] + (let [[var value] binding] + (case var + [_ (#;TagS ["" "let"])] + (` (let (~ value) (~ body'))) + + _ + (` (|> (~ value) ((~ g!map) (lambda [(~ var)] (~ body'))) (~ g!join))) + )))) + body + (reverse (as-pairs bindings)))] + (#;Right [state (#;Cons (` (;_lux_case (~ monad) + (~ g!@) + (;_lux_case (~ g!@) + {#applicative {#A;functor {#F;map (~ g!map)} + #A;wrap (~' wrap) + #A;apply (~ g!apply)} + #join (~ g!join)} + (~ body')))) + #;Nil)])) + + _ + (#;Left "Wrong syntax for do"))) + +## [Functions] +(def: #export (seqM monad xs) + (All [M a] + (-> (Monad M) (List (M a)) (M (List a)))) + (case xs + #;Nil + (:: monad wrap #;Nil) + + (#;Cons x xs') + (do monad + [_x x + _xs (seqM monad xs')] + (wrap (#;Cons _x _xs))) + )) + +(def: #export (mapM monad f xs) + (All [M a b] + (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) + (case xs + #;Nil + (:: monad wrap #;Nil) + + (#;Cons x xs') + (do monad + [_x (f x) + _xs (mapM monad f xs')] + (wrap (#;Cons _x _xs))) + )) + +(def: #export (foldM monad f init xs) + (All [M a b] + (-> (Monad M) (-> b a (M a)) a (List b) + (M a))) + (case xs + #;Nil + (:: monad wrap init) + + (#;Cons x xs') + (do monad + [init' (f x init)] + (foldM monad f init' xs')))) + +(def: #export (liftM Monad f) + (All [M a b] + (-> (Monad M) (-> a b) (-> (M a) (M b)))) + (lambda [ma] + (do Monad + [a ma] + (wrap (f a))))) diff --git a/stdlib/source/lux/control/monoid.lux b/stdlib/source/lux/control/monoid.lux new file mode 100644 index 000000000..67f6d868c --- /dev/null +++ b/stdlib/source/lux/control/monoid.lux @@ -0,0 +1,13 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: lux) + +## Signatures +(sig: #export (Monoid a) + (: a + unit) + (: (-> a a a) + append)) diff --git a/stdlib/source/lux/control/number.lux b/stdlib/source/lux/control/number.lux new file mode 100644 index 000000000..d6e9a42b6 --- /dev/null +++ b/stdlib/source/lux/control/number.lux @@ -0,0 +1,22 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux/control [ord])) + +## [Signatures] +(sig: #export (Number n) + (: (ord;Ord n) + ord) + + (do-template [] + [(: (-> n n n) )] + [+] [-] [*] [/] [%]) + + (do-template [] + [(: (-> n n) )] + [negate] [signum] [abs]) + ) diff --git a/stdlib/source/lux/control/ord.lux b/stdlib/source/lux/control/ord.lux new file mode 100644 index 000000000..0021cbe1b --- /dev/null +++ b/stdlib/source/lux/control/ord.lux @@ -0,0 +1,44 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + [lux #- min max] + (.. eq) + lux/codata/function) + +## [Signatures] +(sig: #export (Ord a) + (: (Eq a) + eq) + + (do-template [] + [(: (-> a a Bool) )] + + [<] [<=] [>] [>=])) + +## [Values] +(def: #export (ord eq <) + (All [a] + (-> (Eq a) (-> a a Bool) (Ord a))) + (let [> (flip <)] + (struct + (def: eq eq) + (def: < <) + (def: (<= test subject) + (or (< test subject) + (:: eq = test subject))) + (def: > >) + (def: (>= test subject) + (or (> test subject) + (:: eq = test subject)))))) + +(do-template [ ] + [(def: #export ( ord x y) + (All [a] + (-> (Ord a) a a a)) + (if (:: ord y x) x y))] + + [max >] + [min <]) diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux new file mode 100644 index 000000000..72a92507c --- /dev/null +++ b/stdlib/source/lux/data/bit.lux @@ -0,0 +1,66 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: [lux #- & | ^]) + +## [Values] +(do-template [ ] + [(def: #export ( param subject) + {#;doc } + (-> Nat ) + (_lux_proc ["bit" ] [subject param]))] + + [& "and" "Bit and." Nat] + [| "or" "Bit or." Nat] + [^ "xor" "Bit xor." Nat] + [<< "shift-left" "Bit shift-left." Nat] + [>> "shift-right" "Bit shift-right." Int] + [>>> "unsigned-shift-right" "Bit unsigned-shift-right." Nat] + ) + +(def: #export (count subject) + {#;doc "Count the number of 1s in a bit-map."} + (-> Nat Nat) + (_lux_proc ["bit" "count"] [subject])) + +(def: mask Nat (int-to-nat -1)) + +(def: #export ~ + {#;doc "Bit negation."} + (-> Nat Nat) + (^ mask)) + +(def: #export (clear idx input) + {#;doc "Clear bit at given index."} + (-> Nat Nat Nat) + (& (~ (<< idx +1)) input)) + +(do-template [ ] + [(def: #export ( idx input) + {#;doc } + (-> Nat Nat Nat) + ( (<< idx +1) input))] + + [set | "Set bit at given index."] + [flip ^ "Flip bit at given index."] + ) + +(def: #export (set? idx input) + (-> Nat Nat Bool) + (|> input (& (<< idx +1)) (=+ +0) not)) + +(def: rot-top Nat +64) + +(do-template [
] + [(def: #export ( distance input) + (-> Nat Nat Nat) + (| (
distance input) + ( (-+ (%+ rot-top distance) + rot-top) + input)))] + + [rotate-left << >>>] + [rotate-right >>> <<] + ) diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux new file mode 100644 index 000000000..15dc349ef --- /dev/null +++ b/stdlib/source/lux/data/bool.lux @@ -0,0 +1,47 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control monoid + eq + codec) + (codata function))) + +## [Structures] +(struct: #export _ (Eq Bool) + (def: (= x y) + (if x + y + (not y)))) + +(do-template [ ] + [(struct: #export (Monoid Bool) + (def: unit ) + (def: (append x y) + ( x y)))] + + [ Or@Monoid false or] + [And@Monoid true and] + ) + +(struct: #export _ (Codec Text Bool) + (def: (encode x) + (if x + "true" + "false")) + + (def: (decode input) + (case input + "true" (#;Right true) + "false" (#;Right false) + _ (#;Left "Wrong syntax for Bool.")))) + +## [Values] +(def: #export complement + {#;doc "Generates the complement of a predicate. + That is a predicate that returns the oposite of the original predicate."} + (All [a] (-> (-> a Bool) (-> a Bool))) + (. not)) diff --git a/stdlib/source/lux/data/char.lux b/stdlib/source/lux/data/char.lux new file mode 100644 index 000000000..6af987408 --- /dev/null +++ b/stdlib/source/lux/data/char.lux @@ -0,0 +1,107 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux/control eq + [ord] + codec + hash) + (.. [text "Text/" Monoid])) + +## [Structures] +(struct: #export _ (Eq Char) + (def: (= x y) + (_lux_proc ["jvm" "ceq"] [x y]))) + +(struct: #export _ (Hash Char) + (def: eq Eq) + (def: hash + (|>. [] + (_lux_proc ["jvm" "c2i"]) + [] + (_lux_proc ["jvm" "i2l"]) + int-to-nat))) + +(struct: #export _ (ord;Ord Char) + (def: eq Eq) + + (do-template [ ] + [(def: ( test subject) + (_lux_proc ["jvm" ] [subject test]))] + + [< "clt"] + [> "cgt"] + ) + + (do-template [ ] + [(def: ( test subject) + (or (_lux_proc ["jvm" "ceq"] [subject test]) + (_lux_proc ["jvm" ] [subject test])))] + + [<= "clt"] + [>= "cgt"] + )) + +(struct: #export _ (Codec Text Char) + (def: (encode x) + (let [as-text (case x + #"\t" "\\t" + #"\b" "\\b" + #"\n" "\\n" + #"\r" "\\r" + #"\f" "\\f" + #"\"" "\\\"" + #"\\" "\\\\" + _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))] + ($_ Text/append "#\"" as-text "\""))) + + (def: (decode y) + (let [size (text;size y)] + (if (and (text;starts-with? "#\"" y) + (text;ends-with? "\"" y) + (or (=+ +4 size) + (=+ +5 size))) + (if (=+ +4 size) + (case (text;at +2 y) + #;None + (#;Left (Text/append "Wrong syntax for Char: " y)) + + (#;Some char) + (#;Right char)) + (case [(text;at +2 y) (text;at +3 y)] + [(#;Some #"\\") (#;Some char)] + (case char + #"t" (#;Right #"\t") + #"b" (#;Right #"\b") + #"n" (#;Right #"\n") + #"r" (#;Right #"\r") + #"f" (#;Right #"\f") + #"\"" (#;Right #"\"") + #"\\" (#;Right #"\\") + #"t" (#;Right #"\t") + _ (#;Left (Text/append "Wrong syntax for Char: " y))) + + _ + (#;Left (Text/append "Wrong syntax for Char: " y)))) + (#;Left (Text/append "Wrong syntax for Char: " y)))))) + +## [Values] +(def: #export (space? x) + {#;doc "Checks whether the character is white-space."} + (-> Char Bool) + (_lux_proc ["jvm" "invokestatic:java.lang.Character:isWhitespace:char"] [x])) + +(def: #export (as-text x) + (-> Char Text) + (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x])) + +(def: #export (char x) + (-> Nat Char) + (_lux_proc ["nat" "to-char"] [x])) + +(def: #export (code x) + (-> Char Nat) + (_lux_proc ["char" "to-nat"] [x])) diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux new file mode 100644 index 000000000..ce2f529b9 --- /dev/null +++ b/stdlib/source/lux/data/error.lux @@ -0,0 +1,66 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + ["M" monad #*]))) + +## [Types] +(type: #export (Error a) + (Either Text a)) + +## [Structures] +(struct: #export _ (Functor Error) + (def: (map f ma) + (case ma + (#;Left msg) (#;Left msg) + (#;Right datum) (#;Right (f datum))))) + +(struct: #export _ (Applicative Error) + (def: functor Functor) + + (def: (wrap a) + (#;Right a)) + + (def: (apply ff fa) + (case ff + (#;Right f) + (case fa + (#;Right a) + (#;Right (f a)) + + (#;Left msg) + (#;Left msg)) + + (#;Left msg) + (#;Left msg)) + )) + +(struct: #export _ (Monad Error) + (def: applicative Applicative) + + (def: (join mma) + (case mma + (#;Left msg) (#;Left msg) + (#;Right ma) ma))) + +(struct: #export (ErrorT Monad) + (All [M] (-> (Monad M) (Monad (All [a] (M (Error a)))))) + (def: applicative (compA (get@ #M;applicative Monad) Applicative)) + (def: (join MeMea) + (do Monad + [eMea MeMea] + (case eMea + (#;Left error) + (wrap (#;Left error)) + + (#;Right Mea) + (join Mea))))) + +(def: #export (lift-error Monad) + (All [M a] (-> (Monad M) (-> (M a) (M (Error a))))) + (liftM Monad (:: Monad wrap))) diff --git a/stdlib/source/lux/data/error/exception.lux b/stdlib/source/lux/data/error/exception.lux new file mode 100644 index 000000000..be9a09327 --- /dev/null +++ b/stdlib/source/lux/data/error/exception.lux @@ -0,0 +1,62 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control monad) + (data error + [text]) + [compiler] + (macro [ast] + ["s" syntax #+ syntax: Syntax] + (syntax [common])))) + +## [Types] +(type: #export Exception + (-> Text Text)) + +## [Values] +(def: #hidden _Text/append_ + (-> Text Text Text) + (:: text;Monoid append)) + +(def: #export (catch exception then try) + (All [a] + (-> Exception (-> Text a) (Error a) + (Error a))) + (case try + (#;Right output) + (#;Right output) + + (#;Left error) + (if (text;starts-with? (exception "") error) + (#;Right (then error)) + (#;Left error)))) + +(def: #export (else to-do try) + (All [a] + (-> (-> Text a) (Error a) a)) + (case try + (#;Right output) + output + + (#;Left error) + (to-do error))) + +(def: #export (return value) + (All [a] (-> a (Error a))) + (#;Right value)) + +(def: #export (throw exception message) + (All [a] (-> Exception Text (Error a))) + (#;Left (exception message))) + +(syntax: #export (exception: {_ex-lev common;export-level} {name s;local-symbol}) + (do @ + [current-module compiler;current-module-name + #let [g!message (ast;symbol ["" "message"])]] + (wrap (list (` (def: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name])) (~ g!message)) + Exception + ($_ _Text/append_ "[" (~ (ast;text current-module)) ";" (~ (ast;text name)) "]\t" (~ g!message)))))))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux new file mode 100644 index 000000000..c51e4b04c --- /dev/null +++ b/stdlib/source/lux/data/format/json.lux @@ -0,0 +1,1031 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control functor + applicative + monad + eq + codec) + (data [bool] + [text "Text/" Eq Monoid] + text/format + [number #* "Real/" Codec] + maybe + [char "Char/" Eq Codec] + error + [sum] + [product] + (struct [list "" Fold "List/" Monad] + [vector #+ Vector vector "Vector/" Monad] + [dict #+ Dict])) + (codata [function]) + [compiler #+ Monad with-gensyms] + (macro [syntax #+ syntax:] + [ast] + [poly #+ poly:]) + [type] + [lexer #+ Lexer Monad])) + +## [Types] +(do-template [ ] + [(type: #export )] + + [Null Unit] + [Boolean Bool] + [Number Real] + [String Text] + ) + +(type: #export #rec JSON + (#Null Null) + (#Boolean Boolean) + (#Number Number) + (#String String) + (#Array (Vector JSON)) + (#Object (Dict String JSON))) + +(do-template [ ] + [(type: #export )] + + [Array (Vector JSON)] + [Object (Dict String JSON)] + ) + +(type: #export (Parser a) + (-> JSON (Error a))) + +(type: #export (Gen a) + (-> a JSON)) + +## [Syntax] +(syntax: #export (json token) + (let [(^open) Monad + wrapper (lambda [x] (` (;;json (~ x))))] + (case token + (^template [ ] + [_ ( value)] + (wrap (list (` (: JSON ( (~ ( value)))))))) + ([#;BoolS ast;bool #Boolean] + [#;IntS (|>. int-to-real ast;real) #Number] + [#;RealS ast;real #Number] + [#;TextS ast;text #String]) + + [_ (#;TagS ["" "null"])] + (wrap (list (` (: JSON #Null)))) + + [_ (#;TupleS members)] + (wrap (list (` (: JSON (#Array (vector (~@ (List/map wrapper members)))))))) + + [_ (#;RecordS pairs)] + (do Monad + [pairs' (mapM @ + (lambda [[slot value]] + (case slot + [_ (#;TextS key-name)] + (wrap (` [(~ (ast;text key-name)) (~ (wrapper value))])) + + _ + (compiler;fail "Wrong syntax for JSON object."))) + pairs)] + (wrap (list (` (: JSON (#Object (dict;from-list text;Hash (list (~@ pairs'))))))))) + + _ + (wrap (list token)) + ))) + +## [Values] +(def: #hidden (show-null _) (-> Null Text) "null") +(do-template [ ] + [(def: (-> Text) (:: encode))] + + [show-boolean Boolean bool;Codec] + [show-number Number number;Codec] + [show-string String text;Codec]) + +(def: (show-array show-json elems) + (-> (-> JSON Text) (-> Array Text)) + (format "[" + (|> elems (Vector/map show-json) vector;vector-to-list (text;join-with ",")) + "]")) + +(def: (show-object show-json object) + (-> (-> JSON Text) (-> Object Text)) + (format "{" + (|> object + dict;entries + (List/map (lambda [[key value]] (format (:: text;Codec encode key) ":" (show-json value)))) + (text;join-with ",")) + "}")) + +(def: (show-json json) + (-> JSON Text) + (case json + (^template [ ] + ( value) + ( value)) + ([#Null show-null] + [#Boolean show-boolean] + [#Number show-number] + [#String show-string] + [#Array (show-array show-json)] + [#Object (show-object show-json)]) + )) + +(def: #export null + JSON + #Null) + +(def: #export (keys json) + (-> JSON (Error (List String))) + (case json + (#Object obj) + (#;Right (dict;keys obj)) + + _ + (#;Left (format "Can't get keys of a non-object.")))) + +(def: #export (get key json) + (-> String JSON (Error JSON)) + (case json + (#Object obj) + (case (dict;get key obj) + (#;Some value) + (#;Right value) + + #;None + (#;Left (format "Missing field " (show-string key) " on object."))) + + _ + (#;Left (format "Can't get field " (show-string key) " of a non-object.")))) + +(def: #export (set key value json) + (-> String JSON JSON (Error JSON)) + (case json + (#Object obj) + (#;Right (#Object (dict;put key value obj))) + + _ + (#;Left (format "Can't set field " (show-string key) " of a non-object.")))) + +(do-template [ ] + [(def: #export ( key json) + (-> Text JSON (Error )) + (case (get key json) + (#;Right ( value)) + (#;Right value) + + (#;Right _) + (#;Left (format "Wrong value type at key " (show-string key))) + + (#;Left error) + (#;Left error)))] + + [get-boolean #Boolean Boolean] + [get-number #Number Number] + [get-string #String String] + [get-array #Array Array] + [get-object #Object Object] + ) + +(do-template [ ] + [(def: #export ( value) + (Gen ) + ( value))] + + [gen-boolean Boolean #Boolean] + [gen-number Number #Number] + [gen-string String #String] + [gen-array Array #Array] + [gen-object Object #Object] + ) + +(def: #export (gen-nullable gen) + (All [a] (-> (Gen a) (Gen (Maybe a)))) + (lambda [elem] + (case elem + #;None #Null + (#;Some value) (gen value)))) + +## Lexers +(def: space~ + (Lexer Text) + (lexer;some' lexer;space)) + +(def: data-sep + (Lexer [Text Char Text]) + ($_ lexer;seq space~ (lexer;this-char #",") space~)) + +(def: null~ + (Lexer Null) + (do Monad + [_ (lexer;this "null")] + (wrap []))) + +(do-template [ ] + [(def: + (Lexer Boolean) + (do Monad + [_ (lexer;this )] + (wrap )))] + + [t~ "true" true] + [f~ "false" false] + ) + +(def: boolean~ + (Lexer Boolean) + (lexer;either t~ f~)) + +(def: number~ + (Lexer Number) + (do Monad + [?sign (: (Lexer (Maybe Text)) + (lexer;opt (lexer;this "-"))) + digits (: (Lexer Text) + (lexer;many' lexer;digit)) + ?decimals (: (Lexer (Maybe Text)) + (lexer;opt (do @ + [_ (lexer;this ".")] + (lexer;many' lexer;digit))))] + (case (: (Error Real) + (Real/decode (format (default "" ?sign) + digits "." + (default "0" ?decimals)))) + (#;Left message) + (lexer;fail message) + + (#;Right value) + (wrap value)))) + +(def: (un-escape escaped) + (-> Char Text) + (case escaped + #"t" "\t" + #"b" "\b" + #"n" "\n" + #"r" "\r" + #"f" "\f" + #"\"" "\"" + #"\\" "\\" + _ "")) + +(def: string-body~ + (Lexer Text) + (loop [_ []] + (do Monad + [chars (lexer;some' (lexer;none-of "\\\"")) + stop-char lexer;peek] + (if (Char/= #"\\" stop-char) + (do @ + [_ lexer;any + escaped lexer;any + next-chars (recur [])] + (wrap (format chars (un-escape escaped) next-chars))) + (wrap chars))))) + +(def: string~ + (Lexer String) + (do Monad + [_ (lexer;this "\"") + string-body string-body~ + _ (lexer;this "\"")] + (wrap string-body))) + +(def: (kv~ json~) + (-> (-> Unit (Lexer JSON)) (Lexer [String JSON])) + (do Monad + [key string~ + _ space~ + _ (lexer;this-char #":") + _ space~ + value (json~ [])] + (wrap [key value]))) + +(do-template [ ] + [(def: ( json~) + (-> (-> Unit (Lexer JSON)) (Lexer )) + (do Monad + [_ (lexer;this-char ) + _ space~ + elems (lexer;sep-by data-sep ) + _ space~ + _ (lexer;this-char )] + (wrap ( elems))))] + + [array~ Array #"[" #"]" (json~ []) vector;list-to-vector] + [object~ Object #"{" #"}" (kv~ json~) (dict;from-list text;Hash)] + ) + +(def: (json~' _) + (-> Unit (Lexer JSON)) + ($_ lexer;alt null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) + +## [Structures] +(struct: #export _ (Functor Parser) + (def: (map f ma) + (lambda [json] + (case (ma json) + (#;Left msg) + (#;Left msg) + + (#;Right a) + (#;Right (f a)))))) + +(struct: #export _ (Applicative Parser) + (def: functor Functor) + + (def: (wrap x json) + (#;Right x)) + + (def: (apply ff fa) + (lambda [json] + (case (ff json) + (#;Right f) + (case (fa json) + (#;Right a) + (#;Right (f a)) + + (#;Left msg) + (#;Left msg)) + + (#;Left msg) + (#;Left msg))))) + +(struct: #export _ (Monad Parser) + (def: applicative Applicative) + + (def: (join mma) + (lambda [json] + (case (mma json) + (#;Left msg) + (#;Left msg) + + (#;Right ma) + (ma json))))) + +## [Values] +## Syntax +(do-template [ 
]
+  [(def: #export ( json)
+     (Parser )
+     (case json
+       ( value)
+       (#;Right (
 value))
+
+       _
+       (#;Left (format "JSON value is not a "  ": " (show-json json)))))]
+
+  [unit Unit #Null    "null"    id]
+  [bool Bool #Boolean "boolean" id]
+  [int  Int  #Number  "number"  real-to-int]
+  [real Real #Number  "number"  id]
+  [text Text #String  "string"  id]
+  )
+
+(do-template [       
]
+  [(def: #export ( test json)
+     (->  (Parser Bool))
+     (case json
+       ( value)
+       (#;Right (::  = test (
 value)))
+
+       _
+       (#;Left (format "JSON value is not a "  ": " (show-json json)))))
+
+   (def: #export ( test json)
+     (->  (Parser Unit))
+     (case json
+       ( value)
+       (let [value (
 value)]
+         (if (::  = test value)
+           (#;Right [])
+           (#;Left (format "Value mismatch: "
+                           (::  encode test) "=/=" (::  encode value)))))
+
+       _
+       (#;Left (format "JSON value is not a "  ": " (show-json json)))))]
+
+  [bool? bool! Bool bool;Eq   bool;Codec   #Boolean "boolean" id]
+  [int?  int!  Int  number;Eq  number;Codec  #Number  "number"  real-to-int]
+  [real? real! Real number;Eq number;Codec #Number  "number"  id]
+  [text? text! Text text;Eq   text;Codec   #String  "string"  id]
+  )
+
+(def: #export (char json)
+  (Parser Char)
+  (case json
+    (#String input)
+    (case (Char/decode (format "#\"" input "\""))
+      (#;Right value)
+      (#;Right value)
+
+      (#;Left _)
+      (#;Left (format "Invalid format for char: " input)))
+
+    _
+    (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+
+(def: #export (char? test json)
+  (-> Char (Parser Bool))
+  (case json
+    (#String input)
+    (case (Char/decode (format "#\"" input "\""))
+      (#;Right value)
+      (if (:: char;Eq = test value)
+        (#;Right true)
+        (#;Left (format "Value mismatch: "
+                        (:: char;Codec encode test) "=/=" (:: char;Codec encode value))))
+
+      (#;Left _)
+      (#;Left (format "Invalid format for char: " input)))
+
+    _
+    (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+
+(def: #export (char! test json)
+  (-> Char (Parser Unit))
+  (case json
+    (#String input)
+    (case (Char/decode (format "#\"" input "\""))
+      (#;Right value)
+      (if (:: char;Eq = test value)
+        (#;Right [])
+        (#;Left (format "Value mismatch: "
+                        (:: char;Codec encode test) "=/=" (:: char;Codec encode value))))
+
+      (#;Left _)
+      (#;Left (format "Invalid format for char: " input)))
+
+    _
+    (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+
+(def: #export (nullable parser)
+  (All [a] (-> (Parser a) (Parser (Maybe a))))
+  (lambda [json]
+    (case json
+      #Null
+      (#;Right #;None)
+      
+      _
+      (case (parser json)
+        (#;Left error)
+        (#;Left error)
+
+        (#;Right value)
+        (#;Right (#;Some value)))
+      )))
+
+(def: #export (array parser)
+  (All [a] (-> (Parser a) (Parser (List a))))
+  (lambda [json]
+    (case json
+      (#Array values)
+      (do Monad
+        [elems (mapM @ parser (vector;vector-to-list values))]
+        (wrap elems))
+
+      _
+      (#;Left (format "JSON value is not an array: " (show-json json))))))
+
+(def: #export (object parser)
+  (All [a] (-> (Parser a) (Parser (Dict String a))))
+  (lambda [json]
+    (case json
+      (#Object fields)
+      (do Monad
+        [kvs (mapM @
+                   (lambda [[key val']]
+                     (do @
+                       [val (parser val')]
+                       (wrap [key val])))
+                   (dict;entries fields))]
+        (wrap (dict;from-list text;Hash kvs)))
+
+      _
+      (#;Left (format "JSON value is not an object: " (show-json json))))))
+
+(def: #export (at idx parser)
+  (All [a] (-> Nat (Parser a) (Parser a)))
+  (lambda [json]
+    (case json
+      (#Array values)
+      (case (vector;at idx values)
+        (#;Some value)
+        (case (parser value)
+          (#;Right output)
+          (#;Right output)
+
+          (#;Left error)
+          (#;Left (format "JSON array index [" (%n idx) "]: (" error ") @ " (show-json json))))
+
+        #;None
+        (#;Left (format "JSON array does not have index " (%n idx) " @ " (show-json json))))
+      
+      _
+      (#;Left (format "JSON value is not an array: " (show-json json))))))
+
+(def: #export (field field-name parser)
+  (All [a] (-> Text (Parser a) (Parser a)))
+  (lambda [json]
+    (case (get field-name json)
+      (#;Some value)
+      (case (parser value)
+        (#;Right output)
+        (#;Right output)
+
+        (#;Left error)
+        (#;Left (format "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
+
+      (#;Left _)
+      (#;Left (format "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
+
+(def: #export any
+  (Parser JSON)
+  (lambda [json]
+    (#;Right json)))
+
+(def: #export (seq pa pb)
+  (All [a b] (-> (Parser a) (Parser b) (Parser [a b])))
+  (do Monad
+    [=a pa
+     =b pb]
+    (wrap [=a =b])))
+
+(def: #export (alt pa pb json)
+  (All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
+  (case (pa json)
+    (#;Right a)
+    (sum;right (sum;left a))
+
+    (#;Left message0)
+    (case (pb json)
+      (#;Right b)
+      (sum;right (sum;right b))
+
+      (#;Left message1)
+      (#;Left message0))))
+
+(def: #export (either pl pr json)
+  (All [a] (-> (Parser a) (Parser a) (Parser a)))
+  (case (pl json)
+    (#;Right x)
+    (#;Right x)
+
+    _
+    (pr json)))
+
+(def: #export (opt p json)
+  (All [a]
+    (-> (Parser a) (Parser (Maybe a))))
+  (case (p json)
+    (#;Left _)  (#;Right #;None)
+    (#;Right x) (#;Right (#;Some x))))
+
+(def: #export (run parser json)
+  (All [a] (-> (Parser a) JSON (Error a)))
+  (parser json))
+
+(def: #export (ensure test parser json)
+  (All [a] (-> (Parser Unit) (Parser a) (Parser a)))
+  (case (test json)
+    (#;Right _)
+    (parser json)
+
+    (#;Left error)
+    (#;Left error)))
+
+(def: #export (array-size! array-size json)
+  (-> Nat (Parser Unit))
+  (case json
+    (#Array parts)
+    (if (=+ array-size (vector;size parts))
+      (#;Right [])
+      (#;Left (format "JSON array does no have size " (%n array-size) " " (show-json json))))
+
+    _
+    (#;Left (format "JSON value is not an array: " (show-json json)))))
+
+(def: #export (object-fields! wanted-fields json)
+  (-> (List String) (Parser Unit))
+  (case json
+    (#Object kvs)
+    (let [actual-fields (dict;keys kvs)]
+      (if (and (=+ (list;size wanted-fields) (list;size actual-fields))
+               (list;every? (list;member? text;Eq wanted-fields)
+                            actual-fields))
+        (#;Right [])
+        (#;Left (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
+
+    _
+    (#;Left (format "JSON value is not an object: " (show-json json)))))
+
+## [Structures]
+(struct: #export _ (Eq JSON)
+  (def: (= x y)
+    (case [x y]
+      [#Null #Null]
+      true
+
+      (^template [ ]
+                 [( x') ( y')]
+                 (::  = x' y'))
+      ([#Boolean bool;Eq]
+       [#Number  number;Eq]
+       [#String  text;Eq])
+
+      [(#Array xs) (#Array ys)]
+      (and (=+ (vector;size xs) (vector;size ys))
+           (fold (lambda [idx prev]
+                   (and prev
+                        (default false
+                          (do Monad
+                            [x' (vector;at idx xs)
+                             y' (vector;at idx ys)]
+                            (wrap (= x' y'))))))
+                 true
+                 (list;indices (vector;size xs))))
+      
+      [(#Object xs) (#Object ys)]
+      (and (=+ (dict;size xs) (dict;size ys))
+           (fold (lambda [[xk xv] prev]
+                   (and prev
+                        (case (dict;get xk ys)
+                          #;None   false
+                          (#;Some yv) (= xv yv))))
+                 true
+                 (dict;entries xs)))
+      
+      _
+      false)))
+
+(struct: #export _ (Codec Text JSON)
+  (def: encode show-json)
+  (def: decode (lexer;run (json~' []))))
+
+## [Syntax]
+(type: Shape
+  (#ArrayShape (List AST))
+  (#ObjectShape (List [Text AST])))
+
+(def: _shape^
+  (syntax;Syntax Shape)
+  (syntax;alt (syntax;tuple (syntax;some syntax;any))
+              (syntax;record (syntax;some (syntax;seq syntax;text syntax;any)))))
+
+(syntax: #export (shape^ {shape _shape^})
+  (case shape
+    (#ArrayShape parts)
+    (let [array-size (list;size parts)
+          parsers (|> parts
+                      (list;zip2 (list;indices array-size))
+                      (List/map (lambda [[idx parser]]
+                                  (` (at (~ (ast;nat idx)) (~ parser))))))]
+      (wrap (list (` ($_ seq (~@ parsers))))))
+
+    (#ObjectShape kvs)
+    (let [fields (List/map product;left kvs)
+          parsers (List/map (lambda [[field-name parser]]
+                              (` (field (~ (ast;text field-name)) (~ parser))))
+                            kvs)]
+      (wrap (list (` ($_ seq (~@ parsers))))))
+    ))
+
+(syntax: #export (shape!^ {shape _shape^})
+  (case shape
+    (#ArrayShape parts)
+    (let [array-size (list;size parts)
+          parsers (|> parts
+                      (list;zip2 (list;indices array-size))
+                      (List/map (lambda [[idx parser]]
+                                  (` (at (~ (ast;nat idx)) (~ parser))))))]
+      (wrap (list (` (ensure (array-size! (~ (ast;nat array-size)))
+                             ($_ seq (~@ parsers)))))))
+
+    (#ObjectShape kvs)
+    (let [fields (List/map product;left kvs)
+          parsers (List/map (lambda [[field-name parser]]
+                              (` (field (~ (ast;text field-name)) (~ parser))))
+                            kvs)]
+      (wrap (list (` (ensure (object-fields! (list (~@ (List/map ast;text fields))))
+                             ($_ seq (~@ parsers)))))))
+    ))
+
+## [Polytypism]
+(def: #hidden _map_
+  (All [a b] (-> (-> a b) (List a) (List b)))
+  List/map)
+
+(poly: #export (|Codec@JSON//encode| *env* :x:)
+  (let [->Codec//encode (: (-> AST AST)
+                           (lambda [.type.] (` (-> (~ .type.) JSON))))]
+    (let% [ (do-template [  ]
+                     [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//encode (` ))) ))))]
+
+                     [Unit poly;unit (lambda [(~ (ast;symbol ["" "0"]))] #Null)]
+                     [Bool poly;bool ;;boolean]
+                     [Int  poly;int  (|>. int-to-real ;;number)]
+                     [Real poly;real ;;number]
+                     [Char poly;char (|>. char;->Text ;;string)]
+                     [Text poly;text ;;string])]
+      ($_ compiler;either
+          
+          (with-gensyms [g!type-fun g!case g!input g!key g!val]
+            (do @
+              [:sub: (poly;list :x:)
+               [g!vars members] (poly;tuple :sub:)
+               :val: (case members
+                       (^ (list :key: :val:))
+                       (do @ [_ (poly;text :key:)]
+                         (wrap :val:))
+
+                       _
+                       (compiler;fail ""))
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               .val. (|Codec@JSON//encode| new-*env* :val:)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (|> (~ g!input)
+                                (_map_ (: (-> [Text (~ (type;type-to-ast :val:))]
+                                              [Text JSON])
+                                          (lambda [[(~ g!key) (~ g!val)]]
+                                            [(~ g!key)
+                                             ((~ .val.) (~ g!val))])))
+                                ;;object))
+                          )))
+              ))
+          (do @
+            [:sub: (poly;maybe :x:)
+             .sub. (|Codec@JSON//encode| *env* :sub:)]
+            (wrap (` (: (~ (->Codec//encode (type;type-to-ast :x:)))
+                        (;;nullable (~ .sub.))))))
+          (do @
+            [:sub: (poly;list :x:)
+             .sub. (|Codec@JSON//encode| *env* :sub:)]
+            (wrap (` (: (~ (->Codec//encode (type;type-to-ast :x:)))
+                        (|>. (_map_ (~ .sub.)) vector;list-to-vector ;;array)))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars cases] (poly;variant :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               pattern-matching (mapM @
+                                      (lambda [[name :case:]]
+                                        (do @
+                                          [#let [tag (ast;tag name)]
+                                           encoder (|Codec@JSON//encode| new-*env* :case:)]
+                                          (wrap (list (` ((~ tag) (~ g!case)))
+                                                      (` (;;json [(~ (ast;text (product;right name)))
+                                                                  ((~ encoder) (~ g!case))]))))))
+                                      cases)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (case (~ g!input)
+                              (~@ (List/join pattern-matching))))
+                          )))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars slots] (poly;record :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               synthesis (mapM @
+                               (lambda [[name :slot:]]
+                                 (do @
+                                   [encoder (|Codec@JSON//encode| new-*env* :slot:)]
+                                   (wrap [(` (~ (ast;text (product;right name))))
+                                          (` ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input))))])))
+                               slots)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (;;json (~ (ast;record synthesis))))
+                          )))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               pattern-matching (mapM @
+                                      (lambda [:member:]
+                                        (do @
+                                          [g!member (compiler;gensym "g!member")
+                                           encoder (|Codec@JSON//encode| new-*env* :member:)]
+                                          (wrap [g!member encoder])))
+                                      members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//encode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//encode g!vars))
+                                     (~ (->Codec//encode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]
+               #let [.tuple. (` [(~@ (List/map product;left pattern-matching))])]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (case (~ g!input)
+                              (~ .tuple.)
+                              (;;array (list (~@ (List/map (lambda [[g!member g!encoder]]
+                                                             (` ((~ g!encoder) (~ g!member))))
+                                                           pattern-matching))))))
+                          )))
+              ))
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (|Codec@JSON//encode| *env* :func:)
+             .args. (mapM @ (|Codec@JSON//encode| *env*) :args:)]
+            (wrap (` (: (~ (->Codec//encode (type;type-to-ast :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          (poly;bound *env* :x:)
+          (compiler;fail (format "Can't create JSON encoder for: " (type;type-to-text :x:)))
+          ))))
+
+(poly: #export (Codec//decode *env* :x:)
+  (let [->Codec//decode (: (-> AST AST)
+                           (lambda [.type.] (` (-> JSON (Error (~ .type.))))))]
+    (let% [ (do-template [  ]
+                     [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//decode (` ))) ))))]
+
+                     [Unit poly;unit ;;null]
+                     [Bool poly;bool ;;bool]
+                     [Int  poly;int  ;;int]
+                     [Real poly;real ;;real]
+                     [Char poly;char ;;char]
+                     [Text poly;text ;;text])
+            (do-template [  ]
+                       [(do @
+                          [:sub: ( :x:)
+                           .sub. (Codec//decode *env* :sub:)]
+                          (wrap (` (: (~ (->Codec//decode (type;type-to-ast :x:)))
+                                      ( (~ .sub.))))))]
+
+                       [Maybe poly;maybe ;;nullable]
+                       [List  poly;list  ;;array])]
+      ($_ compiler;either
+          
+          (with-gensyms [g!type-fun g!case g!input g!key g!val]
+            (do @
+              [:sub: (poly;list :x:)
+               [g!vars members] (poly;tuple :sub:)
+               :val: (case members
+                       (^ (list :key: :val:))
+                       (do @ [_ (poly;text :key:)]
+                         (wrap :val:))
+
+                       _
+                       (compiler;fail ""))
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               .val. (Codec//decode new-*env* :val:)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (do Monad
+                              [(~ g!key) (;;keys (~ g!input))]
+                              (mapM (~ (' %))
+                                    (lambda [(~ g!key)]
+                                      (do Monad
+                                        [(~ g!val) (;;get (~ g!key) (~ g!input))
+                                         (~ g!val) (;;run (~ .val.) (~ g!val))]
+                                        ((~ (' wrap)) [(~ g!key) (~ g!val)])))
+                                    (~ g!key))))
+                          )))
+              ))
+          
+          (with-gensyms [g!type-fun g!_]
+            (do @
+              [[g!vars cases] (poly;variant :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               pattern-matching (mapM @
+                                      (lambda [[name :case:]]
+                                        (do @
+                                          [#let [tag (ast;tag name)]
+                                           decoder (Codec//decode new-*env* :case:)]
+                                          (wrap (list (` (do Monad
+                                                           [(~ g!_) (;;at 0 (;;text! (~ (ast;text (product;right name)))))
+                                                            (~ g!_) (;;at 1 (~ decoder))]
+                                                           ((~ (' wrap)) ((~ tag) (~ g!_)))))))))
+                                      cases)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))
+                     base-parser (` ($_ ;;either
+                                        (~@ (List/join pattern-matching))))
+                     parser (case g!vars
+                              #;Nil
+                              base-parser
+
+                              _
+                              (` (lambda [(~@ g!vars)] (~ base-parser))))]]
+              (wrap (` (: (~ :x:+) (~ parser))))
+              ))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars slots] (poly;record :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               extraction (mapM @
+                                (lambda [[name :slot:]]
+                                  (do @
+                                    [#let [g!member (ast;symbol ["" (product;right name)])]
+                                     decoder (Codec//decode new-*env* :slot:)]
+                                    (wrap (list g!member
+                                                (` (;;get (~ (ast;text (product;right name))) (~ g!input)))
+                                                g!member
+                                                (` ((~ decoder) (~ g!member)))))))
+                                slots)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]]
+              (wrap (` (: (~ :x:+)
+                          (lambda [(~@ g!vars) (~ g!input)]
+                            (do Monad
+                              [(~@ (List/join extraction))]
+                              ((~ (' wrap)) (~ (ast;record (List/map (lambda [[name :slot:]]
+                                                                       [(ast;tag name) (ast;symbol ["" (product;right name)])])
+                                                                     slots))))))
+                          )))))
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-*env* (poly;extend-env g!type-fun g!vars *env*)]
+               pattern-matching (mapM @
+                                      (lambda [:member:]
+                                        (do @
+                                          [g!member (compiler;gensym "g!member")
+                                           decoder (Codec//decode new-*env* :member:)]
+                                          (wrap [g!member decoder])))
+                                      members)
+               #let [:x:+ (case g!vars
+                            #;Nil
+                            (->Codec//decode (type;type-to-ast :x:))
+
+                            _
+                            (` (All (~ g!type-fun) [(~@ g!vars)]
+                                 (-> (~@ (List/map ->Codec//decode g!vars))
+                                     (~ (->Codec//decode (` ((~ (type;type-to-ast :x:)) (~@ g!vars)))))))))]
+               #let [.decoder. (case g!vars
+                                 #;Nil
+                                 (` (;;shape^ [(~@ (List/map product;right pattern-matching))]))
+
+                                 _
+                                 (` (lambda [(~@ g!vars)]
+                                      (;;shape^ [(~@ (List/map product;right pattern-matching))]))))]]
+              (wrap (` (: (~ :x:+) (~ .decoder.))))
+              ))
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (Codec//decode *env* :func:)
+             .args. (mapM @ (Codec//decode *env*) :args:)]
+            (wrap (` (: (~ (->Codec//decode (type;type-to-ast :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          (do @
+            [g!bound (poly;bound *env* :x:)]
+            (wrap g!bound))
+          (compiler;fail (format "Can't create JSON decoder for: " (type;type-to-text :x:)))
+          ))))
+
+(syntax: #export (Codec :x:)
+  (wrap (list (` (: (Codec JSON (~ :x:))
+                    (struct
+                     (def: (~ (' encode)) (|Codec@JSON//encode| (~ :x:)))
+                     (def: (~ (' decode)) (Codec//decode (~ :x:)))
+                     ))))))
diff --git a/stdlib/source/lux/data/ident.lux b/stdlib/source/lux/data/ident.lux
new file mode 100644
index 000000000..4f85da77d
--- /dev/null
+++ b/stdlib/source/lux/data/ident.lux
@@ -0,0 +1,57 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control eq
+                codec
+                hash)
+       (data [text "Text/" Monoid Eq])))
+
+## [Types]
+## (type: Ident
+##   [Text Text])
+
+## [Functions]
+(do-template [ ]
+  [(def: #export ( [module name])
+     (-> Ident Text)
+     )]
+
+  [module module]
+  [name   name]
+  )
+
+## [Structures]
+(struct: #export _ (Eq Ident)
+  (def: (= [xmodule xname] [ymodule yname])
+    (and (Text/= xmodule ymodule)
+         (Text/= xname yname))))
+
+(struct: #export _ (Codec Text Ident)
+  (def: (encode [module name])
+    (case module
+      "" name
+      _ ($_ Text/append module ";" name)))
+  
+  (def: (decode input)
+    (if (Text/= "" input)
+      (#;Left (Text/append "Invalid format for Ident: " input))
+      (case (text;split-all-with ";" input)
+        (^ (list name))
+        (#;Right ["" name])
+
+        (^ (list module name))
+        (#;Right [module name])
+
+        _
+        (#;Left (Text/append "Invalid format for Ident: " input))))))
+
+(struct: #export _ (Hash Ident)
+  (def: eq Eq)
+  
+  (def: (hash [module name])
+    (let [(^open) text;Hash]
+      (*+ (hash module) (hash name)))))
diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux
new file mode 100644
index 000000000..c986db0c0
--- /dev/null
+++ b/stdlib/source/lux/data/identity.lux
@@ -0,0 +1,37 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux/control (functor #as F #refer #all)
+               (applicative #as A #refer #all)
+               (monad #as M #refer #all)
+               (comonad #as CM #refer #all)))
+
+## [Types]
+(type: #export (Identity a)
+  a)
+
+## [Structures]
+(struct: #export _ (Functor Identity)
+  (def: map id))
+
+(struct: #export _ (Applicative Identity)
+  (def: functor Functor)
+
+  (def: wrap id)
+
+  (def: (apply ff fa)
+    (ff fa)))
+
+(struct: #export _ (Monad Identity)
+  (def: applicative Applicative)
+  
+  (def: join id))
+
+(struct: #export _ (CoMonad Identity)
+  (def: functor Functor)
+  (def: unwrap id)
+  (def: split id))
diff --git a/stdlib/source/lux/data/log.lux b/stdlib/source/lux/data/log.lux
new file mode 100644
index 000000000..9e6be6d56
--- /dev/null
+++ b/stdlib/source/lux/data/log.lux
@@ -0,0 +1,62 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux/control monoid
+               ["A" applicative #*]
+               functor
+               ["M" monad #*]))
+
+(type: #export (Log l a)
+  [l a])
+
+(struct: #export Functor (All [l]
+                                (Functor (Log l)))
+  (def: (map f fa)
+    (let [[log datum] fa]
+      [log (f datum)])))
+
+(struct: #export (Applicative mon) (All [l]
+                                          (-> (Monoid l) (Applicative (Log l))))
+  (def: functor Functor)
+
+  (def: (wrap x)
+    [(:: mon unit) x])
+
+  (def: (apply ff fa)
+    (let [[log1 f] ff
+          [log2 a] fa]
+      [(:: mon append log1 log2) (f a)])))
+
+(struct: #export (Monad mon) (All [l]
+                                    (-> (Monoid l) (Monad (Log l))))
+  (def: applicative (Applicative mon))
+
+  (def: (join mma)
+    (let [[log1 [log2 a]] mma]
+      [(:: mon append log1 log2) a])))
+
+(def: #export (log l)
+  (All [l] (-> l (Log l Unit)))
+  [l []])
+
+(struct: #export (LogT Monoid Monad)
+  (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Log l a))))))
+  (def: applicative (A;compA (get@ #M;applicative Monad) (Applicative Monoid)))
+  (def: (join MlMla)
+    (do Monad
+      [[l1 Mla] (: (($ 1) (Log ($ 0) (($ 1) (Log ($ 0) ($ 2)))))
+                   MlMla)
+       [l2 a] (: (($ 1) (Log ($ 0) ($ 2)))
+                 Mla)]
+      (wrap [(:: Monoid append l1 l2) a]))))
+
+(def: #export (lift-log Monoid Monad)
+  (All [l M a] (-> (Monoid l) (Monad M) (-> (M a) (M (Log l a)))))
+  (lambda [ma]
+    (do Monad
+      [a ma]
+      (wrap [(:: Monoid unit) a]))))
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
new file mode 100644
index 000000000..16aa9e30a
--- /dev/null
+++ b/stdlib/source/lux/data/maybe.lux
@@ -0,0 +1,82 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control (monoid #as m #refer #all)
+                (functor #as F #refer #all)
+                (applicative #as A #refer #all)
+                (monad #as M #refer #all)
+                eq)))
+
+## [Types]
+## (type: (Maybe a)
+##   #;None
+##   (#;Some a))
+
+## [Structures]
+(struct: #export Monoid (All [a] (Monoid (Maybe a)))
+  (def: unit #;None)
+  (def: (append xs ys)
+    (case xs
+      #;None     ys
+      (#;Some x) (#;Some x))))
+
+(struct: #export _ (Functor Maybe)
+  (def: (map f ma)
+    (case ma
+      #;None     #;None
+      (#;Some a) (#;Some (f a)))))
+
+(struct: #export _ (Applicative Maybe)
+  (def: functor Functor)
+
+  (def: (wrap x)
+    (#;Some x))
+
+  (def: (apply ff fa)
+    (case [ff fa]
+      [(#;Some f) (#;Some a)]
+      (#;Some (f a))
+
+      _
+      #;None)))
+
+(struct: #export _ (Monad Maybe)
+  (def: applicative Applicative)
+
+  (def: (join mma)
+    (case mma
+      #;None      #;None
+      (#;Some xs) xs)))
+
+(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Maybe a))))
+  (def: (= mx my)
+    (case [mx my]
+      [#;None #;None]
+      true
+
+      [(#;Some x) (#;Some y)]
+      (:: Eq = x y)
+      
+      _
+      false)))
+
+(struct: #export (MaybeT Monad)
+  (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a))))))
+  (def: applicative (A;compA (get@ #M;applicative Monad) Applicative))
+  (def: (join MmMma)
+    (do Monad
+      [mMma MmMma]
+      (case mMma
+        #;None
+        (wrap #;None)
+
+        (#;Some Mma)
+        (join Mma)))))
+
+(def: #export (lift-maybe Monad)
+  (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
+  (liftM Monad (:: Monad wrap)))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
new file mode 100644
index 000000000..41c75402e
--- /dev/null
+++ b/stdlib/source/lux/data/number.lux
@@ -0,0 +1,222 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control number
+                monoid
+                eq
+                hash
+                [ord]
+                enum
+                bounded
+                codec)
+       (data error)))
+
+## [Structures]
+(do-template [ ]
+  [(struct: #export _ (Eq )
+     (def: = ))]
+
+  [ Nat =+]
+  [ Int =]
+  [Frac =..]
+  [Real =.]
+  )
+
+(do-template [     ]
+  [(struct: #export _ (ord;Ord )
+     (def: eq )
+     (def: < )
+     (def: <= )
+     (def: > )
+     (def: >= ))]
+
+  [ Nat  Eq <+  <=+  >+  >=+]
+  [ Int  Eq <   <=   >   >=]
+  [Frac Eq <.. <=.. >.. >=..]
+  [Real Eq <.  <=.  >.  >=.]
+  )
+
+(struct: #export _ (Number Nat)
+  (def: ord Ord)
+  (def: + ++)
+  (def: - -+)
+  (def: * *+)
+  (def: / /+)
+  (def: % %+)
+  (def: negate id)
+  (def: abs id)
+  (def: (signum x)
+    (case x
+      +0 +0
+      _  +1))
+  )
+
+(do-template [  <+> <-> <*>  <%> <=> <<> <0> <1> <-1>]
+  [(struct: #export _ (Number )
+     (def: ord )
+     (def: + <+>)
+     (def: - <->)
+     (def: * <*>)
+     (def: / )
+     (def: % <%>)
+     (def: negate (<*> <-1>))
+     (def: (abs x)
+       (if (<<> <0> x)
+         (<*> <-1> x)
+         x))
+     (def: (signum x)
+       (cond (<=> <0> x) <0>
+             (<<> <0> x) <-1>
+             ## else
+             <1>))
+     )]
+
+  [ Int  Ord +  -  *  /  %  =  <  0   1   -1]
+  [Real Ord +. -. *. /. %. =. <. 0.0 1.0 -1.0]
+  )
+
+(do-template [   ]
+  [(struct: #export _ (Enum )
+     (def: ord )
+     (def: succ )
+     (def: pred ))]
+
+  [Nat Ord (++ +1) (-+ +1)]
+  [Int Ord inc    dec]
+  )
+
+(do-template [  ]
+  [(struct: #export _ (Bounded )
+     (def: top )
+     (def: bottom ))]
+
+  [ Nat (_lux_proc ["nat" "max-value"] [])                            (_lux_proc ["nat" "min-value"] [])]
+  [ Int (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] [])   (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])]
+  [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])])
+
+(do-template [   ]
+  [(struct: #export  (Monoid )
+     (def: unit )
+     (def: (append x y) ( x y)))]
+
+  [ Add@Monoid  Nat +0                       ++]
+  [ Mul@Monoid  Nat +1                       *+]
+  [ Max@Monoid  Nat (:: Bounded bottom)  max+]
+  [ Min@Monoid  Nat (:: Bounded top)     min+]
+  [ Add@Monoid  Int 0                        +]
+  [ Mul@Monoid  Int 1                        *]
+  [ Max@Monoid  Int (:: Bounded bottom)  max]
+  [ Min@Monoid  Int (:: Bounded top)     min]
+  [Add@Monoid Real 0.0                      +.]
+  [Mul@Monoid Real 1.0                      *.]
+  [Max@Monoid Real (:: Bounded bottom) max.]
+  [Min@Monoid Real (:: Bounded top)    min.]
+  )
+
+(def: (text.replace pattern value template)
+  (-> Text Text Text Text)
+  (_lux_proc ["jvm" "invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"] [template pattern value]))
+
+(do-template [   ]
+  [(struct: #export _ (Codec Text )
+     (def: (encode x)
+       (_lux_proc  [x]))
+
+     (def: (decode input)
+       (case (_lux_proc  [input])
+         (#;Some value)
+         (#;Right value)
+
+         #;None
+         (#;Left ))))]
+
+  [Nat  ["nat" "encode"]  ["nat" "decode"]  "Couldn't decode Nat"]
+  [Frac ["frac" "encode"] ["frac" "decode"] "Couldn't decode Frac"]
+  )
+
+(def: clean-number
+  (-> Text Text)
+  (|>. (text.replace "," "")
+       (text.replace "_" "")))
+
+(do-template [   ]
+  [(struct: #export _ (Codec Text )
+     (def: (encode x)
+       (_lux_proc ["jvm" ] [x]))
+
+     (def: (decode input)
+       (_lux_proc ["jvm" "try"]
+                  [(#;Right (_lux_proc ["jvm" ] [(clean-number input)]))
+                   (lambda [e] (#;Left ))])))]
+
+  [ Int "invokevirtual:java.lang.Object:toString:" "invokestatic:java.lang.Long:parseLong:java.lang.String"     "Couldn't parse Int"]
+  [Real "invokevirtual:java.lang.Object:toString:" "invokestatic:java.lang.Double:parseDouble:java.lang.String" "Couldn't parse Real"]
+  )
+
+(struct: #export _ (Hash Nat)
+  (def: eq Eq)
+  (def: hash id))
+
+(struct: #export _ (Hash Int)
+  (def: eq Eq)
+  (def: hash int-to-nat))
+
+(struct: #export _ (Hash Real)
+  (def: eq Eq)
+  
+  (def: hash
+    (|>. (:: Codec encode)
+         []
+         (_lux_proc ["jvm" "invokevirtual:java.lang.Object:hashCode:"])
+         []
+         (_lux_proc ["jvm" "i2l"])
+         int-to-nat)))
+
+## [Values & Syntax]
+(do-template [     ]
+  [(struct: #export  (Codec Text Nat)
+     (def: (encode value)
+       (_lux_proc ["jvm" ] [(nat-to-int value)]))
+
+     (def: (decode repr)
+       (_lux_proc ["jvm" "try"]
+                  [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:valueOf:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [])])))
+                   (lambda [ex] (#;Left ))])))
+
+   (macro: #export ( tokens state)
+     {#;doc }
+     (case tokens
+       (#;Cons [meta (#;TextS repr)] #;Nil)
+       (case (::  decode repr)
+         (#;Right value)
+         (#;Right [state (list [meta (#;NatS value)])])
+
+         (#;Left error)
+         (#;Left error))
+
+       _
+       (#;Left )))]
+
+  [Binary@Codec "invokestatic:java.lang.Long:toBinaryString:long" 2  bin "Invalid binary syntax."
+   (doc "Given syntax for a binary number, generates a Nat."
+        (bin "11001001"))]
+  [Octal@Codec  "invokestatic:java.lang.Long:toOctalString:long"  8  oct "Invalid octal syntax."
+   (doc "Given syntax for an octal number, generates a Nat."
+        (oct "0615243"))]
+  [Hex@Codec    "invokestatic:java.lang.Long:toHexString:long"    16 hex "Invalid hexadecimal syntax."
+   (doc "Given syntax for a hexadecimal number, generates a Nat."
+        (hex "deadBEEF"))]
+  )
+
+(do-template [ ]
+  [(def: #export  Real
+     (_lux_proc ["jvm" ] []))]
+
+  [nan  "getstatic:java.lang.Double:NaN"]
+  [+inf "getstatic:java.lang.Double:POSITIVE_INFINITY"]
+  [-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY"]
+  )
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
new file mode 100644
index 000000000..f542d7a38
--- /dev/null
+++ b/stdlib/source/lux/data/product.lux
@@ -0,0 +1,35 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module: lux)
+
+## [Functions]
+(do-template [  ]
+  [(def: #export ( xy)
+     (All [a b] (-> [a b] ))
+     (let [[x y] xy]
+       ))]
+
+  [left  a x]
+  [right b y])
+
+(def: #export (curry f)
+  (All [a b c]
+    (-> (-> [a b] c)
+        (-> a b c)))
+  (lambda [x y]
+    (f [x y])))
+
+(def: #export (uncurry f)
+  (All [a b c]
+    (-> (-> a b c) (-> [a b] c)))
+  (lambda [xy]
+    (let [[x y] xy]
+      (f x y))))
+
+(def: #export (swap xy)
+  (All [a b] (-> [a b] [b a]))
+  (let [[x y] xy]
+    [y x]))
diff --git a/stdlib/source/lux/data/struct/array.lux b/stdlib/source/lux/data/struct/array.lux
new file mode 100644
index 000000000..6c81683d3
--- /dev/null
+++ b/stdlib/source/lux/data/struct/array.lux
@@ -0,0 +1,224 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monoid
+                functor
+                applicative
+                monad
+                eq
+                fold)
+       (data error
+             (struct [list "List/" Fold])
+             [product])
+       ))
+
+## [Types]
+(type: #export (Array a)
+  (#;HostT "#Array" (#;Cons a #;Nil)))
+
+## [Functions]
+(def: #export (new size)
+  (All [a] (-> Nat (Array a)))
+  (_lux_proc ["array" "new"] [size]))
+
+(def: #export (size xs)
+  (All [a] (-> (Array a) Nat))
+  (_lux_proc ["array" "size"] [xs]))
+
+(def: #export (get i xs)
+  (All [a]
+    (-> Nat (Array a) (Maybe a)))
+  (_lux_proc ["array" "get"] [xs i]))
+
+(def: #export (put i x xs)
+  (All [a]
+    (-> Nat a (Array a) (Array a)))
+  (_lux_proc ["array" "put"] [xs i x]))
+
+(def: #export (remove i xs)
+  (All [a]
+    (-> Nat (Array a) (Array a)))
+  (_lux_proc ["array" "remove"] [xs i]))
+
+(def: #export (copy length src-start src-array dest-start dest-array)
+  (All [a] (-> Nat Nat (Array a) Nat (Array a)
+               (Array a)))
+  (if (=+ +0 length)
+    dest-array
+    (List/fold (lambda [offset target]
+                 (case (get (++ offset src-start) src-array)
+                   #;None
+                   target
+                   
+                   (#;Some value)
+                   (put (++ offset dest-start) value target)))
+               dest-array
+               (list;range+ +0 (dec+ length)))))
+
+(def: #export (occupied array)
+  {#;doc "Finds out how many cells in an array are occupied."}
+  (All [a] (-> (Array a) Nat))
+  (List/fold (lambda [idx count]
+               (case (get idx array)
+                 #;None
+                 count
+                 
+                 (#;Some _)
+                 (inc+ count)))
+             +0
+             (list;indices (size array))))
+
+(def: #export (vacant array)
+  {#;doc "Finds out how many cells in an array are vacant."}
+  (All [a] (-> (Array a) Nat))
+  (-+ (occupied array) (size array)))
+
+(def: #export (filter p xs)
+  (All [a]
+    (-> (-> a Bool) (Array a) (Array a)))
+  (List/fold (: (-> Nat (Array ($ 0)) (Array ($ 0)))
+                (lambda [idx xs']
+                  (case (get idx xs)
+                    #;None
+                    xs'
+
+                    (#;Some x)
+                    (if (p x)
+                      xs'
+                      (remove idx xs')))))
+             xs
+             (list;indices (size xs))))
+
+(def: #export (find p xs)
+  (All [a]
+    (-> (-> a Bool) (Array a) (Maybe a)))
+  (let [arr-size (size xs)]
+    (loop [idx +0]
+      (if (<+ arr-size idx)
+        (case (get idx xs)
+          #;None
+          (recur (inc+ idx))
+          
+          (#;Some x)
+          (if (p x)
+            (#;Some x)
+            (recur (inc+ idx))))
+        #;None))))
+
+(def: #export (find+ p xs)
+  {#;doc "Just like 'find', but with access to the index of each value."}
+  (All [a]
+    (-> (-> Nat a Bool) (Array a) (Maybe [Nat a])))
+  (let [arr-size (size xs)]
+    (loop [idx +0]
+      (if (<+ arr-size idx)
+        (case (get idx xs)
+          #;None
+          (recur (inc+ idx))
+          
+          (#;Some x)
+          (if (p idx x)
+            (#;Some [idx x])
+            (recur (inc+ idx))))
+        #;None))))
+
+(def: #export (clone xs)
+  (All [a] (-> (Array a) (Array a)))
+  (let [arr-size (size xs)]
+    (List/fold (lambda [idx ys]
+                 (case (get idx xs)
+                   #;None
+                   ys
+
+                   (#;Some x)
+                   (put idx x ys)))
+               (new arr-size)
+               (list;indices arr-size))))
+
+(def: #export (from-list xs)
+  (All [a] (-> (List a) (Array a)))
+  (product;right (List/fold (lambda [x [idx arr]]
+                              [(inc+ idx) (put idx x arr)])
+                            [+0 (new (list;size xs))]
+                            xs)))
+
+(def: #export (to-list array)
+  (All [a] (-> (Array a) (List a)))
+  (let [_size (size array)]
+    (product;right (List/fold (lambda [_ [idx tail]]
+                                (case (get idx array)
+                                  (#;Some head)
+                                  [(dec+ idx) (#;Cons head tail)]
+
+                                  #;None
+                                  [(dec+ idx) tail]))
+                              [(dec+ _size) #;Nil]
+                              (list;repeat _size [])
+                              ))))
+
+## [Structures]
+(struct: #export (Eq (^open "a:"))
+  (All [a] (-> (Eq a) (Eq (Array a))))
+  (def: (= xs ys)
+    (let [sxs (size xs)
+          sxy (size ys)]
+      (and (lux;=+ sxy sxs)
+           (List/fold (lambda [idx prev]
+                        (and prev
+                             (case [(get idx xs) (get idx ys)]
+                               [#;None #;None]
+                               true
+
+                               [(#;Some x) (#;Some y)]
+                               (a:= x y)
+
+                               _
+                               false)))
+                      true
+                      (list;range+ +0 (dec+ sxs)))))
+    ))
+
+(struct: #export Monoid (All [a]
+                                 (Monoid (Array a)))
+  (def: unit (new +0))
+
+  (def: (append xs ys)
+    (let [sxs (size xs)
+          sxy (size ys)]
+      (|> (new (++ sxy sxs))
+          (copy sxs +0 xs +0)
+          (copy sxy +0 ys sxs)))))
+
+(struct: #export _ (Functor Array)
+  (def: (map f ma)
+    (let [arr-size (size ma)]
+      (if (=+ +0 arr-size)
+        (new arr-size)
+        (List/fold (: (-> Nat (Array ($ 1)) (Array ($ 1)))
+                      (lambda [idx mb]
+                        (case (get idx ma)
+                          #;None
+                          mb
+
+                          (#;Some x)
+                          (put idx (f x) mb))))
+                   (new arr-size)
+                   (list;range+ +0 (dec+ arr-size)))))))
+
+(struct: #export _ (Fold Array)
+  (def: (fold f init xs)
+    (let [arr-size (size xs)]
+      (loop [so-far init
+             idx +0]
+        (if (<+ arr-size idx)
+          (case (get idx xs)
+            #;None
+            (recur so-far (inc+ idx))
+
+            (#;Some value)
+            (recur (f value so-far) (inc+ idx)))
+          so-far)))))
diff --git a/stdlib/source/lux/data/struct/dict.lux b/stdlib/source/lux/data/struct/dict.lux
new file mode 100644
index 000000000..a10e30dca
--- /dev/null
+++ b/stdlib/source/lux/data/struct/dict.lux
@@ -0,0 +1,675 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control hash
+                eq)
+       (data maybe
+             (struct [list "List/" Fold Functor Monoid]
+                     [array #+ Array "Array/" Functor Fold])
+             [bit]
+             [product]
+             text/format
+             [number])
+       ))
+
+## This implementation of Hash Array Mapped Trie (HAMT) is based on
+## Clojure's PersistentHashMap implementation.
+## That one is further based on Phil Bagwell's Hash Array Mapped Trie.
+
+## [Utils]
+## Bitmaps are used to figure out which branches on a #Base node are
+## populated. The number of bits that are 1s in a bitmap signal the
+## size of the #Base node.
+(type: BitMap Nat)
+
+## Represents the position of a node in a BitMap.
+## It's meant to be a single bit set on a 32-bit word.
+## The position of the bit reflects whether an entry in an analogous
+## position exists within a #Base, as reflected in it's BitMap.
+(type: BitPosition Nat)
+
+## An index into an array.
+(type: Index Nat)
+
+## A hash-code derived from a key during tree-traversal.
+(type: Hash-Code Nat)
+
+## Represents the nesting level of a leaf or node, when looking-it-up
+## while exploring the tree.
+## Changes in levels are done by right-shifting the hashes of keys by
+## the appropriate multiple of the branching-exponent.
+## A shift of 0 means root level.
+## A shift of (* branching-exponent 1) means level 2.
+## A shift of (* branching-exponent N) means level N+1.
+(type: Level Nat)
+
+## Nodes for the tree data-structure that organizes the data inside
+## Dicts.
+(type: (Node k v)
+  (#Hierarchy Nat (Array (Node k v)))
+  (#Base BitMap
+         (Array (Either (Node k v)
+                        [k v])))
+  (#Collisions Hash-Code (Array [k v])))
+
+## #Hierarchy nodes are meant to point down only to lower-level nodes.
+(type: (Hierarchy k v)
+  [Nat (Array (Node k v))])
+
+## #Base nodes may point down to other nodes, but also to leaves,
+## which are KV pairs.
+(type: (Base k v)
+  (Array (Either (Node k v)
+                 [k v])))
+
+## #Collisions are collections of KV-pairs for which the key is
+## different on each case, but their hashes are all the same (thus
+## causing a collision).
+(type: (Collisions k v)
+  (Array [k v]))
+
+## That bitmap for an empty #Base is 0.
+## Which is the same as 0000 0000 0000 0000 0000 0000 0000 0000.
+## Or 0x00000000.
+## Which is 32 zeroes, since the branching factor is 32.
+(def: clean-bitmap
+  BitMap
+  +0)
+
+## Bitmap position (while looking inside #Base nodes) is determined by
+## getting 5 bits from a hash of the key being looked up and using
+## them as an index into the array inside #Base.
+## Since the data-structure can have multiple levels (and the hash has
+## more than 5 bits), the binary-representation of the hash is shifted
+## by 5 positions on each step (2^5 = 32, which is the branching
+## factor).
+## The initial shifting level, though, is 0 (which corresponds to the
+## shift in the shallowest node on the tree, which is the root node).
+(def: root-level
+  Level
+  +0)
+
+## The exponent to which 2 must be elevated, to reach the branching
+## factor of the data-structure.
+(def: branching-exponent
+  Nat
+  +5)
+
+## The threshold on which #Hierarchy nodes are demoted to #Base nodes,
+## which is 1/4 of the branching factor (or a left-shift 2).
+(def: demotion-threshold
+  Nat
+  (bit;<< (-+ +2 branching-exponent) +1))
+
+## The threshold on which #Base nodes are promoted to #Hierarchy nodes,
+## which is 1/2 of the branching factor (or a left-shift 1).
+(def: promotion-threshold
+  Nat
+  (bit;<< (-+ +1 branching-exponent) +1))
+
+## The size of hierarchy-nodes, which is 2^(branching-exponent).
+(def: hierarchy-nodes-size
+  Nat
+  (bit;<< branching-exponent +1))
+
+## The cannonical empty node, which is just an empty #Base node.
+(def: empty
+  Node
+  (#Base clean-bitmap (array;new +0)))
+
+## Expands a copy of the array, to have 1 extra slot, which is used
+## for storing the value.
+(def: (insert! idx value old-array)
+  (All [a] (-> Index a (Array a) (Array a)))
+  (let [old-size (array;size old-array)]
+    (|> (: (Array ($ 0))
+           (array;new (inc+ old-size)))
+        (array;copy idx +0 old-array +0)
+        (array;put idx value)
+        (array;copy (-+ idx old-size) idx old-array (inc+ idx)))))
+
+## Creates a copy of an array with an index set to a particular value.
+(def: (update! idx value array)
+  (All [a] (-> Index a (Array a) (Array a)))
+  (|> array array;clone (array;put idx value)))
+
+## Creates a clone of the array, with an empty position at index.
+(def: (vacant! idx array)
+  (All [a] (-> Index (Array a) (Array a)))
+  (|> array array;clone (array;remove idx)))
+
+## Shrinks a copy of the array by removing the space at index.
+(def: (remove! idx array)
+  (All [a] (-> Index (Array a) (Array a)))
+  (let [new-size (dec+ (array;size array))]
+    (|> (array;new new-size)
+        (array;copy idx +0 array +0)
+        (array;copy (-+ idx new-size) (inc+ idx) array idx))))
+
+## Given a top-limit for indices, produces all indices in [0, R).
+(def: indices-for
+  (-> Nat (List Index))
+  (|>. dec+ (list;range+ +0)))
+
+## Increases the level-shift by the branching-exponent, to explore
+## levels further down the tree.
+(def: level-up
+  (-> Level Level)
+  (++ branching-exponent))
+
+(def: hierarchy-mask BitMap (dec+ hierarchy-nodes-size))
+
+## Gets the branching-factor sized section of the hash corresponding
+## to a particular level, and uses that as an index into the array.
+(def: (level-index level hash)
+  (-> Level Hash-Code Index)
+  (bit;& hierarchy-mask
+         (bit;>>> level hash)))
+
+## A mechanism to go from indices to bit-positions.
+(def: (->bit-position index)
+  (-> Index BitPosition)
+  (bit;<< index +1))
+
+## The bit-position within a base that a given hash-code would have.
+(def: (bit-position level hash)
+  (-> Level Hash-Code BitPosition)
+  (->bit-position (level-index level hash)))
+
+(def: (bit-position-is-set? bit bitmap)
+  (-> BitPosition BitMap Bool)
+  (not (=+ clean-bitmap (bit;& bit bitmap))))
+
+## Figures out whether a bitmap only contains a single bit-position.
+(def: only-bit-position?
+  (-> BitPosition BitMap Bool)
+  =+)
+
+(def: (set-bit-position bit bitmap)
+  (-> BitPosition BitMap BitMap)
+  (bit;| bit bitmap))
+
+(def: unset-bit-position
+  (-> BitPosition BitMap BitMap)
+  bit;^)
+
+## Figures out the size of a bitmap-indexed array by counting all the
+## 1s within the bitmap.
+(def: bitmap-size
+  (-> BitMap Nat)
+  bit;count)
+
+## A mask that, for a given bit position, only allows all the 1s prior
+## to it, which would indicate the bitmap-size (and, thus, index)
+## associated with it.
+(def: bit-position-mask
+  (-> BitPosition BitMap)
+  dec+)
+
+## The index on the base array, based on it's bit-position.
+(def: (base-index bit-position bitmap)
+  (-> BitPosition BitMap Index)
+  (bitmap-size (bit;& (bit-position-mask bit-position)
+                      bitmap)))
+
+## Produces the index of a KV-pair within a #Collisions node.
+(def: (collision-index Hash key colls)
+  (All [K V] (-> (Hash K) K (Collisions K V) (Maybe Index)))
+  (:: Monad map product;left
+      (array;find+ (lambda [idx [key' val']]
+                     (:: Hash = key key'))
+                   colls)))
+
+## When #Hierarchy nodes grow too small, they're demoted to #Base
+## nodes to save space.
+(def: (demote-hierarchy except-idx [h-size h-array])
+  (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)]))
+  (List/fold (lambda [idx (^@ node [bitmap base])]
+               (case (array;get idx h-array)
+                 #;None            node
+                 (#;Some sub-node) (if (=+ except-idx idx)
+                                     node
+                                     [(set-bit-position (->bit-position idx) bitmap)
+                                      (array;put idx (#;Left sub-node) base)])
+                 ))
+             [clean-bitmap
+              (: (Base ($ 0) ($ 1))
+                 (array;new (dec+ h-size)))]
+             (list;indices (array;size h-array))))
+
+## When #Base nodes grow too large, they're promoted to #Hierarchy to
+## add some depth to the tree and help keep it's balance.
+(def: (promote-base put' Hash level bitmap base)
+  (All [K V]
+    (-> (-> Level Hash-Code K V (Hash K) (Node K V) (Node K V))
+        (Hash K) Level
+        BitMap (Base K V)
+        (Array (Node K V))))
+  (product;right (List/fold (lambda [hierarchy-idx (^@ default [base-idx h-array])]
+                              (if (bit-position-is-set? (->bit-position hierarchy-idx)
+                                                        bitmap)
+                                [(inc+ base-idx)
+                                 (case (array;get base-idx base)
+                                   (#;Some (#;Left sub-node))
+                                   (array;put hierarchy-idx sub-node h-array)
+
+                                   (#;Some (#;Right [key' val']))
+                                   (array;put hierarchy-idx
+                                              (put' (level-up level) (:: Hash hash key') key' val' Hash empty)
+                                              h-array)
+
+                                   #;None
+                                   (undefined))]
+                                default))
+                            [+0
+                             (: (Array (Node ($ 0) ($ 1)))
+                                (array;new hierarchy-nodes-size))]
+                            (indices-for hierarchy-nodes-size))))
+
+## All empty nodes look the same (a #Base node with clean bitmap is
+## used).
+## So, this test is introduced to detect them.
+(def: (empty?' node)
+  (All [K V] (-> (Node K V) Bool))
+  (case node
+    (^~ (#Base ;;clean-bitmap _))
+    true
+
+    _
+    false))
+
+(def: (put' level hash key val Hash node)
+  (All [K V] (-> Level Hash-Code K V (Hash K) (Node K V) (Node K V)))
+  (case node
+    ## For #Hierarchy nodes, I check whether I can add the element to
+    ## a sub-node. If impossible, I introduced a new singleton sub-node.
+    (#Hierarchy _size hierarchy)
+    (let [idx (level-index level hash)
+          [_size' sub-node] (: [Nat (Node ($ 0) ($ 1))]
+                               (case (array;get idx hierarchy)
+                                 (#;Some sub-node)
+                                 [_size sub-node]
+
+                                 _
+                                 [(inc+ _size) empty]))]
+      (#Hierarchy _size'
+                  (update! idx (put' (level-up level) hash key val Hash sub-node)
+                           hierarchy)))
+
+    ## For #Base nodes, I check if the corresponding BitPosition has
+    ## already been used.
+    (#Base bitmap base)
+    (let [bit (bit-position level hash)]
+      (if (bit-position-is-set? bit bitmap)
+        ## If so...
+        (let [idx (base-index bit bitmap)]
+          (case (array;get idx base)
+            #;None
+            (undefined)
+
+            ## If it's being used by a node, I add the KV to it.
+            (#;Some (#;Left sub-node))
+            (let [sub-node' (put' (level-up level) hash key val Hash sub-node)]
+              (#Base bitmap (update! idx (#;Left sub-node') base)))
+
+            ## Otherwise, if it's being used by a KV, I compare the keys.
+            (#;Some (#;Right key' val'))
+            (if (:: Hash = key key')
+              ## If the same key is found, I replace the value.
+              (#Base bitmap (update! idx (#;Right key val) base))
+              ## Otherwise, I compare the hashes of the keys.
+              (#Base bitmap (update! idx
+                                     (#;Left (let [hash' (:: Hash hash key')]
+                                               (if (=+ hash hash')
+                                                 ## If the hashes are
+                                                 ## the same, a new
+                                                 ## #Collisions node
+                                                 ## is added.
+                                                 (#Collisions hash (|> (: (Array [($ 0) ($ 1)])
+                                                                          (array;new +2))
+                                                                       (array;put +0 [key' val'])
+                                                                       (array;put +1 [key val])))
+                                                 ## Otherwise, I can
+                                                 ## just keep using
+                                                 ## #Base nodes, so I
+                                                 ## add both KV pairs
+                                                 ## to the empty one.
+                                                 (let [next-level (level-up level)]
+                                                   (|> empty
+                                                       (put' next-level hash' key' val' Hash)
+                                                       (put' next-level hash  key  val Hash))))))
+                                     base)))))
+        ## However, if the BitPosition has not been used yet, I check
+        ## whether this #Base node is ready for a promotion.
+        (let [base-count (bitmap-size bitmap)]
+          (if (>=+ promotion-threshold base-count)
+            ## If so, I promote it to a #Hierarchy node, and add the new
+            ## KV-pair as a singleton node to it.
+            (#Hierarchy (inc+ base-count)
+                        (|> (promote-base put' Hash level bitmap base)
+                            (array;put (level-index level hash)
+                                       (put' (level-up level) hash key val Hash empty))))
+            ## Otherwise, I just resize the #Base node to accommodate the
+            ## new KV-pair.
+            (#Base (set-bit-position bit bitmap)
+                   (insert! (base-index bit bitmap) (#;Right [key val]) base))))))
+    
+    ## For #Collisions nodes, I compare the hashes.
+    (#Collisions _hash _colls)
+    (if (=+ hash _hash)
+      ## If they're equal, that means the new KV contributes to the
+      ## collisions.
+      (case (collision-index Hash key _colls)
+        ## If the key was already present in the collisions-list, it's
+        ## value gets updated.
+        (#;Some coll-idx)
+        (#Collisions _hash (update! coll-idx [key val] _colls))
+
+        ## Otherwise, the KV-pair is added to the collisions-list.
+        #;None
+        (#Collisions _hash (insert! (array;size _colls) [key val] _colls)))
+      ## If the hashes are not equal, I create a new #Base node that
+      ## contains the old #Collisions node, plus the new KV-pair.
+      (|> (#Base (bit-position level _hash)
+                 (|> (: (Base ($ 0) ($ 1))
+                        (array;new +1))
+                     (array;put +0 (#;Left node))))
+          (put' level hash key val Hash)))
+    ))
+
+(def: (remove' level hash key Hash node)
+  (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Node K V)))
+  (case node
+    ## For #Hierarchy nodes, find out if there's a valid sub-node for
+    ## the Hash-Code.
+    (#Hierarchy h-size h-array)
+    (let [idx (level-index level hash)]
+      (case (array;get idx h-array)
+        ## If not, there's nothing to remove.
+        #;None
+        node
+
+        ## But if there is, try to remove the key from the sub-node.
+        (#;Some sub-node)
+        (let [sub-node' (remove' (level-up level) hash key Hash sub-node)]
+          ## Then check if a removal was actually done.
+          (if (== sub-node sub-node')
+            ## If not, then there's nothing to change here either.
+            node
+            ## But if the sub-removal yielded an empty sub-node...
+            (if (empty?' sub-node')
+              ## Check if it's due time for a demotion.
+              (if (<=+ demotion-threshold h-size)
+                ## If so, perform it.
+                (#Base (demote-hierarchy idx [h-size h-array]))
+                ## Otherwise, just clear the space.
+                (#Hierarchy (dec+ h-size) (vacant! idx h-array)))
+              ## But if the sub-removal yielded a non-empty node, then
+              ## just update the hiearchy branch.
+              (#Hierarchy h-size (update! idx sub-node' h-array)))))))
+
+    ## For #Base nodes, check whether the BitPosition is set.
+    (#Base bitmap base)
+    (let [bit (bit-position level hash)]
+      (if (bit-position-is-set? bit bitmap)
+        (let [idx (base-index bit bitmap)]
+          (case (array;get idx base)
+            #;None
+            (undefined)
+
+            ## If set, check if it's a sub-node, and remove the KV
+            ## from it.
+            (#;Some (#;Left sub-node))
+            (let [sub-node' (remove' (level-up level) hash key Hash sub-node)]
+              ## Verify that it was removed.
+              (if (== sub-node sub-node')
+                ## If not, there's also nothing to change here.
+                node
+                ## But if it came out empty...
+                (if (empty?' sub-node')
+                  ### ... figure out whether that's the only position left.
+                  (if (only-bit-position? bit bitmap)
+                    ## If so, removing it leaves this node empty too.
+                    empty
+                    ## But if not, then just unset the position and
+                    ## remove the node.
+                    (#Base (unset-bit-position bit bitmap)
+                           (remove! idx base)))
+                  ## But, if it didn't come out empty, then the
+                  ## position is kept, and the node gets updated.
+                  (#Base bitmap
+                         (update! idx (#;Left sub-node') base)))))
+
+            ## If, however, there was a KV pair instead of a sub-node.
+            (#;Some (#;Right [key' val']))
+            ## Check if the keys match.
+            (if (:: Hash = key key')
+              ## If so, remove the KV pair and unset the BitPosition.
+              (#Base (unset-bit-position bit bitmap)
+                     (remove! idx base))
+              ## Otherwise, there's nothing to remove.
+              node)))
+        ## If the BitPosition is not set, there's nothing to remove.
+        node))
+
+    ## For #Collisions nodes, It need to find out if the key already existst.
+    (#Collisions _hash _colls)
+    (case (collision-index Hash key _colls)
+      ## If not, then there's nothing to remove.
+      #;None
+      node
+
+      ## But if so, then check the size of the collisions list.
+      (#;Some idx)
+      (if (=+ +1 (array;size _colls))
+        ## If there's only one left, then removing it leaves us with
+        ## an empty node.
+        empty
+        ## Otherwise, just shrink the array by removing the KV pair.
+        (#Collisions _hash (remove! idx _colls))))
+    ))
+
+(def: (get' level hash key Hash node)
+  (All [K V] (-> Level Hash-Code K (Hash K) (Node K V) (Maybe V)))
+  (case node
+    ## For #Hierarchy nodes, just look-up the key on its children.
+    (#Hierarchy _size hierarchy)
+    (case (array;get (level-index level hash) hierarchy)
+      #;None            #;None
+      (#;Some sub-node) (get' (level-up level) hash key Hash sub-node))
+
+    ## For #Base nodes, check the leaves, and recursively check the branches.
+    (#Base bitmap base)
+    (let [bit (bit-position level hash)]
+      (if (bit-position-is-set? bit bitmap)
+        (case (array;get (base-index bit bitmap) base)
+          #;None
+          (undefined)
+          
+          (#;Some (#;Left sub-node))
+          (get' (level-up level) hash key Hash sub-node)
+
+          (#;Some (#;Right [key' val']))
+          (if (:: Hash = key key')
+            (#;Some val')
+            #;None))
+        #;None))
+
+    ## For #Collisions nodes, do a linear scan of all the known KV-pairs.
+    (#Collisions _hash _colls)
+    (:: Monad map product;right
+        (array;find (|>. product;left (:: Hash = key))
+                    _colls))
+    ))
+
+(def: (size' node)
+  (All [K V] (-> (Node K V) Nat))
+  (case node
+    (#Hierarchy _size hierarchy)
+    (Array/fold ++ +0 (Array/map size' hierarchy))
+    
+    (#Base _ base)
+    (Array/fold ++ +0 (Array/map (lambda [sub-node']
+                                   (case sub-node'
+                                     (#;Left sub-node) (size' sub-node)
+                                     (#;Right _)       +1))
+                                 base))
+
+    (#Collisions hash colls)
+    (array;size colls)
+    ))
+
+(def: (entries' node)
+  (All [K V] (-> (Node K V) (List [K V])))
+  (case node
+    (#Hierarchy _size hierarchy)
+    (Array/fold (lambda [sub-node tail] (List/append (entries' sub-node) tail))
+                #;Nil
+                hierarchy)
+
+    (#Base bitmap base)
+    (Array/fold (lambda [branch tail]
+                  (case branch
+                    (#;Left sub-node)
+                    (List/append (entries' sub-node) tail)
+
+                    (#;Right [key' val'])
+                    (#;Cons [key' val'] tail)))
+                #;Nil
+                base)
+    
+    (#Collisions hash colls)
+    (Array/fold (lambda [[key' val'] tail] (#;Cons [key' val'] tail))
+                #;Nil
+                colls)))
+
+## [Exports]
+(type: #export (Dict k v)
+  {#;doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."}
+  {#hash (Hash k)
+   #root (Node k v)})
+
+(def: #export (new Hash)
+  (All [K V] (-> (Hash K) (Dict K V)))
+  {#hash Hash
+   #root empty})
+
+(def: #export (put key val [Hash node])
+  (All [K V] (-> K V (Dict K V) (Dict K V)))
+  [Hash (put' root-level (:: Hash hash key) key val Hash node)])
+
+(def: #export (remove key [Hash node])
+  (All [K V] (-> K (Dict K V) (Dict K V)))
+  [Hash (remove' root-level (:: Hash hash key) key Hash node)])
+
+(def: #export (get key [Hash node])
+  (All [K V] (-> K (Dict K V) (Maybe V)))
+  (get' root-level (:: Hash hash key) key Hash node))
+
+(def: #export (contains? key table)
+  (All [K V] (-> K (Dict K V) Bool))
+  (case (get key table)
+    #;None     false
+    (#;Some _) true))
+
+(def: #export (put~ key val table)
+  {#;doc "Only puts the KV-pair if the key is not already present."}
+  (All [K V] (-> K V (Dict K V) (Dict K V)))
+  (if (contains? key table)
+    table
+    (put key val table)))
+
+(def: #export (update key f table)
+  {#;doc "Transforms the value located at key (if available), using the given function."}
+  (All [K V] (-> K (-> V V) (Dict K V) (Dict K V)))
+  (case (get key table)
+    #;None
+    table
+
+    (#;Some val)
+    (put key (f val) table)))
+
+(def: #export size
+  (All [K V] (-> (Dict K V) Nat))
+  (|>. product;right size'))
+
+(def: #export empty?
+  (All [K V] (-> (Dict K V) Bool))
+  (|>. size (=+ +0)))
+
+(def: #export (entries dict)
+  (All [K V] (-> (Dict K V) (List [K V])))
+  (entries' (product;right dict)))
+
+(def: #export (from-list Hash kvs)
+  (All [K V] (-> (Hash K) (List [K V]) (Dict K V)))
+  (List/fold (lambda [[k v] dict]
+               (put k v dict))
+             (new Hash)
+             kvs))
+
+(do-template [  ]
+  [(def: #export 
+     (All [K V] (-> (Dict K V) (List )))
+     (|>. entries (List/map )))]
+
+  [keys   K product;left]
+  [values V product;right]
+  )
+
+(def: #export (merge dict2 dict1)
+  (All [K V] (-> (Dict K V) (Dict K V) (Dict K V)))
+  (List/fold (lambda [[key val] dict] (put key val dict))
+             dict1
+             (entries dict2)))
+
+(def: #export (merge-with f dict1 dict2)
+  (All [K V] (-> (-> V V V) (Dict K V) (Dict K V) (Dict K V)))
+  (List/fold (lambda [[key val] dict]
+               (case (get key dict)
+                 #;None
+                 (put key val dict)
+
+                 (#;Some val')
+                 (put key (f val' val) dict)))
+             dict1
+             (entries dict2)))
+
+(def: #export (re-bind from-key to-key dict)
+  (All [K V] (-> K K (Dict K V) (Dict K V)))
+  (case (get from-key dict)
+    #;None
+    dict
+
+    (#;Some val)
+    (|> dict
+        (remove from-key)
+        (put to-key val))))
+
+(def: #export (select keys (^@ old-dict [Hash _]))
+  {#;doc "Creates a sub-set of the given dict, with only the specified keys."}
+  (All [K V] (-> (List K) (Dict K V) (Dict K V)))
+  (List/fold (lambda [key new-dict]
+               (case (get key old-dict)
+                 #;None       new-dict
+                 (#;Some val) (put key val new-dict)))
+             (new Hash)
+             keys))
+
+## [Structures]
+(struct: #export (Eq Eq) (All [k v] (-> (Eq v) (Eq (Dict k v))))
+  (def: (= test subject)
+    (and (=+ (size test)
+             (size subject))
+         (list;every? (lambda [k]
+                        (case [(get k test) (get k subject)]
+                          [(#;Some tk) (#;Some sk)]
+                          (:: Eq = tk sk)
+
+                          _
+                          false))
+                      (keys test)))))
diff --git a/stdlib/source/lux/data/struct/list.lux b/stdlib/source/lux/data/struct/list.lux
new file mode 100644
index 000000000..7d71e4faa
--- /dev/null
+++ b/stdlib/source/lux/data/struct/list.lux
@@ -0,0 +1,487 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monoid
+                functor
+                applicative
+                ["M" monad #*]
+                eq
+                [fold])
+       (data [number "Int/" Number Codec]
+             bool
+             [product])
+       codata/function))
+
+## [Types]
+## (type: (List a)
+##   #Nil
+##   (#Cons a (List a)))
+
+## [Functions]
+(struct: #export _ (fold;Fold List)
+  (def: (fold f init xs)
+    (case xs
+      #;Nil
+      init
+
+      (#;Cons [x xs'])
+      (fold f (f x init) xs'))))
+
+(open Fold)
+
+(def: #export (reverse xs)
+  (All [a]
+    (-> (List a) (List a)))
+  (fold (lambda [head tail] (#;Cons head tail))
+        #;Nil
+        xs))
+
+(def: #export (filter p xs)
+  (All [a]
+    (-> (-> a Bool) (List a) (List a)))
+  (case xs
+    #;Nil
+    #;Nil
+    
+    (#;Cons [x xs'])
+    (if (p x)
+      (#;Cons [x (filter p xs')])
+      (filter p xs'))))
+
+(def: #export (partition p xs)
+  (All [a] (-> (-> a Bool) (List a) [(List a) (List a)]))
+  [(filter p xs) (filter (complement p) xs)])
+
+(def: #export (as-pairs xs)
+  (All [a] (-> (List a) (List [a a])))
+  (case xs
+    (^ (#;Cons [x1 (#;Cons [x2 xs'])]))
+    (#;Cons [[x1 x2] (as-pairs xs')])
+
+    _
+    #;Nil))
+
+(do-template [  ]
+  [(def: #export ( n xs)
+     (All [a]
+       (-> Nat (List a) (List a)))
+     (if (>+ +0 n)
+       (case xs
+         #;Nil
+         #;Nil
+         
+         (#;Cons [x xs'])
+         )
+       ))]
+  
+  [take (#;Cons [x (take (-+ +1 n) xs')]) #;Nil]
+  [drop (drop (-+ +1 n) xs') xs]
+  )
+
+(do-template [  ]
+  [(def: #export ( p xs)
+     (All [a]
+       (-> (-> a Bool) (List a) (List a)))
+     (case xs
+       #;Nil
+       #;Nil
+       
+       (#;Cons [x xs'])
+       (if (p x)
+         
+         )))]
+
+  [take-while (#;Cons [x (take-while p xs')]) #;Nil]
+  [drop-while (drop-while p xs') xs]
+  )
+
+(def: #export (split n xs)
+  (All [a]
+    (-> Nat (List a) [(List a) (List a)]))
+  (if (>+ +0 n)
+    (case xs
+      #;Nil
+      [#;Nil #;Nil]
+      
+      (#;Cons [x xs'])
+      (let [[tail rest] (split (-+ +1 n) xs')]
+        [(#;Cons [x tail]) rest]))
+    [#;Nil xs]))
+
+(def: (split-with' p ys xs)
+  (All [a]
+    (-> (-> a Bool) (List a) (List a) [(List a) (List a)]))
+  (case xs
+    #;Nil
+    [ys xs]
+
+    (#;Cons [x xs'])
+    (if (p x)
+      (split-with' p (#;Cons [x ys]) xs')
+      [ys xs])))
+
+(def: #export (split-with p xs)
+  (All [a]
+    (-> (-> a Bool) (List a) [(List a) (List a)]))
+  (let [[ys' xs'] (split-with' p #;Nil xs)]
+    [(reverse ys') xs']))
+
+(def: #export (split-all n xs)
+  (All [a] (-> Nat (List a) (List (List a))))
+  (case xs
+    #;Nil
+    (list)
+
+    _
+    (let [[pre post] (split n xs)]
+      (#;Cons pre (split-all n post)))))
+
+(def: #export (repeat n x)
+  (All [a]
+    (-> Nat a (List a)))
+  (if (>+ +0 n)
+    (#;Cons [x (repeat (dec+ n) x)])
+    #;Nil))
+
+(def: (iterate' f x)
+  (All [a]
+    (-> (-> a (Maybe a)) a (List a)))
+  (case (f x)
+    (#;Some x')
+    (list& x (iterate' f x'))
+
+    #;None
+    (list)))
+
+(def: #export (iterate f x)
+  (All [a]
+    (-> (-> a (Maybe a)) a (List a)))
+  (case (f x)
+    (#;Some x')
+    (list& x (iterate' f x'))
+
+    #;None
+    (list x)))
+
+(def: #export (find p xs)
+  (All [a]
+    (-> (-> a Bool) (List a) (Maybe a)))
+  (case xs
+    #;Nil
+    #;None
+
+    (#;Cons [x xs'])
+    (if (p x)
+      (#;Some x)
+      (find p xs'))))
+
+(def: #export (interpose sep xs)
+  (All [a]
+    (-> a (List a) (List a)))
+  (case xs
+    #;Nil
+    xs
+
+    (#;Cons [x #;Nil])
+    xs
+
+    (#;Cons [x xs'])
+    (#;Cons [x (#;Cons [sep (interpose sep xs')])])))
+
+(def: #export (size list)
+  (All [a] (-> (List a) Nat))
+  (fold (lambda [_ acc] (++ +1 acc)) +0 list))
+
+(do-template [  ]
+  [(def: #export ( p xs)
+     (All [a]
+       (-> (-> a Bool) (List a) Bool))
+     (fold (lambda [_2 _1] ( _1 (p _2)))  xs))]
+
+  [every? true  and]
+  [any?   false or])
+
+(def: #export (at i xs)
+  (All [a]
+    (-> Nat (List a) (Maybe a)))
+  (case xs
+    #;Nil
+    #;None
+
+    (#;Cons [x xs'])
+    (if (=+ +0 i)
+      (#;Some x)
+      (at (-+ +1 i) xs'))))
+
+## [Structures]
+(struct: #export (Eq (^open "a:"))
+  (All [a] (-> (Eq a) (Eq (List a))))
+  (def: (= xs ys)
+    (case [xs ys]
+      [#;Nil #;Nil]
+      true
+
+      [(#;Cons x xs') (#;Cons y ys')]
+      (and (a:= x y)
+           (= xs' ys'))
+
+      [_ _]
+      false
+      )))
+
+(struct: #export Monoid (All [a]
+                                (Monoid (List a)))
+  (def: unit #;Nil)
+  (def: (append xs ys)
+    (case xs
+      #;Nil          ys
+      (#;Cons x xs') (#;Cons x (append xs' ys)))))
+
+(open Monoid)
+
+(struct: #export _ (Functor List)
+  (def: (map f ma)
+    (case ma
+      #;Nil          #;Nil
+      (#;Cons a ma') (#;Cons (f a) (map f ma')))))
+
+(open Functor)
+
+(struct: #export _ (Applicative List)
+  (def: functor Functor)
+
+  (def: (wrap a)
+    (#;Cons a #;Nil))
+
+  (def: (apply ff fa)
+    (case ff
+      #;Nil
+      #;Nil
+      
+      (#;Cons f ff')
+      (append (map f fa) (apply ff' fa)))))
+
+(struct: #export _ (Monad List)
+  (def: applicative Applicative)
+
+  (def: join (|>. reverse (fold append unit))))
+
+## [Functions]
+(def: #export (sort < xs)
+  (All [a] (-> (-> a a Bool) (List a) (List a)))
+  (case xs
+    #;Nil
+    (list)
+    
+    (#;Cons x xs')
+    (let [[pre post] (fold (lambda [x' [pre post]]
+                             (if (< x x')
+                               [(#;Cons x' pre) post]
+                               [pre (#;Cons x' post)]))
+                           [(list) (list)]
+                           xs')]
+      ($_ append (sort < pre) (list x) (sort < post)))))
+
+(do-template [   ]
+  [(def: #export ( from to)
+     (->   (List ))
+     (if ( to from)
+       (list& from ( ( from) to))
+       (list)))]
+
+  [range  Int <=  inc]
+  [range+ Nat <=+ inc+]
+  )
+
+(def: #export (empty? xs)
+  (All [a] (-> (List a) Bool))
+  (case xs
+    #;Nil true
+    _     false))
+
+(def: #export (member? eq xs x)
+  (All [a] (-> (Eq a) (List a) a Bool))
+  (case xs
+    #;Nil           false
+    (#;Cons x' xs') (or (:: eq = x x')
+                        (member? eq xs' x))))
+
+(do-template [  ]
+  [(def: #export ( xs)
+     (All [a] (-> (List a) (Maybe )))
+     (case xs
+       #;Nil
+       #;None
+
+       (#;Cons x xs')
+       (#;Some )))]
+
+  [head a        x]
+  [tail (List a) xs']
+  )
+
+## [Syntax]
+(def: (symbol$ name)
+  (-> Text AST)
+  [["" -1 -1] (#;SymbolS "" name)])
+
+(macro: #export (zip tokens state)
+  {#;doc (doc "Create list zippers with the specified number of input lists."
+              (def: #export zip2 (zip 2))
+              (def: #export zip3 (zip 3))
+              ((zip 3) xs ys zs))}
+  (case tokens
+    (^ (list [_ (#;IntS num-lists)]))
+    (if (> 0 num-lists)
+      (let [(^open) Functor
+            indices (range 0 (dec num-lists))
+            type-vars (: (List AST) (map (. symbol$ Int/encode) indices))
+            zip-type (` (All [(~@ type-vars)]
+                          (-> (~@ (map (: (-> AST AST) (lambda [var] (` (List (~ var)))))
+                                       type-vars))
+                              (List [(~@ type-vars)]))))
+            vars+lists (|> indices
+                           (map inc)
+                           (map (lambda [idx]
+                                  [(symbol$ (Int/encode idx))
+                                   (symbol$ (Int/encode (Int/negate idx)))])))
+            pattern (` [(~@ (map (lambda [[v vs]] (` (#;Cons (~ v) (~ vs))))
+                                 vars+lists))])
+            g!step (symbol$ "\tstep\t")
+            g!blank (symbol$ "\t_\t")
+            list-vars (map product;right vars+lists)
+            code (` (: (~ zip-type)
+                       (lambda (~ g!step) [(~@ list-vars)]
+                         (case [(~@ list-vars)]
+                           (~ pattern)
+                           (#;Cons [(~@ (map product;left vars+lists))]
+                                   ((~ g!step) (~@ list-vars)))
+
+                           (~ g!blank)
+                           #;Nil))))]
+        (#;Right [state (list code)]))
+      (#;Left "Can't zip 0 lists."))
+
+    _
+    (#;Left "Wrong syntax for zip")))
+
+(def: #export zip2 (zip 2))
+(def: #export zip3 (zip 3))
+
+(macro: #export (zip-with tokens state)
+  {#;doc (doc "Create list zip-with`s with the specified number of input lists."
+              (def: #export zip2-with (zip-with 2))
+              (def: #export zip3-with (zip-with 3))
+              ((zip-with 2) + xs ys))}
+  (case tokens
+    (^ (list [_ (#;IntS num-lists)]))
+    (if (> 0 num-lists)
+      (let [(^open) Functor
+            indices (range 0 (dec num-lists))
+            g!return-type (symbol$ "\treturn-type\t")
+            g!func (symbol$ "\tfunc\t")
+            type-vars (: (List AST) (map (. symbol$ Int/encode) indices))
+            zip-type (` (All [(~@ type-vars) (~ g!return-type)]
+                          (-> (-> (~@ type-vars) (~ g!return-type))
+                              (~@ (map (: (-> AST AST) (lambda [var] (` (List (~ var)))))
+                                       type-vars))
+                              (List (~ g!return-type)))))
+            vars+lists (|> indices
+                           (map inc)
+                           (map (lambda [idx]
+                                  [(symbol$ (Int/encode idx))
+                                   (symbol$ (Int/encode (Int/negate idx)))])))
+            pattern (` [(~@ (map (lambda [[v vs]] (` (#;Cons (~ v) (~ vs))))
+                                 vars+lists))])
+            g!step (symbol$ "\tstep\t")
+            g!blank (symbol$ "\t_\t")
+            list-vars (map product;right vars+lists)
+            code (` (: (~ zip-type)
+                       (lambda (~ g!step) [(~ g!func) (~@ list-vars)]
+                         (case [(~@ list-vars)]
+                           (~ pattern)
+                           (#;Cons ((~ g!func) (~@ (map product;left vars+lists)))
+                                   ((~ g!step) (~ g!func) (~@ list-vars)))
+
+                           (~ g!blank)
+                           #;Nil))))]
+        (#;Right [state (list code)]))
+      (#;Left "Can't zip-with 0 lists."))
+
+    _
+    (#;Left "Wrong syntax for zip-with")))
+
+(def: #export zip2-with (zip-with 2))
+(def: #export zip3-with (zip-with 3))
+
+(def: #export (last xs)
+  (All [a] (-> (List a) (Maybe a)))
+  (case xs
+    #;Nil
+    #;None
+
+    (#;Cons x #;Nil)
+    (#;Some x)
+    
+    (#;Cons x xs')
+    (last xs')))
+
+(def: #export (inits xs)
+  (All [a] (-> (List a) (Maybe (List a))))
+  (case xs
+    #;Nil
+    #;None
+
+    (#;Cons x #;Nil)
+    (#;Some #;Nil)
+    
+    (#;Cons x xs')
+    (case (inits xs')
+      #;None
+      (undefined)
+
+      (#;Some tail)
+      (#;Some (#;Cons x tail)))
+    ))
+
+(def: #export (concat xss)
+  (All [a] (-> (List (List a)) (List a)))
+  (:: Monad join xss))
+
+(struct: #export (ListT Monad)
+  (All [M] (-> (Monad M) (Monad (All [a] (M (List a))))))
+  (def: applicative (compA (get@ #M;applicative Monad) Applicative))
+  (def: (join MlMla)
+    (do Monad
+      [lMla MlMla
+       lla (: (($ 0) (List (List ($ 1))))
+              (mapM @ join lMla))]
+      (wrap (concat lla)))))
+
+(def: #export (lift-list Monad)
+  (All [M a] (-> (Monad M) (-> (M a) (M (List a)))))
+  (liftM Monad (:: Monad wrap)))
+
+(def: (enumerate' idx xs)
+  (All [a] (-> Nat (List a) (List [Nat a])))
+  (case xs
+    #;Nil
+    #;Nil
+
+    (#;Cons x xs')
+    (#;Cons [idx x] (enumerate' (inc+ idx) xs'))))
+
+(def: #export (enumerate xs)
+  (All [a] (-> (List a) (List [Nat a])))
+  (enumerate' +0 xs))
+
+(def: #export (indices size)
+  {#;doc "Produces all the valid indices for a given size."}
+  (All [a] (-> Nat (List Nat)))
+  (if (=+ +0 size)
+    (list)
+    (|> size dec+ (range+ +0))))
diff --git a/stdlib/source/lux/data/struct/queue.lux b/stdlib/source/lux/data/struct/queue.lux
new file mode 100644
index 000000000..61b97c9cd
--- /dev/null
+++ b/stdlib/source/lux/data/struct/queue.lux
@@ -0,0 +1,79 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control eq)
+       (data (struct [list "List/" Monoid]))))
+
+## [Types]
+(type: #export (Queue a)
+  {#front (List a)
+   #rear (List a)})
+
+## [Values]
+(def: #export empty
+  Queue
+  {#front (list)
+   #rear (list)})
+
+(def: #export (from-list entries)
+  (All [a] (-> (List a) (Queue a)))
+  {#front entries
+   #rear (list)})
+
+(def: #export (to-list queue)
+  (All [a] (-> (Queue a) (List a)))
+  (let [(^slots [#front #rear]) queue]
+    (List/append front (list;reverse rear))))
+
+(def: #export peek
+  (All [a] (-> (Queue a) (Maybe a)))
+  (|>. (get@ #front) list;head))
+
+(def: #export (size queue)
+  (All [a] (-> (Queue a) Nat))
+  (let [(^slots [#front #rear]) queue]
+    (++ (list;size front)
+        (list;size rear))))
+
+(def: #export empty?
+  (All [a] (-> (Queue a) Bool))
+  (|>. (get@ [#front]) list;empty?))
+
+(def: #export (enqueued? a/Eq queue member)
+  (All [a] (-> (Eq a) (Queue a) a Bool))
+  (let [(^slots [#front #rear]) queue]
+    (or (list;member? a/Eq front member)
+        (list;member? a/Eq rear member))))
+
+(def: #export (dequeue queue)
+  (All [a] (-> (Queue a) (Queue a)))
+  (case (get@ #front queue)
+    (^ (list)) ## Empty...
+    queue
+
+    (^ (list _)) ## Front has dried up...
+    (|> queue
+        (set@ #front (list;reverse (get@ #rear queue)))
+        (set@ #rear (list)))
+    
+    (^ (list& _ front')) ## Consume front!
+    (|> queue
+        (set@ #front front'))))
+
+(def: #export (enqueue val queue)
+  (All [a] (-> a (Queue a) (Queue a)))
+  (case (get@ #front queue)
+    #;Nil
+    (set@ #front (list val) queue)
+
+    _
+    (update@ #rear (|>. (#;Cons val)) queue)))
+
+## [Structures]
+(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Queue a))))
+  (def: (= qx qy)
+    (:: (list;Eq Eq) = (to-list qx) (to-list qy))))
diff --git a/stdlib/source/lux/data/struct/set.lux b/stdlib/source/lux/data/struct/set.lux
new file mode 100644
index 000000000..085c0f047
--- /dev/null
+++ b/stdlib/source/lux/data/struct/set.lux
@@ -0,0 +1,85 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control functor
+                applicative
+                monad
+                eq
+                [hash #*])
+       (data (struct [dict]
+                     [list "List/" Fold Functor]))
+       (codata function)))
+
+## [Types]
+(type: #export (Set a)
+  (dict;Dict a a))
+
+## [Values]
+(def: #export (new Hash)
+  (All [a] (-> (Hash a) (Set a)))
+  (dict;new Hash))
+
+(def: #export (add elem set)
+  (All [a] (-> a (Set a) (Set a)))
+  (dict;put elem elem set))
+
+(def: #export (remove elem set)
+  (All [a] (-> a (Set a) (Set a)))
+  (dict;remove elem set))
+
+(def: #export (member? set elem)
+  (All [a] (-> (Set a) a Bool))
+  (dict;contains? elem set))
+
+(def: #export (union xs yx)
+  (All [a] (-> (Set a) (Set a) (Set a)))
+  (dict;merge xs yx))
+
+(def: #export (difference subs base)
+  (All [a] (-> (Set a) (Set a) (Set a)))
+  (List/fold remove base (dict;keys subs)))
+
+(def: #export (intersection filter base)
+  (All [a] (-> (Set a) (Set a) (Set a)))
+  (dict;select (dict;keys filter) base))
+
+(def: #export (size set)
+  (All [a] (-> (Set a) Nat))
+  (dict;size set))
+
+(def: #export (empty? set)
+  (All [a] (-> (Set a) Bool))
+  (=+ +0 (dict;size set)))
+
+(def: #export to-list
+  (All [a] (-> (Set a) (List a)))
+  dict;keys)
+
+(def: #export (from-list Hash xs)
+  (All [a] (-> (Hash a) (List a) (Set a)))
+  (List/fold add (new Hash) xs))
+
+(def: #export (sub? super sub)
+  (All [a] (-> (Set a) (Set a) Bool))
+  (list;every? (member? super) (to-list sub)))
+
+(def: #export (super? sub super)
+  (All [a] (-> (Set a) (Set a) Bool))
+  (sub? super sub))
+
+## [Structures]
+(struct: #export Eq (All [a] (Eq (Set a)))
+  (def: (= (^@ test [Hash _]) subject)
+    (:: (list;Eq (get@ #hash;eq Hash)) = (to-list test) (to-list subject))))
+
+(struct: #export Hash (All [a] (Hash (Set a)))
+  (def: eq Eq)
+  
+  (def: (hash (^@ set [Hash _]))
+    (List/fold (lambda [elem acc] (++ (:: Hash hash elem) acc))
+               +0
+               (to-list set))))
diff --git a/stdlib/source/lux/data/struct/stack.lux b/stdlib/source/lux/data/struct/stack.lux
new file mode 100644
index 000000000..e62a74590
--- /dev/null
+++ b/stdlib/source/lux/data/struct/stack.lux
@@ -0,0 +1,47 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (data (struct [list]))))
+
+## [Types]
+(type: #export (Stack a)
+  (List a))
+
+## [Values]
+(def: #export empty
+  Stack
+  (list))
+
+(def: #export (size stack)
+  (All [a] (-> (Stack a) Nat))
+  (list;size stack))
+
+(def: #export (empty? stack)
+  (All [a] (-> (Stack a) Bool))
+  (list;empty? stack))
+
+(def: #export (peek stack)
+  (All [a] (-> (Stack a) (Maybe a)))
+  (case stack
+    #;Nil
+    #;None
+    
+    (#;Cons value _)
+    (#;Some value)))
+
+(def: #export (pop stack)
+  (All [a] (-> (Stack a) (Stack a)))
+  (case stack
+    #;Nil
+    #;Nil
+    
+    (#;Cons _ stack')
+    stack'))
+
+(def: #export (push value stack)
+  (All [a] (-> a (Stack a) (Stack a)))
+  (#;Cons value stack))
diff --git a/stdlib/source/lux/data/struct/tree.lux b/stdlib/source/lux/data/struct/tree.lux
new file mode 100644
index 000000000..7b7828d73
--- /dev/null
+++ b/stdlib/source/lux/data/struct/tree.lux
@@ -0,0 +1,54 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                eq)
+       (data (struct [list "" Monad]))
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## [Types]
+(type: #export (Tree a)
+  {#value a
+   #children (List (Tree a))})
+
+## [Values]
+(def: #export (flatten tree)
+  (All [a] (-> (Tree a) (List a)))
+  (#;Cons (get@ #value tree)
+          (join (map flatten (get@ #children tree)))))
+
+(def: #export (leaf value)
+  (All [a] (-> a (Tree a)))
+  {#value value
+   #children (list)})
+
+(def: #export (branch value children)
+  (All [a] (-> a (List (Tree a)) (Tree a)))
+  {#value value
+   #children children})
+
+## [Syntax]
+(type: #rec Tree-AST
+  [AST (List Tree-AST)])
+
+(def: (tree^ _)
+  (-> Unit (Syntax Tree-AST))
+  (s;record (s;seq s;any (s;tuple (s;some (lambda [state] ((tree^ []) state)))))))
+
+(syntax: #export (tree type {root (tree^ [])})
+  (wrap (list (` (: (Tree (~ type))
+                    (~ (loop [[value children] root]
+                         (` {#value (~ value)
+                             #children (list (~@ (map recur children)))}))))))))
+
+## [Structs]
+(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Tree a))))
+  (def: (= tx ty)
+    (and (:: Eq = (get@ #value tx) (get@ #value ty))
+         (:: (list;Eq (Eq Eq)) = (get@ #children tx) (get@ #children ty)))))
diff --git a/stdlib/source/lux/data/struct/vector.lux b/stdlib/source/lux/data/struct/vector.lux
new file mode 100644
index 000000000..bb31063a4
--- /dev/null
+++ b/stdlib/source/lux/data/struct/vector.lux
@@ -0,0 +1,428 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control functor
+                applicative
+                monad
+                eq
+                monoid
+                fold)
+       (data maybe
+             (struct [list "List/" Fold Functor Monoid]
+                     [array #+ Array "Array/" Functor Fold])
+             [bit]
+             [number "Int/" Number]
+             [product])
+       [compiler #+ with-gensyms]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])
+       [pipe]
+       ))
+
+## This implementation of vectors is based on Clojure's
+## PersistentVector implementation.
+
+## [Utils]
+(type: (Node a)
+  (#Base (Array a))
+  (#Hierarchy (Array (Node a))))
+
+(type: (Base a) (Array a))
+(type: (Hierarchy a) (Array (Node a)))
+
+(type: Level Nat)
+
+(type: Index Nat)
+
+(def: branching-exponent
+  Nat
+  +5)
+
+(def: root-level
+  Level
+  +0)
+
+(do-template [ ]
+  [(def: 
+     (-> Level Level)
+     ( branching-exponent))]
+
+  [level-up   ++]
+  [level-down -+]
+  )
+
+(def: full-node-size
+  Nat
+  (bit;<< branching-exponent +1))
+
+(def: branch-idx-mask
+  Nat
+  (dec+ full-node-size))
+
+(def: branch-idx
+  (-> Index Index)
+  (bit;& branch-idx-mask))
+
+(def: (new-hierarchy _)
+  (All [a] (-> Top (Hierarchy a)))
+  (array;new full-node-size))
+
+(def: (tail-off vec-size)
+  (-> Nat Nat)
+  (if (<+ full-node-size vec-size)
+    +0
+    (|> (dec+ vec-size)
+        (bit;>>> branching-exponent)
+        (bit;<< branching-exponent))))
+
+(def: (new-path level tail)
+  (All [a] (-> Level (Base a) (Node a)))
+  (if (=+ +0 level)
+    (#Base tail)
+    (|> (: (Hierarchy ($ 0))
+           (new-hierarchy []))
+        (array;put +0 (new-path (level-down level) tail))
+        #Hierarchy)))
+
+(def: (new-tail singleton)
+  (All [a] (-> a (Base a)))
+  (|> (: (Base ($ 0))
+         (array;new +1))
+      (array;put +0 singleton)))
+
+(def: (push-tail size level tail parent)
+  (All [a] (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a)))
+  (let [sub-idx (branch-idx (bit;>>> level (dec+ size)))
+        ## If we're currently on a bottom node
+        sub-node (if (=+ branching-exponent level)
+                   ## Just add the tail to it
+                   (#Base tail)
+                   ## Otherwise, check whether there's a vacant spot
+                   (case (array;get sub-idx parent)
+                     ## If so, set the path to the tail
+                     #;None
+                     (new-path (level-down level) tail)
+                     ## If not, push the tail onto the sub-node.
+                     (#;Some (#Hierarchy sub-node))
+                     (#Hierarchy (push-tail size (level-down level) tail sub-node))
+
+                     _
+                     (undefined))
+                   )]
+    (|> (array;clone parent)
+        (array;put sub-idx sub-node))))
+
+(def: (expand-tail val tail)
+  (All [a] (-> a (Base a) (Base a)))
+  (let [tail-size (array;size tail)]
+    (|> (: (Base ($ 0))
+           (array;new (inc+ tail-size)))
+        (array;copy tail-size +0 tail +0)
+        (array;put tail-size val)
+        )))
+
+(def: (put' level idx val hierarchy)
+  (All [a] (-> Level Index a (Hierarchy a) (Hierarchy a)))
+  (let [sub-idx (branch-idx (bit;>>> level idx))]
+    (case (array;get sub-idx hierarchy)
+      (#;Some (#Hierarchy sub-node))
+      (|> (array;clone hierarchy)
+          (array;put sub-idx (#Hierarchy (put' (level-down level) idx val sub-node))))
+
+      (^=> (#;Some (#Base base))
+           (=+ +0 (level-down level)))
+      (|> (array;clone hierarchy)
+          (array;put sub-idx (|> (array;clone base)
+                                 (array;put (branch-idx idx) val)
+                                 #Base)))
+
+      _
+      (undefined))))
+
+(def: (pop-tail size level hierarchy)
+  (All [a] (-> Nat Level (Hierarchy a) (Maybe (Hierarchy a))))
+  (let [sub-idx (branch-idx (bit;>>> level (-+ +2 size)))]
+    (cond (=+ +0 sub-idx)
+          #;None
+
+          (>+ branching-exponent level)
+          (do Monad
+            [base|hierarchy (array;get sub-idx hierarchy)
+             sub (case base|hierarchy
+                   (#Hierarchy sub)
+                   (pop-tail size (level-down level) sub)
+
+                   (#Base _)
+                   (undefined))]
+            (|> (array;clone hierarchy)
+                (array;put sub-idx (#Hierarchy sub))
+                #;Some))
+
+          ## Else...
+          (|> (array;clone hierarchy)
+              (array;remove sub-idx)
+              #;Some)
+          )))
+
+(def: (to-list' node)
+  (All [a] (-> (Node a) (List a)))
+  (case node
+    (#Base base)
+    (array;to-list base)
+    
+    (#Hierarchy hierarchy)
+    (|> hierarchy
+        array;to-list
+        list;reverse
+        (List/fold (lambda [sub acc] (List/append (to-list' sub) acc))
+                   #;Nil))))
+
+## [Types]
+(type: #export (Vector a)
+  {#level Level
+   #size Nat
+   #root (Hierarchy a)
+   #tail (Base a)})
+
+## [Exports]
+(def: #export empty
+  Vector
+  {#level (level-up root-level)
+   #size +0
+   #root (array;new full-node-size)
+   #tail (array;new +0)})
+
+(def: #export (size vector)
+  (All [a] (-> (Vector a) Nat))
+  (get@ #size vector))
+
+(def: #export (add val vec)
+  (All [a] (-> a (Vector a) (Vector a)))
+  ## Check if there is room in the tail.
+  (let [vec-size (get@ #size vec)]
+    (if (|> vec-size (-+ (tail-off vec-size)) (<+ full-node-size))
+      ## If so, append to it.
+      (|> vec
+          (update@ #size inc+)
+          (update@ #tail (expand-tail val)))
+      ## Otherwise, push tail into the tree
+      ## --------------------------------------------------------
+      ## Will the root experience an overflow with this addition?
+      (|> (if (>+ (bit;<< (get@ #level vec) +1)
+                  (bit;>>> branching-exponent vec-size))
+            ## If so, a brand-new root must be established, that is
+            ## 1-level taller.
+            (|> vec
+                (set@ #root (|> (: (Hierarchy ($ 0))
+                                   (new-hierarchy []))
+                                (array;put +0 (#Hierarchy (get@ #root vec)))
+                                (array;put +1 (new-path (get@ #level vec) (get@ #tail vec)))))
+                (update@ #level level-up))
+            ## Otherwise, just push the current tail onto the root.
+            (|> vec
+                (update@ #root (push-tail vec-size (get@ #level vec) (get@ #tail vec)))))
+          ## Finally, update the size of the Vector and grow a new
+          ## tail with the new element as it's sole member.
+          (update@ #size inc+)
+          (set@ #tail (new-tail val)))
+      )))
+
+(def: (base-for idx vec)
+  (All [a] (-> Index (Vector a) (Maybe (Base a))))
+  (let [vec-size (get@ #size vec)]
+    (if (and (>=+ +0 idx)
+             (<+ vec-size idx))
+      (if (>=+ (tail-off vec-size) idx)
+        (#;Some (get@ #tail vec))
+        (loop [level (get@ #level vec)
+               hierarchy (get@ #root vec)]
+          (case [(>+ branching-exponent level)
+                 (array;get (branch-idx (bit;>>> level idx)) hierarchy)]
+            [true (#;Some (#Hierarchy sub))]
+            (recur (level-down level) sub)
+
+            [false (#;Some (#Base base))]
+            (#;Some base)
+
+            [_ #;None]
+            #;None
+
+            _
+            (error! "Incorrect vector structure."))))
+      #;None)))
+
+(def: #export (at idx vec)
+  (All [a] (-> Nat (Vector a) (Maybe a)))
+  (do Monad
+    [base (base-for idx vec)]
+    (array;get (branch-idx idx) base)))
+
+(def: #export (put idx val vec)
+  (All [a] (-> Nat a (Vector a) (Vector a)))
+  (let [vec-size (get@ #size vec)]
+    (if (and (>=+ +0 idx)
+             (<+ vec-size idx))
+      (if (>=+ (tail-off vec-size) idx)
+        (|> vec
+            (update@ #tail (: (-> (Base ($ 0)) (Base ($ 0)))
+                              (|>. array;clone (array;put (branch-idx idx) val)))))
+        (|> vec
+            (update@ #root (put' (get@ #level vec) idx val))))
+      vec)))
+
+(def: #export (update idx f vec)
+  (All [a] (-> Nat (-> a a) (Vector a) (Vector a)))
+  (case (at idx vec)
+    (#;Some val)
+    (put idx (f val) vec)
+
+    #;None
+    vec))
+
+(def: #export (pop vec)
+  (All [a] (-> (Vector a) (Vector a)))
+  (case (get@ #size vec)
+    +0
+    empty
+
+    +1
+    empty
+
+    vec-size
+    (if (|> vec-size (-+ (tail-off vec-size)) (>+ +1))
+      (let [old-tail (get@ #tail vec)
+            new-tail-size (dec+ (array;size old-tail))]
+        (|> vec
+            (update@ #size dec+)
+            (set@ #tail (|> (array;new new-tail-size)
+                            (array;copy new-tail-size +0 old-tail +0)))))
+      (default (undefined)
+        (do Monad
+          [new-tail (base-for (-+ +2 vec-size) vec)
+           #let [[level' root'] (: [Level (Hierarchy ($ 0))]
+                                   (let [init-level (get@ #level vec)]
+                                     (loop [level init-level
+                                            root (: (Hierarchy ($ 0))
+                                                    (default (new-hierarchy [])
+                                                      (pop-tail vec-size init-level (get@ #root vec))))]
+                                       (if (>+ branching-exponent level)
+                                         (case [(array;get +1 root) (array;get +0 root)]
+                                           [#;None (#;Some (#Hierarchy sub-node))]
+                                           (recur (level-down level) sub-node)
+
+                                           [#;None (#;Some (#Base _))]
+                                           (undefined)
+
+                                           _
+                                           [level root])
+                                         [level root]))))]]
+          (wrap (|> vec
+                    (update@ #size dec+)
+                    (set@ #level level')
+                    (set@ #root root')
+                    (set@ #tail new-tail))))))
+    ))
+
+(def: #export (to-list vec)
+  (All [a] (-> (Vector a) (List a)))
+  (List/append (to-list' (#Hierarchy (get@ #root vec)))
+               (to-list' (#Base (get@ #tail vec)))))
+
+(def: #export (from-list list)
+  (All [a] (-> (List a) (Vector a)))
+  (List/fold add
+             (: (Vector ($ 0))
+                empty)
+             list))
+
+(def: #export (member? a/Eq vec val)
+  (All [a] (-> (Eq a) (Vector a) a Bool))
+  (list;member? a/Eq (to-list vec) val))
+
+(def: #export empty?
+  (All [a] (-> (Vector a) Bool))
+  (|>. (get@ #size) (=+ +0)))
+
+## [Syntax]
+(syntax: #export (vector {elems (s;some s;any)})
+  (wrap (list (` (from-list (list (~@ elems)))))))
+
+## [Structures]
+(struct: #export (Eq Eq) (All [a] (-> (Eq a) (Eq (Vector a))))
+  (def: (= v1 v2)
+    (:: (list;Eq Eq) = (to-list v1) (to-list v2))))
+
+(struct: _ (Fold Node)
+  (def: (fold f init xs)
+    (case xs
+      (#Base base)
+      (Array/fold f init base)
+      
+      (#Hierarchy hierarchy)
+      (Array/fold (lambda [node init'] (fold f init' node))
+                  init
+                  hierarchy))
+    ))
+
+(struct: #export _ (Fold Vector)
+  (def: (fold f init xs)
+    (let [(^open) Fold]
+      (fold f
+            (fold f
+                  init
+                  (#Hierarchy (get@ #root xs)))
+            (#Base (get@ #tail xs))))
+    ))
+
+(struct: #export Monoid (All [a]
+                                  (Monoid (Vector a)))
+  (def: unit empty)
+  (def: (append xs ys)
+    (List/fold add xs (to-list ys))))
+
+(struct: _ (Functor Node)
+  (def: (map f xs)
+    (case xs
+      (#Base base)
+      (#Base (Array/map f base))
+      
+      (#Hierarchy hierarchy)
+      (#Hierarchy (Array/map (map f) hierarchy)))
+    ))
+
+(struct: #export _ (Functor Vector)
+  (def: (map f xs)
+    {#level (get@ #level xs)
+     #size (get@ #size xs)
+     #root (|> xs (get@ #root) (Array/map (:: Functor map f)))
+     #tail (|> xs (get@ #tail) (Array/map f))
+     }))
+
+(struct: #export _ (Applicative Vector)
+  (def: functor Functor)
+
+  (def: (wrap x)
+    (vector x))
+  
+  (def: (apply ff fa)
+    (let [(^open) Functor
+          (^open) Fold
+          (^open) Monoid
+          results (map (lambda [f] (map f fa))
+                       ff)]
+      (fold append unit results)))
+  )
+
+(struct: #export _ (Monad Vector)
+  (def: applicative Applicative)
+
+  (def: (join ffa)
+    (let [(^open) Functor
+          (^open) Fold
+          (^open) Monoid]
+      (fold append unit ffa)))
+  )
diff --git a/stdlib/source/lux/data/struct/zipper.lux b/stdlib/source/lux/data/struct/zipper.lux
new file mode 100644
index 000000000..eb98409b4
--- /dev/null
+++ b/stdlib/source/lux/data/struct/zipper.lux
@@ -0,0 +1,196 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (data (struct [list "" Monad Fold "List/" Monoid]
+                     [tree #+ Tree]
+                     [stack #+ Stack]))
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## Adapted from the clojure.zip namespace in the Clojure standard library.
+
+## [Types]
+(type: #export (Zipper a)
+  {#parent (Maybe (Zipper a))
+   #lefts (Stack (Tree a))
+   #rights (Stack (Tree a))
+   #node (Tree a)})
+
+## [Values]
+(def: #export (from-tree tree)
+  (All [a] (-> (Tree a) (Zipper a)))
+  {#parent #;None
+   #lefts stack;empty
+   #rights stack;empty
+   #node tree})
+
+(def: #export (to-tree zipper)
+  (All [a] (-> (Zipper a) (Tree a)))
+  (get@ #node zipper))
+
+(def: #export (value zipper)
+  (All [a] (-> (Zipper a) a))
+  (|> zipper (get@ #node) (get@ #tree;value)))
+
+(def: #export (children zipper)
+  (All [a] (-> (Zipper a) (List (Tree a))))
+  (|> zipper (get@ #node) (get@ #tree;children)))
+
+(def: #export (branch? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (|> zipper children list;empty? not))
+
+(def: #export (leaf? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (|> zipper branch? not))
+
+(def: #export (parent zipper)
+  (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+  (get@ #parent zipper))
+
+(def: #export (down zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (children zipper)
+    #;Nil
+    zipper
+
+    (#;Cons chead ctail)
+    {#parent (#;Some zipper)
+     #lefts stack;empty
+     #rights ctail
+     #node chead}))
+
+(def: #export (up zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (get@ #parent zipper)
+    #;None
+    zipper
+
+    (#;Some parent)
+    (|> parent
+        (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0)))
+                          (lambda [node]
+                            (set@ #tree;children (List/append (list;reverse (get@ #lefts zipper))
+                                                              (#;Cons (get@ #node zipper)
+                                                                      (get@ #rights zipper)))
+                                  node)))))))
+
+(def: #export (root zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (loop [zipper zipper]
+    (case (get@ #parent zipper)
+      #;None     zipper
+      (#;Some _) (recur (up zipper)))))
+
+(do-template [   ]
+  [(def: #export ( zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (case (get@  zipper)
+       #;Nil
+       zipper
+
+       (#;Cons next side')
+       (|> zipper
+           (update@  (lambda [op-side]
+                                (#;Cons (get@ #node zipper) op-side)))
+           (set@  side')
+           (set@ #node next))))
+
+   (def: #export ( zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (fold (lambda [_] ) zipper (get@  zipper)))]
+
+  [right rightmost #rights #lefts]
+  [left  leftmost  #lefts  #rights]
+  )
+
+(def: #export (set value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (set@ [#node #tree;value] value zipper))
+
+(def: #export (update f zipper)
+  (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
+  (update@ [#node #tree;value] f zipper))
+
+(def: #export (prepend-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #tree;children]
+           (lambda [children]
+             (#;Cons (tree;tree ($ 0) {value []})
+                     children))
+           zipper))
+
+(def: #export (append-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #tree;children]
+           (lambda [children]
+             (List/append children
+                          (list (tree;tree ($ 0) {value []}))))
+           zipper))
+
+(def: #export (remove zipper)
+  (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+  (case (get@ #lefts zipper)
+    #;Nil
+    (case (get@ #parent zipper)
+      #;None
+      #;None
+
+      (#;Some next)
+      (#;Some (|> next
+                  (update@ [#node #tree;children] (|>. list;tail (default (list)))))))
+
+    (#;Cons next side)
+    (#;Some (|> zipper
+                (set@ #lefts side)
+                (set@ #node next)))))
+
+(do-template [ ]
+  [(def: #export ( value zipper)
+     (All [a] (-> a (Zipper a) (Maybe (Zipper a))))
+     (case (get@ #parent zipper)
+       #;None
+       #;None
+
+       _
+       (#;Some (|> zipper
+                   (update@  (lambda [side]
+                                     (#;Cons (tree;tree ($ 0) {value []})
+                                             side)))))))]
+
+  [insert-left  #lefts]
+  [insert-right #rights]
+  )
+
+(do-template [   ]
+  [(def: #export ( zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (case (get@  zipper)
+       #;Nil
+       ( zipper)
+
+       _
+       ( zipper)))]
+
+  [next #rights right down]
+  [prev #lefts  left up]
+  )
+
+(def: #export (end? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (and (list;empty? (get@ #rights zipper))
+       (list;empty? (children zipper))))
+
+(def: #export (root? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (case (get@ #parent zipper)
+    #;None
+    true
+
+    _
+    false))
diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux
new file mode 100644
index 000000000..f01d88727
--- /dev/null
+++ b/stdlib/source/lux/data/sum.lux
@@ -0,0 +1,45 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module: lux)
+
+## [Values]
+(do-template [  ]
+  [(def: #export ( value)
+     (All [a b] (->  (| a b)))
+     ( value))]
+
+  [left  a +0]
+  [right b +1])
+
+(def: #export (either f g s)
+  (All [a b c] (-> (-> a c) (-> b c) (| a b) c))
+  (case s
+    (+0 x)  (f x)
+    (+1 x) (g x)))
+
+(do-template [  ]
+  [(def: #export ( es)
+     (All [a b] (-> (List (| a b)) (List )))
+     (case es
+       #;Nil                  #;Nil
+       (#;Cons ( x) es') (#;Cons [x ( es')])
+       (#;Cons _ es')         ( es')))]
+
+  [lefts  a +0]
+  [rights b +1]
+  )
+
+(def: #export (partition xs)
+  (All [a b] (-> (List (| a b)) [(List a) (List b)]))
+  (case xs
+    #;Nil
+    [#;Nil #;Nil]
+
+    (#;Cons x xs')
+    (let [[lefts rights] (partition xs')]
+      (case x
+        (+0 x')  [(#;Cons x' lefts) rights]
+        (+1 x') [lefts (#;Cons x' rights)]))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
new file mode 100644
index 000000000..97507ba3b
--- /dev/null
+++ b/stdlib/source/lux/data/text.lux
@@ -0,0 +1,223 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monoid
+                eq
+                [ord]
+                monad
+                codec
+                hash)
+       (data (struct [list])
+             maybe)))
+
+## [Functions]
+(def: #export (size x)
+  (-> Text Nat)
+  (int-to-nat (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])])))
+
+(def: #export (at idx x)
+  (-> Nat Text (Maybe Char))
+  (if (<+ (size x) idx)
+    (#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:charAt:int"] [x (_lux_proc ["jvm" "l2i"] [(nat-to-int idx)])]))
+    #;None))
+
+(def: #export (contains? sub text)
+  (-> Text Text Bool)
+  (_lux_proc ["jvm" "invokevirtual:java.lang.String:contains:java.lang.CharSequence"] [text sub]))
+
+(do-template [ ]
+  [(def: #export ( x)
+     (-> Text Text)
+     (_lux_proc ["jvm" ] [x]))]
+  [lower-case "invokevirtual:java.lang.String:toLowerCase:"]
+  [upper-case "invokevirtual:java.lang.String:toUpperCase:"]
+  [trim       "invokevirtual:java.lang.String:trim:"]
+  )
+
+(def: #export (sub from to x)
+  (-> Nat Nat Text (Maybe Text))
+  (if (and (<+ to from)
+           (<=+ (size x) to))
+    (#;Some (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"]
+                       [x
+                        (_lux_proc ["jvm" "l2i"] [(nat-to-int from)])
+                        (_lux_proc ["jvm" "l2i"] [(nat-to-int to)])]))
+    #;None))
+
+(def: #export (sub' from x)
+  (-> Nat Text (Maybe Text))
+  (sub from (size x) x))
+
+(def: #export (replace pattern value template)
+  (-> Text Text Text Text)
+  (_lux_proc ["jvm" "invokevirtual:java.lang.String:replace:java.lang.CharSequence,java.lang.CharSequence"] [template pattern value]))
+
+(do-template [   ]
+  [(def: #export ( pattern x)
+     (-> Text Text (Maybe Nat))
+     (case (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" ] [x pattern])])
+       -1  #;None
+       idx (#;Some (int-to-nat idx))))
+
+   (def: #export ( pattern from x)
+     (-> Text Nat Text (Maybe Nat))
+     (if (<+ (size x) from)
+       (case (_lux_proc ["jvm" "i2l"] [(_lux_proc ["jvm" ] [x pattern (_lux_proc ["jvm" "l2i"] [(nat-to-int from)])])])
+         -1  #;None
+         idx (#;Some (int-to-nat idx)))
+       #;None))]
+
+  [index-of      "invokevirtual:java.lang.String:indexOf:java.lang.String"     index-of'      "invokevirtual:java.lang.String:indexOf:java.lang.String,int"]
+  [last-index-of "invokevirtual:java.lang.String:lastIndexOf:java.lang.String" last-index-of' "invokevirtual:java.lang.String:lastIndexOf:java.lang.String,int"]
+  )
+
+(def: #export (starts-with? prefix x)
+  (-> Text Text Bool)
+  (case (index-of prefix x)
+    (#;Some +0)
+    true
+
+    _
+    false))
+
+(def: #export (ends-with? postfix x)
+  (-> Text Text Bool)
+  (case (last-index-of postfix x)
+    (#;Some n)
+    (=+ (size x)
+        (++ (size postfix) n))
+
+    _
+    false))
+
+(def: #export (split at x)
+  (-> Nat Text (Maybe [Text Text]))
+  (if (<=+ (size x) at)
+    (let [pre (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int,int"] [x (_lux_proc ["jvm" "l2i"] [0]) (_lux_proc ["jvm" "l2i"] [(nat-to-int at)])])
+          post (_lux_proc ["jvm" "invokevirtual:java.lang.String:substring:int"] [x (_lux_proc ["jvm" "l2i"] [(nat-to-int at)])])]
+      (#;Some [pre post]))
+    #;None))
+
+(def: #export (split-with token sample)
+  (-> Text Text (Maybe [Text Text]))
+  (do Monad
+    [index (index-of token sample)
+     [pre post'] (split index sample)
+     [_ post] (split (size token) post')]
+    (wrap [pre post])))
+
+(def: #export (split-all-with token sample)
+  (-> Text Text (List Text))
+  (case (split-with token sample)
+    (#;Some [pre post])
+    (#;Cons pre (split-all-with token post))
+
+    #;None
+    (#;Cons sample #;Nil)))
+
+(def: #export split-lines
+  (split-all-with "\n"))
+
+## [Structures]
+(struct: #export _ (Eq Text)
+  (def: (= test subject)
+    (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [subject test])))
+
+(struct: #export _ (ord;Ord Text)
+  (def: eq Eq)
+
+  (do-template [ ]
+    [(def: ( test subject)
+       ( 0
+             (_lux_proc ["jvm" "i2l"]  [(_lux_proc ["jvm" "invokevirtual:java.lang.String:compareTo:java.lang.String"] [subject test])])))]
+
+    [<  ;<]
+    [<= ;<=]
+    [>  ;>]
+    [>= ;>=]))
+
+(struct: #export _ (Monoid Text)
+  (def: unit "")
+  (def: (append x y)
+    (_lux_proc ["jvm" "invokevirtual:java.lang.String:concat:java.lang.String"] [x y])))
+
+(open Monoid)
+
+(struct: #export _ (Codec Text Text)
+  (def: (encode original)
+    (let [escaped (|> original
+                      (replace "\\" "\\\\")
+                      (replace "\t" "\\t")
+                      (replace "\b" "\\b")
+                      (replace "\n" "\\n")
+                      (replace "\r" "\\r")
+                      (replace "\f" "\\f")
+                      (replace "\"" "\\\"")
+                      )]
+      ($_ append "\"" escaped "\"")))
+
+  (def: (decode input)
+    (if (and (starts-with? "\"" input)
+             (ends-with? "\"" input))
+      (case (sub +1 (dec+ (size input)) input)
+        (#;Some input')
+        (|> input'
+            (replace "\\\\" "\\")
+            (replace "\\t" "\t")
+            (replace "\\b" "\b")
+            (replace "\\n" "\n")
+            (replace "\\r" "\r")
+            (replace "\\f" "\f")
+            (replace "\\\"" "\"")
+            #;Some)
+
+        #;None
+        (#;Left "Couldn't decode text"))
+      (#;Left "Couldn't decode text"))))
+
+(struct: #export _ (Hash Text)
+  (def: eq Eq)
+  
+  (def: hash
+    (|>. []
+         (_lux_proc ["jvm" "invokevirtual:java.lang.Object:hashCode:"])
+         []
+         (_lux_proc ["jvm" "i2l"])
+         int-to-nat)))
+
+(def: #export concat
+  (-> (List Text) Text)
+  (let [(^open) list;Fold
+        (^open) Monoid]
+    (|>. list;reverse (fold append unit))))
+
+(def: #export (join-with sep texts)
+  (-> Text (List Text) Text)
+  (|> texts (list;interpose sep) concat))
+
+(def: #export (empty? text)
+  (-> Text Bool)
+  (case text
+    "" true
+    _  false))
+
+(def: #export (replace-once pattern value template)
+  (-> Text Text Text Text)
+  (default template
+    (do Monad
+      [[pre post] (split-with pattern template)]
+      (let [(^open) Monoid]
+        (wrap ($_ append pre value post))))))
+
+(def: #export (enclose [left right] content)
+  (-> [Text Text] Text Text)
+  (let [(^open) Monoid]
+    ($_ append left content right)))
+
+(def: #export (enclose' boundary content)
+  (-> Text Text Text)
+  (enclose [boundary boundary] content))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
new file mode 100644
index 000000000..a8b289fe3
--- /dev/null
+++ b/stdlib/source/lux/data/text/format.lux
@@ -0,0 +1,54 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data [bool]
+             [char]
+             [number]
+             [text]
+             [ident]
+             (struct [list "" Monad]))
+       [type]
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## [Syntax]
+(def: #hidden _append_
+  (-> Text Text Text)
+  (:: text;Monoid append))
+
+(syntax: #export (format {fragments (s;many s;any)})
+  {#;doc (doc "Text interpolation as a macro."
+              (format "Static part " (%t static) " doesn't match URI: " uri))}
+  (wrap (list (` ($_ _append_ (~@ fragments))))))
+
+## [Formatters]
+(type: (Formatter a)
+  (-> a Text))
+
+(do-template [  ]
+  [(def: #export 
+     (Formatter )
+     )]
+
+  [%b     Bool  (:: bool;Codec encode)]
+  [%n     Nat   (:: number;Codec encode)]
+  [%i     Int   (:: number;Codec encode)]
+  [%f     Frac  (:: number;Codec encode)]
+  [%r     Real  (:: number;Codec encode)]
+  [%c     Char  (:: char;Codec encode)]
+  [%t     Text  (:: text;Codec encode)]
+  [%ident Ident (:: ident;Codec encode)]
+  [%ast   AST   ast;ast-to-text]
+  [%type  Type  type;type-to-text]
+  )
+
+(def: #export (%list formatter)
+  (All [a] (-> (Formatter a) (Formatter (List a))))
+  (lambda [values]
+    (format "(list " (text;join-with " " (map formatter values)) ")")))
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.lux
new file mode 100644
index 000000000..ecc33227a
--- /dev/null
+++ b/stdlib/source/lux/host.lux
@@ -0,0 +1,2137 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                [enum])
+       (codata function
+               [io #+ IO Monad io])
+       (data (struct [list #* "" Functor Fold "List/" Monad Monoid]
+                     [array #+ Array])
+             number
+             maybe
+             [product]
+             [text "Text/" Eq]
+             text/format
+             [bool "Bool/" Codec])
+       [compiler #+ with-gensyms Functor Monad]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])
+       [type]
+       ))
+
+(do-template [   ]
+  [(def: #export ( value)
+     {#;doc (doc "Type converter."
+                 "From:"
+                 
+                 "To:"
+                 )}
+     (-> (host ) (host ))
+     (_lux_proc ["jvm" ] [value]))]
+
+  [b2l "b2l" java.lang.Byte      java.lang.Long]
+
+  [s2l "s2l" java.lang.Short     java.lang.Long]
+  
+  [d2i "d2i" java.lang.Double    java.lang.Integer]
+  [d2l "d2l" java.lang.Double    java.lang.Long]
+  [d2f "d2f" java.lang.Double    java.lang.Float]
+
+  [f2i "f2i" java.lang.Float     java.lang.Integer]
+  [f2l "f2l" java.lang.Float     java.lang.Long]
+  [f2d "f2d" java.lang.Float     java.lang.Double]
+  
+  [i2b "i2b" java.lang.Integer   java.lang.Byte]
+  [i2s "i2s" java.lang.Integer   java.lang.Short]
+  [i2l "i2l" java.lang.Integer   java.lang.Long]
+  [i2f "i2f" java.lang.Integer   java.lang.Float]
+  [i2d "i2d" java.lang.Integer   java.lang.Double]
+  [i2c "i2c" java.lang.Integer   java.lang.Character]
+
+  [l2b "l2b" java.lang.Long      java.lang.Byte]
+  [l2s "l2s" java.lang.Long      java.lang.Short]
+  [l2i "l2i" java.lang.Long      java.lang.Integer]
+  [l2f "l2f" java.lang.Long      java.lang.Float]
+  [l2d "l2d" java.lang.Long      java.lang.Double]
+
+  [c2b "c2b" java.lang.Character java.lang.Byte]
+  [c2s "c2s" java.lang.Character java.lang.Short]
+  [c2i "c2i" java.lang.Character java.lang.Integer]
+  [c2l "c2l" java.lang.Character java.lang.Long]
+  )
+
+## [Utils]
+(def: array-type-name "#Array")
+(def: constructor-method-name "")
+(def: member-separator ".")
+
+## Types
+(do-template [ ]
+  [(type: #export 
+     (#;HostT  #;Nil))]
+
+  ["[Z" BooleanArray]
+  ["[B" ByteArray]
+  ["[S" ShortArray]
+  ["[I" IntArray]
+  ["[J" LongArray]
+  ["[F" FloatArray]
+  ["[D" DoubleArray]
+  ["[C" CharArray]
+  )
+
+(type: Code Text)
+
+(type: BoundKind
+  #UpperBound
+  #LowerBound)
+
+(type: #rec GenericType
+  (#GenericTypeVar Text)
+  (#GenericClass [Text (List GenericType)])
+  (#GenericArray GenericType)
+  (#GenericWildcard (Maybe [BoundKind GenericType])))
+
+(type: TypeParam
+  [Text (List GenericType)])
+
+(type: Primitive-Mode
+  #ManualPrM
+  #AutoPrM)
+
+(type: PrivacyModifier
+  #PublicPM
+  #PrivatePM
+  #ProtectedPM
+  #DefaultPM)
+
+(type: StateModifier
+  #VolatileSM
+  #FinalSM
+  #DefaultSM)
+
+(type: InheritanceModifier
+  #FinalIM
+  #AbstractIM
+  #DefaultIM)
+
+(type: ClassKind
+  #Class
+  #Interface)
+
+(type: ClassDecl
+  {#class-name   Text
+   #class-params (List TypeParam)})
+
+(type: StackFrame (host java.lang.StackTraceElement))
+(type: StackTrace (Array StackFrame))
+
+(type: SuperClassDecl
+  {#super-class-name   Text
+   #super-class-params (List GenericType)})
+
+(type: AnnotationParam
+  [Text AST])
+
+(type: Annotation
+  {#ann-name   Text
+   #ann-params (List AnnotationParam)})
+
+(type: MemberDecl
+  {#member-name Text
+   #member-privacy PrivacyModifier
+   #member-anns (List Annotation)})
+
+(type: FieldDecl
+  (#ConstantField GenericType AST)
+  (#VariableField StateModifier GenericType))
+
+(type: MethodDecl
+  {#method-tvars  (List TypeParam)
+   #method-inputs (List GenericType)
+   #method-output GenericType
+   #method-exs    (List GenericType)})
+
+(type: ArgDecl
+  {#arg-name Text
+   #arg-type GenericType})
+
+(type: ConstructorArg
+  [GenericType AST])
+
+(type: MethodDef
+  (#ConstructorMethod [Bool
+                       (List TypeParam)
+                       (List ArgDecl)
+                       (List ConstructorArg)
+                       AST
+                       (List GenericType)])
+  (#VirtualMethod [Bool
+                   Bool
+                   (List TypeParam)
+                   (List ArgDecl)
+                   GenericType
+                   AST
+                   (List GenericType)])
+  (#OverridenMethod [Bool
+                     ClassDecl
+                     (List TypeParam)
+                     (List ArgDecl)
+                     GenericType
+                     AST
+                     (List GenericType)])
+  (#StaticMethod [Bool
+                  (List TypeParam)
+                  (List ArgDecl)
+                  GenericType
+                  AST
+                  (List GenericType)])
+  (#AbstractMethod [(List TypeParam)
+                    (List ArgDecl)
+                    GenericType
+                    (List GenericType)])
+  (#NativeMethod [(List TypeParam)
+                  (List ArgDecl)
+                  GenericType
+                  (List GenericType)]))
+
+(type: PartialCall
+  {#pc-method AST
+   #pc-args   AST})
+
+(type: ImportMethodKind
+  #StaticIMK
+  #VirtualIMK)
+
+(type: ImportMethodCommons
+  {#import-member-mode   Primitive-Mode
+   #import-member-alias  Text
+   #import-member-kind   ImportMethodKind
+   #import-member-tvars  (List TypeParam)
+   #import-member-args   (List [Bool GenericType])
+   #import-member-maybe? Bool
+   #import-member-try?   Bool
+   #import-member-io?    Bool})
+
+(type: ImportConstructorDecl
+  {})
+
+(type: ImportMethodDecl
+  {#import-method-name    Text
+   #import-method-return  GenericType})
+
+(type: ImportFieldDecl
+  {#import-field-mode    Primitive-Mode
+   #import-field-name    Text
+   #import-field-static? Bool
+   #import-field-maybe?  Bool
+   #import-field-setter? Bool
+   #import-field-type    GenericType})
+
+(type: ImportMemberDecl
+  (#EnumDecl        (List Text))
+  (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
+  (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
+  (#FieldAccessDecl ImportFieldDecl))
+
+(type: ClassImports
+  (List [Text Text]))
+
+## Utils
+(def: (short-class-name name)
+  (-> Text Text)
+  (case (reverse (text;split-all-with "." name))
+    (#;Cons short-name _)
+    short-name
+
+    #;Nil
+    name))
+
+(def: (manual-primitive-to-type class)
+  (-> Text (Maybe AST))
+  (case class
+    (^template [ ]
+      
+      (#;Some (' )))
+    (["boolean" (;^ java.lang.Boolean)]
+     ["byte"    (;^ java.lang.Byte)]
+     ["short"   (;^ java.lang.Short)]
+     ["int"     (;^ java.lang.Integer)]
+     ["long"    (;^ java.lang.Long)]
+     ["float"   (;^ java.lang.Float)]
+     ["double"  (;^ java.lang.Double)]
+     ["char"    (;^ java.lang.Character)]
+     ["void"    ;Unit])
+
+    _
+    #;None))
+
+(def: (auto-primitive-to-type class)
+  (-> Text (Maybe AST))
+  (case class
+    (^template [ ]
+      
+      (#;Some (' )))
+    (["boolean" ;Bool]
+     ["byte"    ;Int]
+     ["short"   ;Int]
+     ["int"     ;Int]
+     ["long"    ;Int]
+     ["float"   ;Real]
+     ["double"  ;Real]
+     ["char"    ;Char]
+     ["void"    ;Unit])
+
+    _
+    #;None))
+
+(def: (generic-class->type' mode type-params in-array? name+params
+                            class->type')
+  (-> Primitive-Mode (List TypeParam) Bool [Text (List GenericType)]
+      (-> Primitive-Mode (List TypeParam) Bool GenericType AST)
+      AST)
+  (case [name+params mode in-array?]
+    (^=> [[prim #;Nil] #ManualPrM false]
+         {(manual-primitive-to-type prim) (#;Some output)})
+    output
+
+    (^=> [[prim #;Nil] #AutoPrM false]
+         {(auto-primitive-to-type prim) (#;Some output)})
+    output
+    
+    [[name params] _ _]
+    (let [=params (map (class->type' mode type-params in-array?) params)]
+      (` (host (~ (ast;symbol ["" name])) [(~@ =params)])))))
+
+(def: (class->type' mode type-params in-array? class)
+  (-> Primitive-Mode (List TypeParam) Bool GenericType AST)
+  (case class
+    (#GenericTypeVar name)
+    (case (find (lambda [[pname pbounds]]
+                  (and (Text/= name pname)
+                       (not (list;empty? pbounds))))
+                type-params)
+      #;None
+      (ast;symbol ["" name])
+
+      (#;Some [pname pbounds])
+      (class->type' mode type-params in-array? (default (undefined) (list;head pbounds))))
+    
+    (#GenericClass name+params)
+    (generic-class->type' mode type-params in-array? name+params
+                          class->type')
+
+    (#GenericArray param)
+    (let [=param (class->type' mode type-params true param)]
+      (` (host (~ (ast;symbol ["" array-type-name])) [(~ =param)])))
+
+    (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _])))
+    (' (;Ex [*] *))
+
+    (#GenericWildcard (#;Some [#UpperBound upper-bound]))
+    (class->type' mode type-params in-array? upper-bound)
+    ))
+
+(def: (class->type mode type-params class)
+  (-> Primitive-Mode (List TypeParam) GenericType AST)
+  (class->type' mode type-params false class))
+
+(def: (type-param-type$ [name bounds])
+  (-> TypeParam AST)
+  (ast;symbol ["" name]))
+
+(def: (class-decl-type$ (^slots [#class-name #class-params]))
+  (-> ClassDecl AST)
+  (let [=params (map (: (-> TypeParam AST)
+                        (lambda [[pname pbounds]]
+                          (case pbounds
+                            #;Nil
+                            (ast;symbol ["" pname])
+
+                            (#;Cons bound1 _)
+                            (class->type #ManualPrM class-params bound1))))
+                     class-params)]
+    (` (host (~ (ast;symbol ["" class-name])) [(~@ =params)]))))
+
+(def: (stack-trace->text trace)
+  (-> StackTrace Text)
+  (let [size (_lux_proc ["jvm" "arraylength"] [trace])
+        idxs (list;range+ +0 (dec+ size))]
+    (|> idxs
+        (map (: (-> Nat Text)
+                (lambda [idx]
+                  (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"]
+                             [(_lux_proc ["jvm" "aaload"] [trace idx])]))))
+        reverse
+        (text;join-with "\n")
+        )))
+
+(def: (get-stack-trace t)
+  (-> (host java.lang.Throwable) StackTrace)
+  (_lux_proc ["jvm" "invokevirtual:java.lang.Throwable:getStackTrace:"] [t]))
+
+(def: #export (throwable->text t)
+  (All [a] (-> (host java.lang.Throwable) (Either Text a)))
+  (#;Left (format (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [t])
+                  "\n"
+                  (|> t get-stack-trace stack-trace->text))))
+
+(def: empty-imports
+  ClassImports
+  (list))
+
+(def: (get-import name imports)
+  (-> Text ClassImports (Maybe Text))
+  (:: Functor map product;right
+      (find (|>. product;left (Text/= name))
+            imports)))
+
+(def: (add-import short+full imports)
+  (-> [Text Text] ClassImports ClassImports)
+  (#;Cons short+full imports))
+
+(def: (class-imports compiler)
+  (-> Compiler ClassImports)
+  (case (compiler;run compiler
+                      (: (Lux ClassImports)
+                         (do Monad
+                           [current-module compiler;current-module-name
+                            defs (compiler;defs current-module)]
+                           (wrap (fold (: (-> [Text Def] ClassImports ClassImports)
+                                          (lambda [[short-name [_ meta _]] imports]
+                                            (case (compiler;get-text-ann (ident-for #;;jvm-class) meta)
+                                              (#;Some full-class-name)
+                                              (add-import [short-name full-class-name] imports)
+
+                                              _
+                                              imports)))
+                                       empty-imports
+                                       defs)))))
+    (#;Left _)        (list)
+    (#;Right imports) imports))
+
+(def: java.lang-classes
+  (List Text)
+  (list ## Interfaces
+   "Appendable"
+   "AutoCloseable"
+   "CharSequence"
+   "Cloneable"
+   "Comparable"
+   "Iterable"
+   "Readable"
+   "Runnable"
+
+   ## Classes
+   "Boolean"
+   "Byte"
+   "Character"
+   "Class"
+   "ClassLoader"
+   "ClassValue"
+   "Compiler"
+   "Double"
+   "Enum"
+   "Float"
+   "InheritableThreadLocal"
+   "Integer"
+   "Long"
+   "Math"
+   "Number"
+   "Object"
+   "Package"
+   "Process"
+   "ProcessBuilder"
+   "Runtime"
+   "RuntimePermission"
+   "SecurityManager"
+   "Short"
+   "StackTraceElement"
+   "StrictMath"
+   "String"
+   "StringBuffer"
+   "StringBuilder"
+   "System"
+   "Thread"
+   "ThreadGroup"
+   "ThreadLocal"
+   "Throwable"
+   "Void"
+
+   ## Exceptions
+   "ArithmeticException"
+   "ArrayIndexOutOfBoundsException"
+   "ArrayStoreException"
+   "ClassCastException"
+   "ClassNotFoundException"
+   "CloneNotSupportedException"
+   "EnumConstantNotPresentException"
+   "Exception"
+   "IllegalAccessException"
+   "IllegalArgumentException"
+   "IllegalMonitorStateException"
+   "IllegalStateException"
+   "IllegalThreadStateException"
+   "IndexOutOfBoundsException"
+   "InstantiationException"
+   "InterruptedException"
+   "NegativeArraySizeException"
+   "NoSuchFieldException"
+   "NoSuchMethodException"
+   "NullPointerException"
+   "NumberFormatException"
+   "ReflectiveOperationException"
+   "RuntimeException"
+   "SecurityException"
+   "StringIndexOutOfBoundsException"
+   "TypeNotPresentException"
+   "UnsupportedOperationException"
+
+   ## Annotations
+   "Deprecated"
+   "Override"
+   "SafeVarargs"
+   "SuppressWarnings"))
+
+(def: (fully-qualified-class-name? name)
+  (-> Text Bool)
+  (text;contains? "." name))
+
+(def: (fully-qualify-class-name imports name)
+  (-> ClassImports Text Text)
+  (cond (fully-qualified-class-name? name)
+        name
+
+        (member? text;Eq java.lang-classes name)
+        (format "java.lang." name)
+
+        ## else
+        (default name (get-import name imports))))
+
+(def: type-var-class Text "java.lang.Object")
+
+(def: (simple-class$ params class)
+  (-> (List TypeParam) GenericType Text)
+  (case class
+    (#GenericTypeVar name)
+    (case (find (lambda [[pname pbounds]]
+                  (and (Text/= name pname)
+                       (not (list;empty? pbounds))))
+                params)
+      #;None
+      type-var-class
+
+      (#;Some [pname pbounds])
+      (simple-class$ params (default (undefined) (list;head pbounds))))
+
+    (^or (#GenericWildcard #;None) (#GenericWildcard (#;Some [#LowerBound _])))
+    type-var-class
+    
+    (#GenericWildcard (#;Some [#UpperBound upper-bound]))
+    (simple-class$ params upper-bound)
+    
+    (#GenericClass name params)
+    name
+
+    (#GenericArray param')
+    (case param'
+      (#GenericArray param)
+      (format "[" (simple-class$ params param))
+      
+      (^template [ ]
+        (#GenericClass  #;Nil)
+        )
+      (["boolean" "[Z"]
+       ["byte"    "[B"]
+       ["short"   "[S"]
+       ["int"     "[I"]
+       ["long"    "[J"]
+       ["float"   "[F"]
+       ["double"  "[D"]
+       ["char"    "[C"])
+      
+      param
+      (format "[L" (simple-class$ params param) ";"))
+    ))
+
+(def: (make-get-const-parser class-name field-name)
+  (-> Text Text (Syntax AST))
+  (do s;Monad
+    [#let [dotted-name (format "." field-name)]
+     _ (s;symbol! ["" dotted-name])]
+    (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" class-name ":" field-name)))] [])))))
+
+(def: (make-get-var-parser class-name field-name)
+  (-> Text Text (Syntax AST))
+  (do s;Monad
+    [#let [dotted-name (format "." field-name)]
+     _ (s;symbol! ["" dotted-name])]
+    (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "getfield" ":" class-name ":" field-name)))] [_jvm_this])))))
+
+(def: (make-put-var-parser class-name field-name)
+  (-> Text Text (Syntax AST))
+  (do s;Monad
+    [#let [dotted-name (format "." field-name)]
+     [_ _ value] (: (Syntax [Unit Unit AST])
+                    (s;form ($_ s;seq (s;symbol! ["" ":="]) (s;symbol! ["" dotted-name]) s;any)))]
+    (wrap (`' (_lux_proc ["jvm" (~ (ast;text (format "putfield" ":" class-name ":" field-name)))] [_jvm_this (~ value)])))))
+
+(def: (pre-walk-replace f input)
+  (-> (-> AST AST) AST AST)
+  (case (f input)
+    (^template []
+      [meta ( parts)]
+      [meta ( (map (pre-walk-replace f) parts))])
+    ([#;FormS]
+     [#;TupleS])
+    
+    [meta (#;RecordS pairs)]
+    [meta (#;RecordS (map (: (-> [AST AST] [AST AST])
+                             (lambda [[key val]]
+                               [(pre-walk-replace f key) (pre-walk-replace f val)]))
+                          pairs))]
+    
+    ast'
+    ast'))
+
+(def: (parser->replacer p ast)
+  (-> (Syntax AST) (-> AST AST))
+  (case (s;run (list ast) p)
+    (#;Right [#;Nil ast'])
+    ast'
+
+    _
+    ast
+    ))
+
+(def: (field->parser class-name [[field-name _ _] field])
+  (-> Text [MemberDecl FieldDecl] (Syntax AST))
+  (case field
+    (#ConstantField _)
+    (make-get-const-parser class-name field-name)
+    
+    (#VariableField _)
+    (s;either (make-get-var-parser class-name field-name)
+              (make-put-var-parser class-name field-name))))
+
+(def: (make-constructor-parser params class-name arg-decls)
+  (-> (List TypeParam) Text (List ArgDecl) (Syntax AST))
+  (do s;Monad
+    [[_ args] (: (Syntax [Unit (List AST)])
+                 (s;form ($_ s;seq (s;symbol! ["" ".new!"]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+     #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
+    (wrap (` (;_lux_proc ["jvm" (~ (ast;text (format "new" ":" class-name ":" (text;join-with "," arg-decls'))))]
+                         [(~@ args)])))))
+
+(def: (make-static-method-parser params class-name method-name arg-decls)
+  (-> (List TypeParam) Text Text (List ArgDecl) (Syntax AST))
+  (do s;Monad
+    [#let [dotted-name (format "." method-name "!")]
+     [_ args] (: (Syntax [Unit (List AST)])
+                 (s;form ($_ s;seq (s;symbol! ["" dotted-name]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+     #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
+    (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format "invokestatic" ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
+                          [(~@ args)])))))
+
+(do-template [ ]
+  [(def: ( params class-name method-name arg-decls)
+     (-> (List TypeParam) Text Text (List ArgDecl) (Syntax AST))
+     (do s;Monad
+       [#let [dotted-name (format "." method-name "!")]
+        [_ args] (: (Syntax [Unit (List AST)])
+                    (s;form ($_ s;seq (s;symbol! ["" dotted-name]) (s;tuple (s;exactly (list;size arg-decls) s;any)))))
+        #let [arg-decls' (: (List Text) (map (. (simple-class$ params) product;right) arg-decls))]]
+       (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format  ":" class-name ":" method-name ":" (text;join-with "," arg-decls'))))]
+                             [(~' _jvm_this) (~@ args)])))))]
+
+  [make-special-method-parser "invokespecial"]
+  [make-virtual-method-parser "invokevirtual"]
+  )
+
+(def: (method->parser params class-name [[method-name _ _] meth-def])
+  (-> (List TypeParam) Text [MemberDecl MethodDef] (Syntax AST))
+  (case meth-def
+    (#ConstructorMethod strict? type-vars args constructor-args return-expr exs)
+    (make-constructor-parser params class-name args)
+    
+    (#StaticMethod strict? type-vars args return-type return-expr exs)
+    (make-static-method-parser params class-name method-name args)
+    
+    (^or (#VirtualMethod final? strict? type-vars args return-type return-expr exs) (#OverridenMethod strict? owner-class type-vars args return-type return-expr exs))
+    (make-special-method-parser params class-name method-name args)
+
+    (#AbstractMethod type-vars args return-type exs)
+    (make-virtual-method-parser params class-name method-name args)
+
+    (#NativeMethod type-vars args return-type exs)
+    (make-virtual-method-parser params class-name method-name args)))
+
+## Syntaxs
+(def: (full-class-name^ imports)
+  (-> ClassImports (Syntax Text))
+  (do s;Monad
+    [name s;local-symbol]
+    (wrap (fully-qualify-class-name imports name))))
+
+(def: privacy-modifier^
+  (Syntax PrivacyModifier)
+  (let [(^open) s;Monad]
+    ($_ s;alt
+        (s;tag! ["" "public"])
+        (s;tag! ["" "private"])
+        (s;tag! ["" "protected"])
+        (wrap []))))
+
+(def: inheritance-modifier^
+  (Syntax InheritanceModifier)
+  (let [(^open) s;Monad]
+    ($_ s;alt
+        (s;tag! ["" "final"])
+        (s;tag! ["" "abstract"])
+        (wrap []))))
+
+(def: bound-kind^
+  (Syntax BoundKind)
+  (s;alt (s;symbol! ["" "<"])
+         (s;symbol! ["" ">"])))
+
+(def: (generic-type^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax GenericType))
+  ($_ s;either
+      (do s;Monad
+        [_ (s;symbol! ["" "?"])]
+        (wrap (#GenericWildcard #;None)))
+      (s;tuple (do s;Monad
+                 [_ (s;symbol! ["" "?"])
+                  bound-kind bound-kind^
+                  bound (generic-type^ imports type-vars)]
+                 (wrap (#GenericWildcard (#;Some [bound-kind bound])))))
+      (do s;Monad
+        [name (full-class-name^ imports)]
+        (let% [ (do-template [ ]
+                            [(Text/=  name)
+                             (wrap (#GenericClass  (list)))]
+
+                            ["[Z" "BooleanArray"]
+                            ["[B" "ByteArray"]
+                            ["[S" "ShortArray"]
+                            ["[I" "IntArray"]
+                            ["[J" "LongArray"]
+                            ["[F" "FloatArray"]
+                            ["[D" "DoubleArray"]
+                            ["[C" "CharArray"])]
+          (cond (member? text;Eq (map product;left type-vars) name)
+                (wrap (#GenericTypeVar name))
+
+                
+                
+                ## else
+                (wrap (#GenericClass name (list))))))
+      (s;form (do s;Monad
+                [name (s;symbol! ["" "Array"])
+                 component (generic-type^ imports type-vars)]
+                (case component
+                  (^template [ ]
+                    (#GenericClass  #;Nil)
+                    (wrap (#GenericClass  (list))))
+                  (["[Z" "boolean"]
+                   ["[B" "byte"]
+                   ["[S" "short"]
+                   ["[I" "int"]
+                   ["[J" "long"]
+                   ["[F" "float"]
+                   ["[D" "double"]
+                   ["[C" "char"])
+
+                  _
+                  (wrap (#GenericArray component)))))
+      (s;form (do s;Monad
+                [name (full-class-name^ imports)
+                 params (s;some (generic-type^ imports type-vars))
+                 _ (s;assert (not (member? text;Eq (map product;left type-vars) name))
+                             (format name " can't be a type-parameter!"))]
+                (wrap (#GenericClass name params))))
+      ))
+
+(def: (type-param^ imports)
+  (-> ClassImports (Syntax TypeParam))
+  (s;either (do s;Monad
+              [param-name s;local-symbol]
+              (wrap [param-name (list)]))
+            (s;tuple (do s;Monad
+                       [param-name s;local-symbol
+                        _ (s;symbol! ["" "<"])
+                        bounds (s;many (generic-type^ imports (list)))]
+                       (wrap [param-name bounds])))))
+
+(def: (type-params^ imports)
+  (-> ClassImports (Syntax (List TypeParam)))
+  (s;tuple (s;some (type-param^ imports))))
+
+(def: (class-decl^ imports)
+  (-> ClassImports (Syntax ClassDecl))
+  (s;either (do s;Monad
+              [name (full-class-name^ imports)]
+              (wrap [name (list)]))
+            (s;form (do s;Monad
+                      [name (full-class-name^ imports)
+                       params (s;some (type-param^ imports))]
+                      (wrap [name params])))
+            ))
+
+(def: (super-class-decl^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax SuperClassDecl))
+  (s;either (do s;Monad
+              [name (full-class-name^ imports)]
+              (wrap [name (list)]))
+            (s;form (do s;Monad
+                      [name (full-class-name^ imports)
+                       params (s;some (generic-type^ imports type-vars))]
+                      (wrap [name params])))))
+
+(def: annotation-params^
+  (Syntax (List AnnotationParam))
+  (s;record (s;some (s;seq s;local-tag s;any))))
+
+(def: (annotation^ imports)
+  (-> ClassImports (Syntax Annotation))
+  (s;either (do s;Monad
+              [ann-name (full-class-name^ imports)]
+              (wrap [ann-name (list)]))
+            (s;form (s;seq (full-class-name^ imports)
+                           annotation-params^))))
+
+(def: (annotations^' imports)
+  (-> ClassImports (Syntax (List Annotation)))
+  (do s;Monad
+    [_ (s;tag! ["" "ann"])]
+    (s;tuple (s;some (annotation^ imports)))))
+
+(def: (annotations^ imports)
+  (-> ClassImports (Syntax (List Annotation)))
+  (do s;Monad
+    [anns?? (s;opt (annotations^' imports))]
+    (wrap (default (list) anns??))))
+
+(def: (throws-decl'^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax (List GenericType)))
+  (do s;Monad
+    [_ (s;tag! ["" "throws"])]
+    (s;tuple (s;some (generic-type^ imports type-vars)))))
+
+(def: (throws-decl^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax (List GenericType)))
+  (do s;Monad
+    [exs? (s;opt (throws-decl'^ imports type-vars))]
+    (wrap (default (list) exs?))))
+
+(def: (method-decl^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDecl]))
+  (s;form (do s;Monad
+            [tvars (s;default (list) (type-params^ imports))
+             name s;local-symbol
+             anns (annotations^ imports)
+             inputs (s;tuple (s;some (generic-type^ imports type-vars)))
+             output (generic-type^ imports type-vars)
+             exs (throws-decl^ imports type-vars)]
+            (wrap [[name #PublicPM anns] {#method-tvars tvars
+                                          #method-inputs inputs
+                                          #method-output output
+                                          #method-exs    exs}]))))
+
+(def: state-modifier^
+  (Syntax StateModifier)
+  ($_ s;alt
+      (s;tag! ["" "volatile"])
+      (s;tag! ["" "final"])
+      (:: s;Monad wrap [])))
+
+(def: (field-decl^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax [MemberDecl FieldDecl]))
+  (s;either (s;form (do s;Monad
+                      [_ (s;tag! ["" "const"])
+                       name s;local-symbol
+                       anns (annotations^ imports)
+                       type (generic-type^ imports type-vars)
+                       body s;any]
+                      (wrap [[name #PublicPM anns] (#ConstantField [type body])])))
+            (s;form (do s;Monad
+                      [pm privacy-modifier^
+                       sm state-modifier^
+                       name s;local-symbol
+                       anns (annotations^ imports)
+                       type (generic-type^ imports type-vars)]
+                      (wrap [[name pm anns] (#VariableField [sm type])])))))
+
+(def: (arg-decl^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax ArgDecl))
+  (s;record (s;seq s;local-symbol
+                   (generic-type^ imports type-vars))))
+
+(def: (arg-decls^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax (List ArgDecl)))
+  (s;some (arg-decl^ imports type-vars)))
+
+(def: (constructor-arg^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax ConstructorArg))
+  (s;tuple (s;seq (generic-type^ imports type-vars) s;any)))
+
+(def: (constructor-args^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax (List ConstructorArg)))
+  (s;tuple (s;some (constructor-arg^ imports type-vars))))
+
+(def: (constructor-method^ imports class-vars)
+  (-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [pm privacy-modifier^
+             strict-fp? (s;tag? ["" "strict"])
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars (List/append class-vars method-vars)]
+             [_ arg-decls] (s;form (s;seq (s;symbol! ["" "new"])
+                                          (arg-decls^ imports total-vars)))
+             constructor-args (constructor-args^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)
+             body s;any]
+            (wrap [{#member-name constructor-method-name
+                    #member-privacy pm
+                    #member-anns annotations}
+                   (#ConstructorMethod strict-fp? method-vars arg-decls constructor-args body exs)]))))
+
+(def: (virtual-method-def^ imports class-vars)
+  (-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [pm privacy-modifier^
+             strict-fp? (s;tag? ["" "strict"])
+             final? (s;tag? ["" "final"])
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars (List/append class-vars method-vars)]
+             [name arg-decls] (s;form (s;seq s;local-symbol
+                                             (arg-decls^ imports total-vars)))
+             return-type (generic-type^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)
+             body s;any]
+            (wrap [{#member-name name
+                    #member-privacy pm
+                    #member-anns annotations}
+                   (#VirtualMethod final? strict-fp? method-vars arg-decls return-type body exs)]))))
+
+(def: (overriden-method-def^ imports)
+  (-> ClassImports (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [strict-fp? (s;tag? ["" "strict"])
+             owner-class (class-decl^ imports)
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars (List/append (product;right owner-class) method-vars)]
+             [name arg-decls] (s;form (s;seq s;local-symbol
+                                             (arg-decls^ imports total-vars)))
+             return-type (generic-type^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)
+             body s;any]
+            (wrap [{#member-name name
+                    #member-privacy #PublicPM
+                    #member-anns annotations}
+                   (#OverridenMethod strict-fp? owner-class method-vars arg-decls return-type body exs)]))))
+
+(def: (static-method-def^ imports)
+  (-> ClassImports (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [pm privacy-modifier^
+             strict-fp? (s;tag? ["" "strict"])
+             _ (s;tag! ["" "static"])
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars method-vars]
+             [name arg-decls] (s;form (s;seq s;local-symbol
+                                             (arg-decls^ imports total-vars)))
+             return-type (generic-type^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)
+             body s;any]
+            (wrap [{#member-name name
+                    #member-privacy pm
+                    #member-anns annotations}
+                   (#StaticMethod strict-fp? method-vars arg-decls return-type body exs)]))))
+
+(def: (abstract-method-def^ imports)
+  (-> ClassImports (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [pm privacy-modifier^
+             _ (s;tag! ["" "abstract"])
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars method-vars]
+             [name arg-decls] (s;form (s;seq s;local-symbol
+                                             (arg-decls^ imports total-vars)))
+             return-type (generic-type^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)]
+            (wrap [{#member-name name
+                    #member-privacy pm
+                    #member-anns annotations}
+                   (#AbstractMethod method-vars arg-decls return-type exs)]))))
+
+(def: (native-method-def^ imports)
+  (-> ClassImports (Syntax [MemberDecl MethodDef]))
+  (s;form (do s;Monad
+            [pm privacy-modifier^
+             _ (s;tag! ["" "native"])
+             method-vars (s;default (list) (type-params^ imports))
+             #let [total-vars method-vars]
+             [name arg-decls] (s;form (s;seq s;local-symbol
+                                             (arg-decls^ imports total-vars)))
+             return-type (generic-type^ imports total-vars)
+             exs (throws-decl^ imports total-vars)
+             annotations (annotations^ imports)]
+            (wrap [{#member-name name
+                    #member-privacy pm
+                    #member-anns annotations}
+                   (#NativeMethod method-vars arg-decls return-type exs)]))))
+
+(def: (method-def^ imports class-vars)
+  (-> ClassImports (List TypeParam) (Syntax [MemberDecl MethodDef]))
+  ($_ s;either
+      (constructor-method^ imports class-vars)
+      (virtual-method-def^ imports class-vars)
+      (overriden-method-def^ imports)
+      (static-method-def^ imports)
+      (abstract-method-def^ imports)
+      (native-method-def^ imports)))
+
+(def: partial-call^
+  (Syntax PartialCall)
+  (s;form (s;seq s;any s;any)))
+
+(def: class-kind^
+  (Syntax ClassKind)
+  (s;either (do s;Monad
+              [_ (s;tag! ["" "class"])]
+              (wrap #Class))
+            (do s;Monad
+              [_ (s;tag! ["" "interface"])]
+              (wrap #Interface))
+            ))
+
+(def: import-member-alias^
+  (Syntax (Maybe Text))
+  (s;opt (do s;Monad
+           [_ (s;tag! ["" "as"])]
+           s;local-symbol)))
+
+(def: (import-member-args^ imports type-vars)
+  (-> ClassImports (List TypeParam) (Syntax (List [Bool GenericType])))
+  (s;tuple (s;some (s;seq (s;tag? ["" "?"]) (generic-type^ imports type-vars)))))
+
+(def: import-member-return-flags^
+  (Syntax [Bool Bool Bool])
+  ($_ s;seq (s;tag? ["" "io"]) (s;tag? ["" "try"]) (s;tag? ["" "?"])))
+
+(def: primitive-mode^
+  (Syntax Primitive-Mode)
+  (s;alt (s;tag! ["" "manual"])
+         (s;tag! ["" "auto"])))
+
+(def: (import-member-decl^ imports owner-vars)
+  (-> ClassImports (List TypeParam) (Syntax ImportMemberDecl))
+  ($_ s;either
+      (s;form (do s;Monad
+                [_ (s;tag! ["" "enum"])
+                 enum-members (s;some s;local-symbol)]
+                (wrap (#EnumDecl enum-members))))
+      (s;form (do s;Monad
+                [tvars (s;default (list) (type-params^ imports))
+                 _ (s;symbol! ["" "new"])
+                 ?alias import-member-alias^
+                 #let [total-vars (List/append owner-vars tvars)]
+                 ?prim-mode (s;opt primitive-mode^)
+                 args (import-member-args^ imports total-vars)
+                 [io? try? maybe?] import-member-return-flags^]
+                (wrap (#ConstructorDecl [{#import-member-mode    (default #AutoPrM ?prim-mode)
+                                          #import-member-alias   (default "new" ?alias)
+                                          #import-member-kind    #VirtualIMK
+                                          #import-member-tvars   tvars
+                                          #import-member-args    args
+                                          #import-member-maybe?  maybe?
+                                          #import-member-try?    try?
+                                          #import-member-io?     io?}
+                                         {}]))
+                ))
+      (s;form (do s;Monad
+                [kind (: (Syntax ImportMethodKind)
+                         (s;alt (s;tag! ["" "static"])
+                                (wrap [])))
+                 tvars (s;default (list) (type-params^ imports))
+                 name s;local-symbol
+                 ?alias import-member-alias^
+                 #let [total-vars (List/append owner-vars tvars)]
+                 ?prim-mode (s;opt primitive-mode^)
+                 args (import-member-args^ imports total-vars)
+                 [io? try? maybe?] import-member-return-flags^
+                 return (generic-type^ imports total-vars)]
+                (wrap (#MethodDecl [{#import-member-mode    (default #AutoPrM ?prim-mode)
+                                     #import-member-alias   (default name ?alias)
+                                     #import-member-kind    kind
+                                     #import-member-tvars   tvars
+                                     #import-member-args    args
+                                     #import-member-maybe?  maybe?
+                                     #import-member-try?    try?
+                                     #import-member-io?     io?}
+                                    {#import-method-name    name
+                                     #import-method-return  return
+                                     }]))))
+      (s;form (do s;Monad
+                [static? (s;tag? ["" "static"])
+                 name s;local-symbol
+                 ?prim-mode (s;opt primitive-mode^)
+                 gtype (generic-type^ imports owner-vars)
+                 maybe? (s;tag? ["" "?"])
+                 setter? (s;tag? ["" "!"])]
+                (wrap (#FieldAccessDecl {#import-field-mode    (default #AutoPrM ?prim-mode)
+                                         #import-field-name    name
+                                         #import-field-static? static?
+                                         #import-field-maybe?  maybe?
+                                         #import-field-setter? setter?
+                                         #import-field-type    gtype}))))
+      ))
+
+## Generators
+(def: with-parens
+  (-> Code Code)
+  (text;enclose ["(" ")"]))
+
+(def: with-brackets
+  (-> Code Code)
+  (text;enclose ["[" "]"]))
+
+(def: spaced
+  (-> (List Code) Code)
+  (text;join-with " "))
+
+(def: (privacy-modifier$ pm)
+  (-> PrivacyModifier Code)
+  (case pm
+    #PublicPM    "public"
+    #PrivatePM   "private"
+    #ProtectedPM "protected"
+    #DefaultPM   "default"))
+
+(def: (inheritance-modifier$ im)
+  (-> InheritanceModifier Code)
+  (case im
+    #FinalIM    "final"
+    #AbstractIM "abstract"
+    #DefaultIM  "default"))
+
+(def: (annotation-param$ [name value])
+  (-> AnnotationParam Code)
+  (format name "=" (ast;ast-to-text value)))
+
+(def: (annotation$ [name params])
+  (-> Annotation Code)
+  (format "(" name " " "{" (text;join-with "\t" (map annotation-param$ params)) "}" ")"))
+
+(def: (bound-kind$ kind)
+  (-> BoundKind Code)
+  (case kind
+    #UpperBound "<"
+    #LowerBound ">"))
+
+(def: (generic-type$ gtype)
+  (-> GenericType Code)
+  (case gtype
+    (#GenericTypeVar name)
+    name
+
+    (#GenericClass name params)
+    (format "(" name " " (spaced (map generic-type$ params)) ")")
+    
+    (#GenericArray param)
+    (format "(" array-type-name " " (generic-type$ param) ")")
+    
+    (#GenericWildcard #;None)
+    "?"
+
+    (#GenericWildcard (#;Some [bound-kind bound]))
+    (format (bound-kind$ bound-kind) (generic-type$ bound))))
+
+(def: (type-param$ [name bounds])
+  (-> TypeParam Code)
+  (format "(" name " " (spaced (map generic-type$ bounds)) ")"))
+
+(def: (class-decl$ (^open))
+  (-> ClassDecl Code)
+  (format "(" class-name " " (spaced (map type-param$ class-params)) ")"))
+
+(def: (super-class-decl$ (^slots [#super-class-name #super-class-params]))
+  (-> SuperClassDecl Code)
+  (format "(" super-class-name " " (spaced (map generic-type$ super-class-params)) ")"))
+
+(def: (method-decl$ [[name pm anns] method-decl])
+  (-> [MemberDecl MethodDecl] Code)
+  (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl]
+    (with-parens
+      (spaced (list name
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ method-tvars)))
+                    (with-brackets (spaced (map generic-type$ method-exs)))
+                    (with-brackets (spaced (map generic-type$ method-inputs)))
+                    (generic-type$ method-output))
+              ))))
+
+(def: (state-modifier$ sm)
+  (-> StateModifier Code)
+  (case sm
+    #VolatileSM "volatile"
+    #FinalSM    "final"
+    #DefaultSM  "default"))
+
+(def: (field-decl$ [[name pm anns] field])
+  (-> [MemberDecl FieldDecl] Code)
+  (case field
+    (#ConstantField class value)
+    (with-parens
+      (spaced (list "constant" name
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (generic-type$ class)
+                    (ast;ast-to-text value))
+              ))
+
+    (#VariableField sm class)
+    (with-parens
+      (spaced (list "variable" name
+                    (privacy-modifier$ pm)
+                    (state-modifier$ sm)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (generic-type$ class))
+              ))
+    ))
+
+(def: (arg-decl$ [name type])
+  (-> ArgDecl Code)
+  (with-parens
+    (spaced (list name (generic-type$ type)))))
+
+(def: (constructor-arg$ [class term])
+  (-> ConstructorArg Code)
+  (with-brackets
+    (spaced (list (generic-type$ class) (ast;ast-to-text term)))))
+
+(def: (method-def$ replacer super-class [[name pm anns] method-def])
+  (-> (-> AST AST) SuperClassDecl [MemberDecl MethodDef] Code)
+  (case method-def
+    (#ConstructorMethod strict-fp? type-vars arg-decls constructor-args body exs)
+    (with-parens
+      (spaced (list "init"
+                    (privacy-modifier$ pm)
+                    (Bool/encode strict-fp?)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ type-vars)))
+                    (with-brackets (spaced (map generic-type$ exs)))
+                    (with-brackets (spaced (map arg-decl$ arg-decls)))
+                    (with-brackets (spaced (map constructor-arg$ constructor-args)))
+                    (ast;ast-to-text (pre-walk-replace replacer body))
+                    )))
+    
+    (#VirtualMethod final? strict-fp? type-vars arg-decls return-type body exs)
+    (with-parens
+      (spaced (list "virtual"
+                    name
+                    (privacy-modifier$ pm)
+                    (Bool/encode final?)
+                    (Bool/encode strict-fp?)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ type-vars)))
+                    (with-brackets (spaced (map generic-type$ exs)))
+                    (with-brackets (spaced (map arg-decl$ arg-decls)))
+                    (generic-type$ return-type)
+                    (ast;ast-to-text (pre-walk-replace replacer body)))))
+    
+    (#OverridenMethod strict-fp? class-decl type-vars arg-decls return-type body exs)
+    (let [super-replacer (parser->replacer (s;form (do s;Monad
+                                                     [_ (s;symbol! ["" ".super!"])
+                                                      args (s;tuple (s;exactly (list;size arg-decls) s;any))
+                                                      #let [arg-decls' (: (List Text) (map (. (simple-class$ (list)) product;right)
+                                                                                           arg-decls))]]
+                                                     (wrap (`' (;_lux_proc ["jvm" (~ (ast;text (format "invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text;join-with "," arg-decls'))))]
+                                                                           [(~' _jvm_this) (~@ args)]))))))]
+      (with-parens
+        (spaced (list "override"
+                      (class-decl$ class-decl)
+                      name
+                      (Bool/encode strict-fp?)
+                      (with-brackets (spaced (map annotation$ anns)))
+                      (with-brackets (spaced (map type-param$ type-vars)))
+                      (with-brackets (spaced (map generic-type$ exs)))
+                      (with-brackets (spaced (map arg-decl$ arg-decls)))
+                      (generic-type$ return-type)
+                      (|> body
+                          (pre-walk-replace replacer)
+                          (pre-walk-replace super-replacer)
+                          (ast;ast-to-text))
+                      ))))
+
+    (#StaticMethod strict-fp? type-vars arg-decls return-type body exs)
+    (with-parens
+      (spaced (list "static"
+                    name
+                    (privacy-modifier$ pm)
+                    (Bool/encode strict-fp?)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ type-vars)))
+                    (with-brackets (spaced (map generic-type$ exs)))
+                    (with-brackets (spaced (map arg-decl$ arg-decls)))
+                    (generic-type$ return-type)
+                    (ast;ast-to-text (pre-walk-replace replacer body)))))
+
+    (#AbstractMethod type-vars arg-decls return-type exs)
+    (with-parens
+      (spaced (list "abstract"
+                    name
+                    (privacy-modifier$ pm)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ type-vars)))
+                    (with-brackets (spaced (map generic-type$ exs)))
+                    (with-brackets (spaced (map arg-decl$ arg-decls)))
+                    (generic-type$ return-type))))
+
+    (#NativeMethod type-vars arg-decls return-type exs)
+    (with-parens
+      (spaced (list "native"
+                    name
+                    (privacy-modifier$ pm)
+                    (with-brackets (spaced (map annotation$ anns)))
+                    (with-brackets (spaced (map type-param$ type-vars)))
+                    (with-brackets (spaced (map generic-type$ exs)))
+                    (with-brackets (spaced (map arg-decl$ arg-decls)))
+                    (generic-type$ return-type))))
+    ))
+
+(def: (complete-call$ obj [method args])
+  (-> AST PartialCall AST)
+  (` ((~ method) (~ args) (~ obj))))
+
+## [Syntax]
+(def: object-super-class
+  SuperClassDecl
+  {#super-class-name   "java.lang.Object"
+   #super-class-params (list)})
+
+(syntax: #export (class: {#let [imports (class-imports *compiler*)]}
+                   {im inheritance-modifier^}
+                   {class-decl (class-decl^ imports)}
+                   {#let [full-class-name (product;left class-decl)
+                          imports (add-import [(short-class-name full-class-name) full-class-name]
+                                              (class-imports *compiler*))]}
+                   {#let [class-vars (product;right class-decl)]}
+                   {super (s;opt (super-class-decl^ imports class-vars))}
+                   {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {annotations (annotations^ imports)}
+                   {fields (s;some (field-decl^ imports class-vars))}
+                   {methods (s;some (method-def^ imports class-vars))})
+  {#;doc (doc "Allows defining JVM classes in Lux code."
+              "For example:"
+              (class: #final (JvmPromise A) []
+                ## Fields
+                (#private resolved boolean)
+                (#private datum A)
+                (#private waitingList (java.util.List lux.Function))
+                ## Methods
+                (#public new [] [] []
+                         (exec (:= .resolved false)
+                           (:= .waitingList (ArrayList.new []))
+                           []))
+                (#public resolve [] [{value A}] boolean
+                         (let [container (.new! [])]
+                           (synchronized _jvm_this
+                             (if .resolved
+                               false
+                               (exec (:= .datum value)
+                                 (:= .resolved true)
+                                 (let [sleepers .waitingList
+                                       sleepers-count (java.util.List.size [] sleepers)]
+                                   (map (lambda [idx]
+                                          (let [sleeper (java.util.List.get [(l2i idx)] sleepers)]
+                                            (Executor.execute [(@runnable (lux.Function.apply [(:! Object value)] sleeper))]
+                                                              executor)))
+                                        (range 0 (dec (i2l sleepers-count)))))
+                                 (:= .waitingList (null))
+                                 true)))))
+                (#public poll [] [] A
+                         .datum)
+                (#public wasResolved [] [] boolean
+                         (synchronized _jvm_this
+                           .resolved))
+                (#public waitOn [] [{callback lux.Function}] void
+                         (synchronized _jvm_this
+                           (exec (if .resolved
+                                   (lux.Function.apply [(:! Object .datum)] callback)
+                                   (:! Object (java.util.List.add [callback] .waitingList)))
+                             [])))
+                (#public #static make [A] [{value A}] (lux.concurrency.promise.JvmPromise A)
+                         (let [container (.new! [])]
+                           (exec (.resolve! (:! (host lux.concurrency.promise.JvmPromise [Unit]) container) [(:! Unit value)])
+                             container))))
+
+              "The vector corresponds to parent interfaces."
+              "An optional super-class can be specified before the vector. If not specified, java.lang.Object will be assumed."
+              "Fields and methods defined in the class can be used with special syntax."
+              "For example:"
+              ".resolved, for accessing the \"resolved\" field."
+              "(:= .resolved true) for modifying it."
+              "(.new! []) for calling the class's constructor."
+              "(.resolve! container [value]) for calling the \"resolve\" method."
+              )}
+  (do Monad
+    [current-module compiler;current-module-name
+     #let [fully-qualified-class-name (format (text;replace "/" "." current-module) "." full-class-name)
+           field-parsers (map (field->parser fully-qualified-class-name) fields)
+           method-parsers (map (method->parser (product;right class-decl) fully-qualified-class-name) methods)
+           replacer (parser->replacer (fold s;either
+                                            (s;fail "")
+                                            (List/append field-parsers method-parsers)))
+           super-class (default object-super-class super)
+           def-code (format "class:"
+                            (spaced (list (class-decl$ class-decl)
+                                          (super-class-decl$ super-class)
+                                          (with-brackets (spaced (map super-class-decl$ interfaces)))
+                                          (inheritance-modifier$ im)
+                                          (with-brackets (spaced (map annotation$ annotations)))
+                                          (with-brackets (spaced (map field-decl$ fields)))
+                                          (with-brackets (spaced (map (method-def$ replacer super-class) methods))))))]]
+    (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
+
+(syntax: #export (interface: {#let [imports (class-imports *compiler*)]}
+                   {class-decl (class-decl^ imports)}
+                   {#let [full-class-name (product;left class-decl)
+                          imports (add-import [(short-class-name full-class-name) full-class-name]
+                                              (class-imports *compiler*))]}
+                   {#let [class-vars (product;right class-decl)]}
+                   {supers (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {annotations (annotations^ imports)}
+                   {members (s;some (method-decl^ imports class-vars))})
+  (let [def-code (format "interface:"
+                         (spaced (list (class-decl$ class-decl)
+                                       (with-brackets (spaced (map super-class-decl$ supers)))
+                                       (with-brackets (spaced (map annotation$ annotations)))
+                                       (spaced (map method-decl$ members)))))]
+    (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))
+    ))
+
+(syntax: #export (object {#let [imports (class-imports *compiler*)]}
+                   {#let [class-vars (list)]}
+                   {super (s;opt (super-class-decl^ imports class-vars))}
+                   {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+                   {constructor-args (constructor-args^ imports class-vars)}
+                   {methods (s;some (overriden-method-def^ imports))})
+  {#;doc (doc "Allows defining anonymous classes."
+              "The 1st vector corresponds to parent interfaces."
+              "The 2nd vector corresponds to arguments to the super class constructor."
+              "An optional super-class can be specified before the 1st vector. If not specified, java.lang.Object will be assumed."
+              (object [java.lang.Runnable]
+                []
+                (java.lang.Runnable run [] [] void
+                                    (exec (do-something some-input)
+                                      [])))
+              )}
+  (let [super-class (default object-super-class super)
+        def-code (format "anon-class:"
+                         (spaced (list (super-class-decl$ super-class)
+                                       (with-brackets (spaced (map super-class-decl$ interfaces)))
+                                       (with-brackets (spaced (map constructor-arg$ constructor-args)))
+                                       (with-brackets (spaced (map (method-def$ id super-class) methods))))))]
+    (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
+
+(syntax: #export (null)
+  {#;doc (doc "Null object pointer."
+              (null))}
+  (wrap (list (` (;_lux_proc ["jvm" "null"] [])))))
+
+(def: #export (null? obj)
+  {#;doc (doc "Test for null object pointer."
+              (null? (null))
+              "=>"
+              true
+              (null? "YOLO")
+              "=>"
+              false)}
+  (-> (host java.lang.Object) Bool)
+  (;_lux_proc ["jvm" "null?"] [obj]))
+
+(syntax: #export (??? expr)
+  {#;doc (doc "Takes a (potentially null) object pointer and creates a (Maybe ObjectType) for it."
+              (??? (: java.lang.Thread (null)))
+              "=>"
+              #;None
+              (??? "YOLO")
+              "=>"
+              (#;Some "YOLO"))}
+  (with-gensyms [g!temp]
+    (wrap (list (` (let [(~ g!temp) (~ expr)]
+                     (if (;_lux_proc ["jvm" "null?"] [(~ g!temp)])
+                       #;None
+                       (#;Some (~ g!temp)))))))))
+
+(syntax: #export (!!! expr)
+  {#;doc (doc "Takes a (Maybe ObjectType) and return a ObjectType."
+              "A #;None would gets translated in to a (null)."
+              "Takes a (potentially null) object pointer and creates a (Maybe ObjectType) for it."
+              (!!! (??? (: java.lang.Thread (null))))
+              "=>"
+              (null)
+              (!!! (??? "YOLO"))
+              "=>"
+              "YOLO")}
+  (with-gensyms [g!value]
+    (wrap (list (` (;_lux_case (~ expr)
+                     (#;Some (~ g!value))
+                     (~ g!value)
+
+                     #;None
+                     (;_lux_proc ["jvm" "null"] [])))))))
+
+(syntax: #export (try expr)
+  {#;doc (doc "Covers the expression in a try-catch block."
+              "If it succeeds, you get (#;Right result)."
+              "If it fails, you get (#;Left error+stack-traces-as-text)."
+              (try (risky-computation input)))}
+  (wrap (list (`' (_lux_proc ["jvm" "try"]
+                             [(#;Right (~ expr))
+                              ;;throwable->text])))))
+
+(syntax: #export (instance? {#let [imports (class-imports *compiler*)]}
+                            {class (generic-type^ imports (list))}
+                            obj)
+  {#;doc (doc "Checks whether an object is an instance of a particular class."
+              "Caveat emptor: Can't check for polymorphism, so avoid using parameterized classes."
+              (instance? String "YOLO"))}
+  (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text (format "instanceof" ":" (simple-class$ (list) class))))] [(~ obj)])))))
+
+(syntax: #export (synchronized lock body)
+  {#;doc (doc "Evaluates body, while holding a lock on a given object."
+              (synchronized object-to-be-locked
+                (exec (do-something ...)
+                  (do-something-else ...)
+                  (finish-the-computation ...))))}
+  (wrap (list (` (;_lux_proc ["jvm" "synchronized"] [(~ lock) (~ body)]))))
+  ## (with-gensyms [g!lock g!body g!_ g!e]
+  ##   (wrap (list (` (let [(~ g!lock) (~ lock)
+  ##                        (~ g!_) (;_lux_proc ["jvm" "monitorenter"] [(~ g!lock)])
+  ##                        (~ g!body) (~ body)
+  ##                        (~ g!_) (;_lux_proc ["jvm" "monitorexit"] [(~ g!lock)])]
+  ##                    (~ g!body)))))
+  ##   )
+  )
+
+(syntax: #export (do-to obj {methods (s;some partial-call^)})
+  {#;doc (doc "Call a variety of methods on an object; then return the object."
+              (do-to vreq
+                (HttpServerRequest.setExpectMultipart [true])
+                (ReadStream.handler [(object [(Handler Buffer)]
+                                       []
+                                       ((Handler A) handle [] [(buffer A)] void
+                                        (io;run (do Monad
+                                                  [_ (write (Buffer.getBytes [] buffer) body)]
+                                                  (wrap []))))
+                                       )])
+                (ReadStream.endHandler [[(object [(Handler Void)]
+                                           []
+                                           ((Handler A) handle [] [(_ A)] void
+                                            (exec (do Monad
+                                                    [#let [_ (io;run (close body))]
+                                                     response (handler (request$ vreq body))]
+                                                    (respond! response vreq))
+                                              []))
+                                           )]])))}
+  (with-gensyms [g!obj]
+    (wrap (list (` (let [(~ g!obj) (~ obj)]
+                     (exec (~@ (map (complete-call$ g!obj) methods))
+                       (~ g!obj))))))))
+
+(def: (class-import$ long-name? [full-name params])
+  (-> Bool ClassDecl AST)
+  (let [def-name (if long-name?
+                   full-name
+                   (short-class-name full-name))]
+    (case params
+      #;Nil
+      (` (def: (~ (ast;symbol ["" def-name]))
+           {#;type? true
+            #;;jvm-class (~ (ast;text full-name))}
+           Type
+           (host (~ (ast;symbol ["" full-name])))))
+
+      (#;Cons _)
+      (let [params' (map (lambda [[p _]] (ast;symbol ["" p])) params)]
+        (` (def: (~ (ast;symbol ["" def-name]))
+             {#;type?      true
+              #;;jvm-class (~ (ast;text full-name))}
+             Type
+             (All [(~@ params')]
+               (host (~ (ast;symbol ["" full-name]))
+                     [(~@ params')]))))))))
+
+(def: (member-type-vars class-tvars member)
+  (-> (List TypeParam) ImportMemberDecl (List TypeParam))
+  (case member
+    (#ConstructorDecl [commons _])
+    (List/append class-tvars (get@ #import-member-tvars commons))
+
+    (#MethodDecl [commons _])
+    (case (get@ #import-member-kind commons)
+      #StaticIMK
+      (get@ #import-member-tvars commons)
+
+      _
+      (List/append class-tvars (get@ #import-member-tvars commons)))
+
+    _
+    class-tvars))
+
+(def: (member-def-arg-bindings type-params class member)
+  (-> (List TypeParam) ClassDecl ImportMemberDecl (Lux [(List AST) (List AST) (List Text) (List AST)]))
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (let [(^slots [#import-member-tvars #import-member-args]) commons]
+      (do Monad
+        [arg-inputs (mapM @
+                          (: (-> [Bool GenericType] (Lux [AST AST]))
+                             (lambda [[maybe? _]]
+                               (with-gensyms [arg-name]
+                                 (wrap [arg-name (if maybe?
+                                                   (` (!!! (~ arg-name)))
+                                                   arg-name)]))))
+                          import-member-args)
+         #let [arg-classes (: (List Text)
+                              (map (. (simple-class$ (List/append type-params import-member-tvars)) product;right)
+                                   import-member-args))
+               arg-types (map (: (-> [Bool GenericType] AST)
+                                 (lambda [[maybe? arg]]
+                                   (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)]
+                                     (if maybe?
+                                       (` (Maybe (~ arg-type)))
+                                       arg-type))))
+                              import-member-args)
+               arg-lambda-inputs (map product;left arg-inputs)
+               arg-method-inputs (map product;right arg-inputs)]]
+        (wrap [arg-lambda-inputs arg-method-inputs arg-classes arg-types])))
+
+    _
+    (:: Monad wrap [(list) (list) (list) (list)])))
+
+(def: (member-def-return mode type-params class member)
+  (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Lux AST))
+  (case member
+    (#ConstructorDecl _)
+    (:: Monad wrap (class-decl-type$ class))
+
+    (#MethodDecl [_ method])
+    (:: Monad wrap (class->type mode type-params (get@ #import-method-return method)))
+
+    _
+    (compiler;fail "Only methods have return values.")))
+
+(def: (decorate-return-maybe member [return-type return-term])
+  (-> ImportMemberDecl [AST AST] [AST AST])
+  (case member
+    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+    (if (get@ #import-member-maybe? commons)
+      [(` (Maybe (~ return-type)))
+       (` (??? (~ return-term)))]
+      [return-type
+       (let [g!temp (ast;symbol ["" "Ω"])]
+         (` (let [(~ g!temp) (~ return-term)]
+              (if (null? (:! (host (~' java.lang.Object))
+                             (~ g!temp)))
+                (error! "Can't produce null pointers from method calls.")
+                (~ g!temp)))))])
+
+    _
+    [return-type return-term]))
+
+(do-template [   ]
+  [(def: ( member [return-type return-term])
+     (-> ImportMemberDecl [AST AST] [AST AST])
+     (case member
+       (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
+       (if (get@  commons)
+         [ ]
+         [return-type return-term])
+
+       _
+       [return-type return-term]))]
+
+  [decorate-return-try #import-member-try? (` (Either Text (~ return-type))) (` (try (~ return-term)))]
+  [decorate-return-io  #import-member-io?  (` (IO (~ return-type)))          (` (io (~ return-term)))]
+  )
+
+(def: (free-type-param? [name bounds])
+  (-> TypeParam Bool)
+  (case bounds
+    #;Nil true
+    _     false))
+
+(def: (type-param->type-arg [name _])
+  (-> TypeParam AST)
+  (ast;symbol ["" name]))
+
+(def: (with-mode-output mode output-type body)
+  (-> Primitive-Mode GenericType AST AST)
+  (case mode
+    #ManualPrM
+    body
+    
+    #AutoPrM
+    (case output-type
+      (#GenericClass ["byte" _])
+      (` (b2l (~ body)))
+      
+      (#GenericClass ["short" _])
+      (` (s2l (~ body)))
+      
+      (#GenericClass ["int" _])
+      (` (i2l (~ body)))
+      
+      (#GenericClass ["float" _])
+      (` (f2d (~ body)))
+      
+      _
+      body)))
+
+(def: (auto-conv-class? class)
+  (-> Text Bool)
+  (case class
+    (^or "byte" "short" "int" "float")
+    true
+
+    _
+    false))
+
+(def: (auto-conv [class var])
+  (-> [Text AST] (List AST))
+  (case class
+    "byte"  (list var (` (l2b (~ var))))
+    "short" (list var (` (l2s (~ var))))
+    "int"   (list var (` (l2i (~ var))))
+    "float" (list var (` (d2f (~ var))))
+    _       (list)))
+
+(def: (with-mode-inputs mode inputs body)
+  (-> Primitive-Mode (List [Text AST]) AST AST)
+  (case mode
+    #ManualPrM
+    body
+    
+    #AutoPrM
+    (` (let [(~@ (|> inputs
+                     (List/map auto-conv)
+                     List/join))]
+         (~ body)))))
+
+(def: (with-mode-field-get mode class output)
+  (-> Primitive-Mode GenericType AST AST)
+  (case mode
+    #ManualPrM
+    output
+    
+    #AutoPrM
+    (case (simple-class$ (list) class)
+      "byte"  (` (b2l (~ output)))
+      "short" (` (s2l (~ output)))
+      "int"   (` (i2l (~ output)))
+      "float" (` (f2d (~ output)))
+      _       output)))
+
+(def: (with-mode-field-set mode class input)
+  (-> Primitive-Mode GenericType AST AST)
+  (case mode
+    #ManualPrM
+    input
+    
+    #AutoPrM
+    (case (simple-class$ (list) class)
+      "byte"  (` (l2b (~ input)))
+      "short" (` (l2s (~ input)))
+      "int"   (` (l2i (~ input)))
+      "float" (` (d2f (~ input)))
+      _       input)))
+
+(def: (member-def-interop type-params kind class [arg-lambda-inputs arg-method-inputs arg-classes arg-types] member method-prefix)
+  (-> (List TypeParam) ClassKind ClassDecl [(List AST) (List AST) (List Text) (List AST)] ImportMemberDecl Text (Lux (List AST)))
+  (let [[full-name class-tvars] class
+        all-params (|> (member-type-vars class-tvars member)
+                       (filter free-type-param?)
+                       (map type-param->type-arg))]
+    (case member
+      (#EnumDecl enum-members)
+      (do Monad
+        [#let [enum-type (: AST
+                            (case class-tvars
+                              #;Nil
+                              (` (host (~ (ast;symbol ["" full-name]))))
+
+                              _
+                              (let [=class-tvars (|> class-tvars
+                                                     (filter free-type-param?)
+                                                     (map type-param->type-arg))]
+                                (` (All [(~@ =class-tvars)] (host (~ (ast;symbol ["" full-name])) [(~@ =class-tvars)]))))))
+               getter-interop (: (-> Text AST)
+                                 (lambda [name]
+                                   (let [getter-name (ast;symbol ["" (format method-prefix member-separator name)])]
+                                     (` (def: (~ getter-name)
+                                          (~ enum-type)
+                                          (;_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" full-name ":" name)))] []))))))]]
+        (wrap (map getter-interop enum-members)))
+      
+      (#ConstructorDecl [commons _])
+      (do Monad
+        [return-type (member-def-return (get@ #import-member-mode commons) type-params class member)
+         #let [def-name (ast;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
+               def-params (list (ast;tuple arg-lambda-inputs))
+               jvm-interop (|> (` (;_lux_proc ["jvm" (~ (ast;text (format "new" ":" full-name ":" (text;join-with "," arg-classes))))]
+                                              [(~@ arg-method-inputs)]))
+                               (with-mode-inputs (get@ #import-member-mode commons)
+                                 (list;zip2 arg-classes arg-lambda-inputs)))
+               [return-type jvm-interop] (|> [return-type jvm-interop]
+                                             (decorate-return-maybe member)
+                                             (decorate-return-try member)
+                                             (decorate-return-io member))]]
+        (wrap (list (` (def: ((~ def-name) (~@ def-params))
+                         (All [(~@ all-params)] (-> [(~@ arg-types)] (~ return-type)))
+                         (~ jvm-interop))))))
+
+      (#MethodDecl [commons method])
+      (with-gensyms [g!obj]
+        (do @
+          [return-type (member-def-return (get@ #import-member-mode commons) type-params class member)
+           #let [def-name (ast;symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
+                 (^slots [#import-member-kind]) commons
+                 (^slots [#import-method-name]) method
+                 [jvm-op obj-ast class-ast] (: [Text (List AST) (List AST)]
+                                               (case import-member-kind
+                                                 #StaticIMK
+                                                 ["invokestatic"
+                                                  (list)
+                                                  (list)]
+
+                                                 #VirtualIMK
+                                                 (case kind
+                                                   #Class
+                                                   ["invokevirtual"
+                                                    (list g!obj)
+                                                    (list (class-decl-type$ class))]
+                                                   
+                                                   #Interface
+                                                   ["invokeinterface"
+                                                    (list g!obj)
+                                                    (list (class-decl-type$ class))]
+                                                   )))
+                 def-params (#;Cons (ast;tuple arg-lambda-inputs) obj-ast)
+                 def-param-types (#;Cons (` [(~@ arg-types)]) class-ast)
+                 jvm-interop (|> (` (;_lux_proc ["jvm" (~ (ast;text (format jvm-op ":" full-name ":" import-method-name
+                                                                            ":" (text;join-with "," arg-classes))))]
+                                                [(~@ obj-ast) (~@ arg-method-inputs)]))
+                                 (with-mode-output (get@ #import-member-mode commons)
+                                   (get@ #import-method-return method))
+                                 (with-mode-inputs (get@ #import-member-mode commons)
+                                   (list;zip2 arg-classes arg-lambda-inputs)))
+                 [return-type jvm-interop] (|> [return-type jvm-interop]
+                                               (decorate-return-maybe member)
+                                               (decorate-return-try member)
+                                               (decorate-return-io member))]]
+          (wrap (list (` (def: ((~ def-name) (~@ def-params))
+                           (All [(~@ all-params)] (-> (~@ def-param-types) (~ return-type)))
+                           (~ jvm-interop)))))))
+
+      (#FieldAccessDecl fad)
+      (do Monad
+        [#let [(^open) fad
+               base-gtype (class->type import-field-mode type-params import-field-type)
+               g!class (class-decl-type$ class)
+               g!type (if import-field-maybe?
+                        (` (Maybe (~ base-gtype)))
+                        base-gtype)
+               tvar-asts (: (List AST)
+                            (|> class-tvars
+                                (filter free-type-param?)
+                                (map type-param->type-arg)))
+               getter-name (ast;symbol ["" (format method-prefix member-separator import-field-name)])
+               setter-name (ast;symbol ["" (format method-prefix member-separator import-field-name "!")])]
+         getter-interop (with-gensyms [g!obj]
+                          (let [getter-call (if import-field-static?
+                                              getter-name
+                                              (` ((~ getter-name) (~ g!obj))))
+                                getter-type (if import-field-setter?
+                                              (` (IO (~ g!type)))
+                                              g!type)
+                                getter-type (if import-field-static?
+                                              getter-type
+                                              (` (-> (~ g!class) (~ getter-type))))
+                                getter-type (` (All [(~@ tvar-asts)] (~ getter-type)))
+                                getter-body (if import-field-static?
+                                              (with-mode-field-get import-field-mode import-field-type
+                                                (` (;_lux_proc ["jvm" (~ (ast;text (format "getstatic" ":" full-name ":" import-field-name)))] [])))
+                                              (with-mode-field-get import-field-mode import-field-type
+                                                (` (;_lux_proc ["jvm" (~ (ast;text (format "getfield" ":" full-name ":" import-field-name)))] [(~ g!obj)]))))
+                                getter-body (if import-field-maybe?
+                                              (` (??? (~ getter-body)))
+                                              getter-body)
+                                getter-body (if import-field-setter?
+                                              (` (io (~ getter-body)))
+                                              getter-body)]
+                            (wrap (` (def: (~ getter-call)
+                                       (~ getter-type)
+                                       (~ getter-body))))))
+         setter-interop (if import-field-setter?
+                          (with-gensyms [g!obj g!value]
+                            (let [setter-call (if import-field-static?
+                                                (` ((~ setter-name) (~ g!value)))
+                                                (` ((~ setter-name) (~ g!value) (~ g!obj))))
+                                  setter-type (if import-field-static?
+                                                (` (All [(~@ tvar-asts)] (-> (~ g!type) (IO Unit))))
+                                                (` (All [(~@ tvar-asts)] (-> (~ g!type) (~ g!class) (IO Unit)))))
+                                  setter-value (with-mode-field-set import-field-mode import-field-type g!value)
+                                  setter-value (if import-field-maybe?
+                                                 (` (!!! (~ setter-value)))
+                                                 setter-value)
+                                  setter-command (format (if import-field-static? "putstatic" "putfield")
+                                                         ":" full-name ":" import-field-name)]
+                              (wrap (: (List AST)
+                                       (list (` (def: (~ setter-call)
+                                                  (~ setter-type)
+                                                  (io (;_lux_proc ["jvm" (~ (ast;text setter-command))]
+                                                                  [(~ setter-value)])))))))))
+                          (wrap (list)))]
+        (wrap (list& getter-interop setter-interop)))
+      )))
+
+(def: (member-import$ type-params long-name? kind class member)
+  (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Lux (List AST)))
+  (let [[full-name _] class
+        method-prefix (if long-name?
+                        full-name
+                        (short-class-name full-name))]
+    (do Monad
+      [=args (member-def-arg-bindings type-params class member)]
+      (member-def-interop type-params kind class =args member method-prefix))))
+
+(def: (interface? class)
+  (All [a] (-> (host java.lang.Class [a]) Bool))
+  (_lux_proc ["jvm" "invokevirtual:java.lang.Class:isInterface:"] [class]))
+
+(def: (load-class class-name)
+  (-> Text (Either Text (host java.lang.Class [(Ex [a] a)])))
+  (try (_lux_proc ["jvm" "invokestatic:java.lang.Class:forName:java.lang.String"] [class-name])))
+
+(def: (class-kind [class-name _])
+  (-> ClassDecl (Lux ClassKind))
+  (case (load-class class-name)
+    (#;Right class)
+    (:: Monad wrap (if (interface? class)
+                          #Interface
+                          #Class))
+
+    (#;Left _)
+    (compiler;fail (format "Unknown class: " class-name))))
+
+(syntax: #export (jvm-import {#let [imports (class-imports *compiler*)]}
+                   {long-name? (s;tag? ["" "long"])}
+                   {class-decl (class-decl^ imports)}
+                   {#let [full-class-name (product;left class-decl)
+                          imports (add-import [(short-class-name full-class-name) full-class-name]
+                                              (class-imports *compiler*))]}
+                   {members (s;some (import-member-decl^ imports (product;right class-decl)))})
+  {#;doc (doc "Allows importing JVM classes, and using them as types."
+              "Their methods, fields and enum options can also be imported."
+              "Also, classes which get imported into a module can also be referred-to with their short names in other macros that require JVM classes."
+              "Examples:"
+              (jvm-import java.lang.Object
+                (new [] [])
+                (equals [] [Object] boolean)
+                (wait [] [int] #io #try void))
+              "Special options can also be given for the return values."
+              "#? means that the values will be returned inside a Maybe type. That way, null becomes #;None."
+              "#try means that the computation might throw an exception, and the return value will be wrapped by the Error type."
+              "#io means the computation has side effects, and will be wrapped by the IO type."
+              "These options must show up in the following order [#io #try #?] (although, each option can be used independently)."
+              (jvm-import java.lang.String
+                (new [] [(Array byte)])
+                (#static valueOf [] [char] String)
+                (#static valueOf #as int-valueOf [] [int] String))
+
+              (jvm-import #long (java.util.List e)
+                (size [] [] int)
+                (get [] [int] e))
+
+              (jvm-import (java.util.ArrayList a)
+                (toArray [T] [(Array T)] (Array T)))
+              "#long makes it so the class-type that is generated is of the fully-qualified name."
+              "In this case, it avoids a clash between the java.util.List type, and Lux's own List type."
+              (jvm-import java.lang.Character$UnicodeScript
+                (#enum ARABIC CYRILLIC LATIN))
+              "All enum options to be imported must be specified."
+
+              (jvm-import #long (lux.concurrency.promise.JvmPromise A)
+                (resolve [] [A] boolean)
+                (poll [] [] A)
+                (wasResolved [] [] boolean)
+                (waitOn [] [lux.Function] void)
+                (#static make [A] [A] (JvmPromise A)))
+              "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters."
+              "Lux types, such as Maybe can't be named (otherwise, they'd be confused for Java classes)."
+              
+              "Also, the names of the imported members will look like ClassName.MemberName."
+              "E.g.:"
+              (Object.new [])
+              (Object.equals [other-object] my-object)
+              (java.util.List.size [] my-list)
+              Character$UnicodeScript.LATIN
+              )}
+  (do Monad
+    [kind (class-kind class-decl)
+     =members (mapM @ (member-import$ (product;right class-decl) long-name? kind class-decl) members)]
+    (wrap (list& (class-import$ long-name? class-decl) (List/join =members)))))
+
+(syntax: #export (array {#let [imports (class-imports *compiler*)]}
+                        {type (generic-type^ imports (list))}
+                        size)
+  {#;doc (doc "Create an array of the given type, with the given size."
+              (array Object +10))}
+  (case type
+    (^template [ ]
+      (^ (#GenericClass  (list)))
+      (wrap (list (` (;_lux_proc ["jvm" ] [(~ size)])))))
+    (["boolean" "znewarray"]
+     ["byte"    "bnewarray"]
+     ["short"   "snewarray"]
+     ["int"     "inewarray"]
+     ["long"    "lnewarray"]
+     ["float"   "fnewarray"]
+     ["double"  "dnewarray"]
+     ["char"    "cnewarray"])
+
+    _
+    (wrap (list (` (;_lux_proc ["jvm" "anewarray"] [(~ (ast;text (generic-type$ type))) (~ size)]))))))
+
+(syntax: #export (array-length array)
+  {#;doc (doc "Gives the length of an array."
+              (array-length my-array))}
+  (wrap (list (` (;_lux_proc ["jvm" "arraylength"] [(~ array)])))))
+
+(def: (type->class-name type)
+  (-> Type (Lux Text))
+  (case type
+    (#;HostT name params)
+    (:: Monad wrap name)
+
+    (#;AppT F A)
+    (case (type;apply-type F A)
+      #;None
+      (compiler;fail (format "Can't apply type: " (type;type-to-text F) " to " (type;type-to-text A)))
+
+      (#;Some type')
+      (type->class-name type'))
+    
+    (#;NamedT _ type')
+    (type->class-name type')
+
+    #;UnitT
+    (:: Monad wrap "java.lang.Object")
+    
+    (^or #;VoidT (#;VarT _) (#;ExT _) (#;BoundT _) (#;SumT _) (#;ProdT _) (#;LambdaT _) (#;UnivQ _) (#;ExQ _))
+    (compiler;fail (format "Can't convert to JvmType: " (type;type-to-text type)))
+    ))
+
+(syntax: #export (array-load idx array)
+  {#;doc (doc "Loads an element from an array."
+              (array-load 10 my-array))}
+  (case array
+    [_ (#;SymbolS array-name)]
+    (do Monad
+      [array-type (compiler;find-type array-name)
+       array-jvm-type (type->class-name array-type)]
+      (case array-jvm-type
+        (^template [ ]
+          
+          (wrap (list (` (;_lux_proc ["jvm" ] [(~ array) (~ idx)])))))
+        (["[Z" "zaload"]
+         ["[B" "baload"]
+         ["[S" "saload"]
+         ["[I" "iaload"]
+         ["[J" "jaload"]
+         ["[F" "faload"]
+         ["[D" "daload"]
+         ["[C" "caload"])
+
+        _
+        (wrap (list (` (;_lux_proc ["jvm" "aaload"] [(~ array) (~ idx)]))))))
+
+    _
+    (with-gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (;;array-load (~ g!array) (~ idx)))))))))
+
+(syntax: #export (array-store idx value array)
+  {#;doc (doc "Stores an element into an array."
+              (array-store 10 my-object my-array))}
+  (case array
+    [_ (#;SymbolS array-name)]
+    (do Monad
+      [array-type (compiler;find-type array-name)
+       array-jvm-type (type->class-name array-type)]
+      (case array-jvm-type
+        (^template [ ]
+          
+          (wrap (list (` (;_lux_proc ["jvm" ] [(~ array) (~ idx) (~ value)])))))
+        (["[Z" "zastore"]
+         ["[B" "bastore"]
+         ["[S" "sastore"]
+         ["[I" "iastore"]
+         ["[J" "jastore"]
+         ["[F" "fastore"]
+         ["[D" "dastore"]
+         ["[C" "castore"])
+
+        _
+        (wrap (list (` (;_lux_proc ["jvm" "aastore"] [(~ array) (~ idx) (~ value)]))))))
+
+    _
+    (with-gensyms [g!array]
+      (wrap (list (` (let [(~ g!array) (~ array)]
+                       (;;array-store (~ g!array) (~ idx) (~ value)))))))))
+
+(def: simple-bindings^
+  (Syntax (List [Text AST]))
+  (s;tuple (s;some (s;seq s;local-symbol s;any))))
+
+(syntax: #export (with-open {bindings simple-bindings^} body)
+  {#;doc (doc "Creates a local-binding with the desired resources, and runs the body (assumed to be in the IO type)."
+              "Afterwards, closes all resources (assumed to be subclasses of java.io.Closeable), and returns the value resulting from running the body."
+              (with-open [my-res1 (res1-constructor ...)
+                          my-res2 (res1-constructor ...)]
+                (do Monad
+                  [foo (do-something my-res1)
+                   bar (do-something-else my-res2)]
+                  (do-one-last-thing foo bar))))}
+  (with-gensyms [g!output g!_]
+    (let [inits (List/join (List/map (lambda [[res-name res-ctor]]
+                                       (list (ast;symbol ["" res-name]) res-ctor))
+                                     bindings))
+          closes (List/map (lambda [res]
+                             (` (try (;_lux_proc ["jvm" "invokevirtual:java.io.Closeable:close:"]
+                                                 [(~ (ast;symbol ["" (product;left res)]))]))))
+                           bindings)]
+      (wrap (list (` (do Monad
+                       [(~@ inits)
+                        (~ g!output) (~ body)
+                        (~' #let) [(~ g!_) (exec (~@ (reverse closes)) [])]]
+                       ((~' wrap) (~ g!output)))))))))
+
+(syntax: #export (class-for {#let [imports (class-imports *compiler*)]}
+                            {type (generic-type^ imports (list))})
+  {#;doc (doc "Loads the class a a Class object."
+              (class-for java.lang.String))}
+  (wrap (list (` (;_lux_proc ["jvm" "load-class"] [(~ (ast;text (simple-class$ (list) type)))])))))
diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
new file mode 100644
index 000000000..654259d8d
--- /dev/null
+++ b/stdlib/source/lux/lexer.lux
@@ -0,0 +1,439 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  [lux #- not]
+  (lux (control functor
+                applicative
+                monad
+                codec)
+       (data [text "Text/" Eq]
+             text/format
+             [number "Int/" Codec]
+             [product]
+             [char "Char/" Ord]
+             maybe
+             error
+             (struct [list "" Functor]))
+       host))
+
+## [Types]
+(type: #export (Lexer a)
+  (-> Text (Error [Text a])))
+
+## [Structures]
+(struct: #export _ (Functor Lexer)
+  (def: (map f fa)
+    (lambda [input]
+      (case (fa input)
+        (#;Left msg)              (#;Left msg)
+        (#;Right [input' output]) (#;Right [input' (f output)])))))
+
+(struct: #export _ (Applicative Lexer)
+  (def: functor Functor)
+
+  (def: (wrap a)
+    (lambda [input]
+      (#;Right [input a])))
+
+  (def: (apply ff fa)
+    (lambda [input]
+      (case (ff input)
+        (#;Right [input' f])
+        (case (fa input')
+          (#;Right [input'' a])
+          (#;Right [input'' (f a)])
+
+          (#;Left msg)
+          (#;Left msg))
+
+        (#;Left msg)
+        (#;Left msg)))))
+
+(struct: #export _ (Monad Lexer)
+  (def: applicative Applicative)
+  
+  (def: (join mma)
+    (lambda [input]
+      (case (mma input)
+        (#;Left msg)          (#;Left msg)
+        (#;Right [input' ma]) (ma input'))))
+  )
+
+## [Values]
+## Runner
+(def: #export (run' lexer input)
+  (All [a] (-> (Lexer a) Text (Error [Text a])))
+  (lexer input))
+
+(def: #export (run lexer input)
+  (All [a] (-> (Lexer a) Text (Error a)))
+  (case (lexer input)
+    (#;Left msg)
+    (#;Left msg)
+    
+    (#;Right [input' output])
+    (#;Right output)
+    ))
+
+## Combinators
+(def: #export (fail message)
+  (All [a] (-> Text (Lexer a)))
+  (lambda [input]
+    (#;Left message)))
+
+(def: #export any
+  (Lexer Char)
+  (lambda [input]
+    (case [(text;at +0 input) (text;split +1 input)]
+      [(#;Some output) (#;Some [_ input'])]
+      (#;Right [input' output])
+
+      _
+      (#;Left "Can't parse character from empty text."))
+    ))
+
+(def: #export (seq left right)
+  (All [a b] (-> (Lexer a) (Lexer b) (Lexer [a b])))
+  (do Monad
+    [=left left
+     =right right]
+    (wrap [=left =right])))
+
+(def: #export (alt left right)
+  (All [a b] (-> (Lexer a) (Lexer b) (Lexer (| a b))))
+  (lambda [input]
+    (case (left input)
+      (#;Left msg)
+      (case (right input)
+        (#;Left msg)
+        (#;Left msg)
+
+        (#;Right [input' output])
+        (#;Right [input' (+1 output)]))
+
+      (#;Right [input' output])
+      (#;Right [input' (+0 output)]))))
+
+(def: #export (not! p)
+  (All [a] (-> (Lexer a) (Lexer Unit)))
+  (lambda [input]
+    (case (p input)
+      (#;Left msg)
+      (#;Right [input []])
+      
+      _
+      (#;Left "Expected to fail; yet succeeded."))))
+
+(def: #export (not p)
+  (All [a] (-> (Lexer a) (Lexer Char)))
+  (lambda [input]
+    (case (p input)
+      (#;Left msg)
+      (any input)
+      
+      _
+      (#;Left "Expected to fail; yet succeeded."))))
+
+(def: #export (either left right)
+  (All [a] (-> (Lexer a) (Lexer a) (Lexer a)))
+  (lambda [input]
+    (case (left input)
+      (#;Left msg)
+      (right input)
+
+      output
+      output)))
+
+(def: #export (assert test message)
+  (-> Bool Text (Lexer Unit))
+  (lambda [input]
+    (if test
+      (#;Right [input []])
+      (#;Left message))))
+
+(def: #export (some p)
+  (All [a] (-> (Lexer a) (Lexer (List a))))
+  (lambda [input]
+    (case (p input)
+      (#;Left msg)
+      (#;Right [input (list)])
+      
+      (#;Right [input' x])
+      (run' (do Monad
+              [xs (some p)]
+              (wrap (#;Cons x xs)))
+            input'))
+    ))
+
+(def: #export (many p)
+  (All [a] (-> (Lexer a) (Lexer (List a))))
+  (do Monad
+    [x p
+     xs (some p)]
+    (wrap (#;Cons x xs))))
+
+(def: #export (exactly n p)
+  (All [a] (-> Nat (Lexer a) (Lexer (List a))))
+  (if (>+ +0 n)
+    (do Monad
+      [x p
+       xs (exactly (dec+ n) p)]
+      (wrap (#;Cons x xs)))
+    (:: Monad wrap (list))))
+
+(def: #export (at-most n p)
+  (All [a] (-> Nat (Lexer a) (Lexer (List a))))
+  (if (>+ +0 n)
+    (lambda [input]
+      (case (p input)
+        (#;Left msg)
+        (#;Right [input (list)])
+
+        (#;Right [input' x])
+        (run' (do Monad
+                [xs (at-most (dec+ n) p)]
+                (wrap (#;Cons x xs)))
+              input')
+        ))
+    (:: Monad wrap (list))))
+
+(def: #export (at-least n p)
+  (All [a] (-> Nat (Lexer a) (Lexer (List a))))
+  (do Monad
+    [min-xs (exactly n p)
+     extras (some p)]
+    (wrap (list;concat (list min-xs extras)))))
+
+(def: #export (between from to p)
+  (All [a] (-> Nat Nat (Lexer a) (Lexer (List a))))
+  (do Monad
+    [min-xs (exactly from p)
+     max-xs (at-most (-+ from to) p)]
+    (wrap (list;concat (list min-xs max-xs)))))
+
+(def: #export (opt p)
+  (All [a] (-> (Lexer a) (Lexer (Maybe a))))
+  (lambda [input]
+    (case (p input)
+      (#;Left msg)
+      (#;Right [input #;None])
+
+      (#;Right [input value])
+      (#;Right [input (#;Some value)])
+      )))
+
+(def: #export (this text)
+  (-> Text (Lexer Text))
+  (lambda [input]
+    (if (text;starts-with? text input)
+      (case (text;split (text;size text) input)
+        #;None              (#;Left "")
+        (#;Some [_ input']) (#;Right [input' text]))
+      (#;Left (format "Invalid match: " text " @ " (:: text;Codec encode input))))
+    ))
+
+(def: #export (sep-by sep p)
+  (All [a b] (-> (Lexer b) (Lexer a) (Lexer (List a))))
+  (do Monad
+    [?x (opt p)]
+    (case ?x
+      #;None
+      (wrap #;Nil)
+      
+      (#;Some x)
+      (do @
+        [xs' (some (seq sep p))]
+        (wrap (#;Cons x (map product;right xs'))))
+      )))
+
+(def: #export end
+  (Lexer Unit)
+  (lambda [input]
+    (case input
+      "" (#;Right [input []])
+      _  (#;Left (format "The text input has not been fully consumed @ " (:: text;Codec encode input)))
+      )))
+
+(def: #export peek
+  (Lexer Char)
+  (lambda [input]
+    (case (text;at +0 input)
+      (#;Some output)
+      (#;Right [input output])
+
+      _
+      (#;Left "Can't peek character from empty text."))
+    ))
+
+(def: #export (this-char char)
+  (-> Char (Lexer Char))
+  (lambda [input]
+    (case [(text;at +0 input) (text;split +1 input)]
+      [(#;Some char') (#;Some [_ input'])]
+      (if (Char/= char char')
+        (#;Right [input' char])
+        (#;Left (format "Expected " (:: char;Codec encode char) " @ " (:: text;Codec encode input)
+                        " " (Int/encode (c2l char))" " (Int/encode (c2l [char'])))))
+
+      _
+      (#;Left "Can't parse character from empty text."))
+    ))
+
+(def: #export get-input
+  (Lexer Text)
+  (lambda [input]
+    (#;Right [input input])))
+
+(def: #export (char-range bottom top)
+  (-> Char Char (Lexer Char))
+  (do Monad
+    [input get-input
+     char any
+     _ (assert (and (Char/>= bottom char)
+                    (Char/<= top char))
+               (format "Character is not within range: " (:: char;Codec encode bottom) "-" (:: char;Codec encode top) " @ " (:: text;Codec encode input)))]
+    (wrap char)))
+
+(do-template [  ]
+  [(def: #export 
+     (Lexer Char)
+     (char-range  ))]
+
+  [upper     #"A" #"Z"]
+  [lower     #"a" #"z"]
+  [digit     #"0" #"9"]
+  [oct-digit #"0" #"7"]
+  )
+
+(def: #export alpha
+  (Lexer Char)
+  (either lower upper))
+
+(def: #export alpha-num
+  (Lexer Char)
+  (either alpha digit))
+
+(def: #export hex-digit
+  (Lexer Char)
+  ($_ either
+      digit
+      (char-range #"a" #"f")
+      (char-range #"A" #"F")))
+
+(def: #export (one-of options)
+  (-> Text (Lexer Char))
+  (lambda [input]
+    (case (text;split +1 input)
+      (#;Some [init input'])
+      (if (text;contains? init options)
+        (case (text;at +0 init)
+          (#;Some output)
+          (#;Right [input' output])
+
+          _
+          (#;Left ""))
+        (#;Left (format "Character (" init ") is not one of: " options " @ " (:: text;Codec encode input))))
+
+      _
+      (#;Left "Can't parse character from empty text."))))
+
+(def: #export (none-of options)
+  (-> Text (Lexer Char))
+  (lambda [input]
+    (case (text;split +1 input)
+      (#;Some [init input'])
+      (if (;not (text;contains? init options))
+        (case (text;at +0 init)
+          (#;Some output)
+          (#;Right [input' output])
+
+          _
+          (#;Left ""))
+        (#;Left (format "Character (" init ") is one of: " options " @ " (:: text;Codec encode input))))
+
+      _
+      (#;Left "Can't parse character from empty text."))))
+
+(def: #export (satisfies p)
+  (-> (-> Char Bool) (Lexer Char))
+  (lambda [input]
+    (case (: (Maybe [Text Char])
+             (do Monad
+               [[init input'] (text;split +1 input)
+                output (text;at +0 init)]
+               (wrap [input' output])))
+      (#;Some [input' output])
+      (if (p output)
+        (#;Right [input' output])
+        (#;Left (format "Character does not satisfy predicate: " (:: text;Codec encode input))))
+
+      _
+      (#;Left "Can't parse character from empty text."))))
+
+(def: #export space
+  (Lexer Char)
+  (satisfies char;space?))
+
+(def: #export (some' p)
+  (-> (Lexer Char) (Lexer Text))
+  (do Monad
+    [cs (some p)]
+    (wrap (text;concat (map char;as-text cs)))))
+
+(def: #export (many' p)
+  (-> (Lexer Char) (Lexer Text))
+  (do Monad
+    [cs (many p)]
+    (wrap (text;concat (map char;as-text cs)))))
+
+(def: #export end?
+  (Lexer Bool)
+  (lambda [input]
+    (#;Right [input (text;empty? input)])))
+
+(def: #export (_& left right)
+  (All [a b] (-> (Lexer a) (Lexer b) (Lexer b)))
+  (do Monad
+    [_ left]
+    right))
+
+(def: #export (&_ left right)
+  (All [a b] (-> (Lexer a) (Lexer b) (Lexer a)))
+  (do Monad
+    [output left
+     _ right]
+    (wrap output)))
+
+(def: #export (default value lexer)
+  (All [a] (-> a (Lexer a) (Lexer a)))
+  (lambda [input]
+    (case (lexer input)
+      (#;Left error)
+      (#;Right [input value])
+
+      (#;Right input'+value)
+      (#;Right input'+value))))
+
+(def: #export (codec codec lexer)
+  (All [a] (-> (Codec Text a) (Lexer Text) (Lexer a)))
+  (lambda [input]
+    (case (lexer input)
+      (#;Left error)
+      (#;Left error)
+
+      (#;Right [input' to-decode])
+      (case (:: codec decode to-decode)
+        (#;Left error)
+        (#;Left error)
+        
+        (#;Right value)
+        (#;Right [input' value])))))
+
+(def: #export (enclosed [start end] lexer)
+  (All [a] (-> [Text Text] (Lexer a) (Lexer a)))
+  (_& (this start)
+      (&_ lexer
+          (this end))))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
new file mode 100644
index 000000000..7c192cb2b
--- /dev/null
+++ b/stdlib/source/lux/macro.lux
@@ -0,0 +1,31 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data (struct [list "List/" Monad])
+             text/format)
+       [compiler]
+       (macro ["s" syntax #+ syntax: Syntax])))
+
+(def: omit^
+  (Syntax Bool)
+  (s;tag? ["" "omit"]))
+
+(do-template [ ]
+  [(syntax: #export ( {? omit^} token)
+     (do @
+       [output ( token)
+        #let [_ (List/map (. log! %ast)
+                          output)]]
+       (if ?
+         (wrap (list))
+         (wrap output))))]
+
+  [expand      compiler;macro-expand]
+  [expand-all  compiler;macro-expand-all]
+  [expand-once compiler;macro-expand-once]
+  )
diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/ast.lux
new file mode 100644
index 000000000..cc1cffa5f
--- /dev/null
+++ b/stdlib/source/lux/macro/ast.lux
@@ -0,0 +1,149 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control eq)
+       (data bool
+             number
+             [char]
+             [text #+ Eq "Text/" Monoid]
+             ident
+             (struct [list #* "" Functor Fold])
+             )))
+
+## [Types]
+## (type: (AST' w)
+##   (#;BoolS Bool)
+##   (#;NatS Nat)
+##   (#;IntS Int)
+##   (#;RealS Real)
+##   (#;CharS Char)
+##   (#;TextS Text)
+##   (#;SymbolS Text Text)
+##   (#;TagS Text Text)
+##   (#;FormS (List (w (AST' w))))
+##   (#;TupleS (List (w (AST' w))))
+##   (#;RecordS (List [(w (AST' w)) (w (AST' w))])))
+
+## (type: AST
+##   (Meta Cursor (AST' (Meta Cursor))))
+
+## [Utils]
+(def: _cursor Cursor ["" -1 -1])
+
+## [Functions]
+(do-template [  ]
+  [(def: #export ( x)
+     (->  AST)
+     [_cursor ( x)])]
+  
+  [bool   Bool             #;BoolS]
+  [nat    Nat              #;NatS]
+  [int    Int              #;IntS]
+  [frac   Frac             #;FracS]
+  [real   Real             #;RealS]
+  [char   Char             #;CharS]
+  [text   Text             #;TextS]
+  [symbol Ident            #;SymbolS]
+  [tag    Ident            #;TagS]
+  [form   (List AST)       #;FormS]
+  [tuple  (List AST)       #;TupleS]
+  [record (List [AST AST]) #;RecordS]
+  )
+
+(do-template [ ]
+  [(def: #export ( name)
+     (-> Text AST)
+     [_cursor ( ["" name])])]
+
+  [local-symbol #;SymbolS]
+  [local-tag    #;TagS])
+
+## [Structures]
+(struct: #export _ (Eq AST)
+  (def: (= x y)
+    (case [x y]
+      (^template [ ]
+       [[_ ( x')] [_ ( y')]]
+       (::  = x' y'))
+      ([#;BoolS   Eq]
+       [#;NatS    Eq]
+       [#;IntS    Eq]
+       [#;FracS   Eq]
+       [#;RealS   Eq]
+       [#;CharS   char;Eq]
+       [#;TextS   Eq]
+       [#;SymbolS Eq]
+       [#;TagS    Eq])
+
+      (^template []
+       [[_ ( xs')] [_ ( ys')]]
+       (and (:: Eq = (size xs') (size ys'))
+            (fold (lambda [[x' y'] old]
+                    (and old (= x' y')))
+                  true
+                  (zip2 xs' ys'))))
+      ([#;FormS]
+       [#;TupleS])
+
+      [[_ (#;RecordS xs')] [_ (#;RecordS ys')]]
+      (and (:: Eq = (size xs') (size ys'))
+           (fold (lambda [[[xl' xr'] [yl' yr']] old]
+                   (and old (= xl' yl') (= xr' yr')))
+                 true
+                 (zip2 xs' ys')))
+      
+      _
+      false)))
+
+## [Values]
+(def: #export (ast-to-text ast)
+  (-> AST Text)
+  (case ast
+    (^template [ ]
+     [_ ( value)]
+     (::  encode value))
+    ([#;BoolS   Codec]
+     [#;NatS    Codec]
+     [#;IntS    Codec]
+     [#;FracS   Codec]
+     [#;RealS   Codec]
+     [#;CharS   char;Codec]
+     [#;TextS   text;Codec]
+     [#;SymbolS Codec])
+
+    [_ (#;TagS ident)]
+    (Text/append  "#" (:: Codec encode ident))
+
+    (^template [  ]
+     [_ ( members)]
+     ($_ Text/append  (|> members (map ast-to-text) (interpose " ") (text;join-with "")) ))
+    ([#;FormS  "(" ")"]
+     [#;TupleS "[" "]"])
+
+    [_ (#;RecordS pairs)]
+    ($_ Text/append "{" (|> pairs (map (lambda [[left right]] ($_ Text/append (ast-to-text left) " " (ast-to-text right)))) (interpose " ") (text;join-with "")) "}")
+    ))
+
+(def: #export (replace source target ast)
+  (-> AST AST AST AST)
+  (if (:: Eq = source ast)
+    target
+    (case ast
+      (^template []
+       [cursor ( parts)]
+       [cursor ( (map (replace source target) parts))])
+      ([#;FormS]
+       [#;TupleS])
+
+      [cursor (#;RecordS parts)]
+      [cursor (#;RecordS (map (lambda [[left right]]
+                                [(replace source target left)
+                                 (replace source target right)])
+                              parts))]
+
+      _
+      ast)))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
new file mode 100644
index 000000000..ac7043f26
--- /dev/null
+++ b/stdlib/source/lux/macro/poly.lux
@@ -0,0 +1,364 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  [lux #- list]
+  (lux (control monad
+                [eq])
+       (data [text]
+             text/format
+             (struct [list "List/" Monad]
+                     [dict #+ Dict])
+             [number]
+             [product]
+             [bool]
+             [char]
+             [maybe])
+       [compiler #+ Monad with-gensyms]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax]
+              (syntax [common]))
+       [type]
+       ))
+
+## [Types]
+(type: #export (Matcher a)
+  (-> Type (Lux a)))
+
+(type: #export Env (Dict Nat AST))
+
+## [Combinators]
+(do-template [ ]
+  [(def: #export 
+     (Matcher Unit)
+     (lambda [:type:]
+       (case (type;un-alias :type:)
+         (#;NamedT ["lux" ] _)
+         (:: compiler;Monad wrap [])
+
+         _
+         (compiler;fail (format "Not "  " type: " (type;type-to-text :type:))))))]
+
+  [unit "Unit"]
+  [bool "Bool"]
+  [nat  "Nat"]
+  [int  "Int"]
+  [frac "Frac"]
+  [real "Real"]
+  [char "Char"]
+  [text "Text"]
+  )
+
+(def: #export primitive
+  (Matcher Type)
+  (lambda [:type:]
+    (let% [ (do-template [ ]
+                          [(do Monad
+                             [_ ( :type:)]
+                             (wrap ))]
+
+                          [bool Bool]
+                          [nat  Nat]
+                          [int  Int]
+                          [frac Frac]
+                          [real Real]
+                          [char Char]
+                          [text Text])]
+      ($_ compiler;either
+          ))))
+
+(syntax: ($AST$ ast)
+  (wrap (;list (ast;text (ast;ast-to-text ast)))))
+
+(do-template [   ]
+  [(def: #export 
+     (Matcher [Type Type])
+     (lambda [:type:]
+       (case (type;un-name :type:)
+         ( :left: :right:)
+         (:: compiler;Monad wrap [:left: :right:])
+
+         _
+         (compiler;fail (format "Not a " ($AST$ ) " type: " (type;type-to-text :type:))))))
+
+   (def: #export 
+     (Matcher (List Type))
+     (lambda [:type:]
+       (let [members ( (type;un-name :type:))]
+         (if (>+ +1 (list;size members))
+           (:: compiler;Monad wrap members)
+           (compiler;fail (format "Not a " ($AST$ ) " type: " (type;type-to-text :type:)))))))]
+
+  [sum    sum+    type;flatten-sum      #;SumT]
+  [prod   prod+   type;flatten-prod     #;ProdT]
+  )
+
+(def: #export func
+  (Matcher [Type Type])
+  (lambda [:type:]
+    (case (type;un-name :type:)
+      (#;LambdaT :left: :right:)
+      (:: compiler;Monad wrap [:left: :right:])
+
+      _
+      (compiler;fail (format "Not a LambdaT type: " (type;type-to-text :type:))))))
+
+(def: #export func+
+  (Matcher [(List Type) Type])
+  (lambda [:type:]
+    (let [[ins out] (type;flatten-function (type;un-name :type:))]
+      (if (>+ +0 (list;size ins))
+        (:: compiler;Monad wrap [ins out])
+        (compiler;fail (format "Not a LambdaT type: " (type;type-to-text :type:)))))))
+
+(def: #export tagged
+  (Matcher [(List Ident) Type])
+  (lambda [:type:]
+    (case (type;un-alias :type:)
+      (#;NamedT type-name :def:)
+      (do compiler;Monad
+        [tags (compiler;tags-of type-name)]
+        (wrap [tags :def:]))
+
+      _
+      (compiler;fail (format "Unnamed types can't have tags: " (type;type-to-text :type:))))))
+
+(def: #export polymorphic
+  (Matcher [(List AST) Type])
+  (lambda [:type:]
+    (loop [:type: (type;un-name :type:)]
+      (case :type:
+        (#;UnivQ _ :type:')
+        (do compiler;Monad
+          [[g!tail :type:''] (recur :type:')
+           g!head (compiler;gensym "type-var")]
+          (wrap [(list& g!head g!tail)
+                 :type:'']))
+
+        _
+        (:: compiler;Monad wrap [(;list) :type:])))))
+
+(do-template [ ]
+  [(def: #export 
+     (Matcher [(List AST) (List [Ident Type])])
+     (lambda [:type:]
+       (do compiler;Monad
+         [[tags :type:] (tagged :type:)
+          _ (compiler;assert (>+ +0 (list;size tags)) "Records and variants must have tags.")
+          [vars :type:] (polymorphic :type:)
+          members ( :type:)]
+         (wrap [vars (list;zip2 tags members)]))))]
+
+  [variant sum+]
+  [record  prod+]
+  )
+
+(def: #export tuple
+  (Matcher [(List AST) (List Type)])
+  (lambda [:type:]
+    (do compiler;Monad
+      [[vars :type:] (polymorphic :type:)
+       members (prod+ :type:)]
+      (wrap [vars members]))))
+
+(def: #export function
+  (Matcher [(List AST) [(List Type) Type]])
+  (lambda [:type:]
+    (do compiler;Monad
+      [[vars :type:] (polymorphic :type:)
+       ins+out (func+ :type:)]
+      (wrap [vars ins+out]))))
+
+(def: #export apply
+  (Matcher [Type (List Type)])
+  (lambda [:type:]
+    (do compiler;Monad
+      [#let [[:func: :args:] (loop [:type: (type;un-name :type:)]
+                               (case :type:
+                                 (#;AppT :func: :arg:)
+                                 (let [[:func:' :args:] (recur :func:)]
+                                   [:func:' (list& :arg: :args:)])
+
+                                 _
+                                 [:type: (;list)]))]]
+      (case :args:
+        #;Nil
+        (compiler;fail "Not a type application.")
+
+        _
+        (wrap [:func: (list;reverse :args:)])))))
+
+(do-template [ ]
+  [(def: #export 
+     (Matcher Type)
+     (lambda [:type:]
+       (case (type;un-name :type:)
+         (^=> (#;AppT :quant: :arg:)
+              {(type;un-alias :quant:) (#;NamedT ["lux" ] _)})
+         (:: compiler;Monad wrap :arg:)
+
+         _
+         (compiler;fail (format "Not "  " type: " (type;type-to-text :type:))))))]
+
+  [maybe "Maybe"]
+  [list  "List"]
+  )
+
+(def: (adjusted-idx env idx)
+  (-> Env Nat Nat)
+  (let [env-level (/+ +2 (dict;size env))
+        bound-level (/+ +2 idx)
+        bound-idx (%+ +2 idx)]
+    (|> env-level dec+ (-+ bound-level) (*+ +2) (++ bound-idx))))
+
+(def: #export (bound env)
+  (-> Env (Matcher AST))
+  (lambda [:type:]
+    (case :type:
+      (#;BoundT idx)
+      (case (dict;get (adjusted-idx env idx) env)
+        (#;Some poly-val)
+        (:: compiler;Monad wrap poly-val)
+
+        #;None
+        (compiler;fail (format "Unknown bound type: " (type;type-to-text :type:))))
+
+      _
+      (compiler;fail (format "Not a bound type: " (type;type-to-text :type:))))))
+
+(def: #export (var env var-id)
+  (-> Env Nat (Matcher Unit))
+  (lambda [:type:]
+    (case :type:
+      (^=> (#;BoundT idx)
+           (=+ var-id (adjusted-idx env idx)))
+      (:: compiler;Monad wrap [])
+
+      _
+      (compiler;fail (format "Not a bound type: " (type;type-to-text :type:))))))
+
+(def: #export (recur env)
+  (-> Env (Matcher Unit))
+  (lambda [:type:]
+    (do Monad
+      [[t-fun t-args] (apply :type:)]
+      (loop [base +0
+             :parts: (list& t-fun t-args)]
+        (case :parts:
+          #;Nil
+          (wrap [])
+          
+          (^=> (#;Cons (#;BoundT idx) :parts:')
+               {(adjusted-idx env idx)
+                idx'}
+               (=+ base idx'))
+          (recur (inc+ base) :parts:')
+
+          _
+          (compiler;fail (format "Type is not a recursive instance: " (type;type-to-text :type:)))))
+      )))
+
+## [Syntax]
+(def: #export (extend-env type-func type-vars env)
+  (-> AST (List AST) Env Env)
+  (case type-vars
+    #;Nil
+    env
+    
+    (#;Cons tvar type-vars')
+    (let [current-size (dict;size env)]
+      (|> env
+          (dict;put current-size type-func)
+          (dict;put (inc+ current-size) tvar)
+          (extend-env (` (#;AppT (~ type-func) (~ tvar))) type-vars')
+          ))))
+
+(syntax: #export (poly: {_ex-lev common;export-level}
+                   {[name env inputs] (s;form ($_ s;seq
+                                                  s;local-symbol
+                                                  s;local-symbol
+                                                  (s;many s;local-symbol)))}
+                   body)
+  (with-gensyms [g!body]
+    (let [g!inputs (List/map (|>. [""] ast;symbol) inputs)
+          g!name (ast;symbol ["" name])
+          g!env (ast;symbol ["" env])]
+      (wrap (;list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ g!name) (~@ (List/map (lambda [g!input] (` {(~ g!input) s;symbol}))
+                                                                                                g!inputs)))
+                        (do Monad
+                          [(~@ (List/join (List/map (lambda [g!input] (;list g!input (` (compiler;find-type-def (~ g!input)))))
+                                                    g!inputs)))
+                           (~' #let) [(~ g!env) (: Env (dict;new number;Hash))]
+                           (~ g!body) (: (Lux AST)
+                                         (loop [(~ g!env) (~ g!env)
+                                                (~@ (List/join (List/map (lambda [g!input] (;list g!input g!input))
+                                                                         g!inputs)))]
+                                           (let [(~ g!name) (~' recur)]
+                                             (~ body))))]
+                          ((~' wrap) (;list (~ g!body)))))))))))
+
+(def: (common-poly-name? poly-func)
+  (-> Text Bool)
+  (and (text;starts-with? "|" poly-func)
+       (text;ends-with? "|" poly-func)))
+
+(def: (derivation-name poly args)
+  (-> Text (List Text) (Maybe Text))
+  (if (common-poly-name? poly)
+    (case (text;sub +1 (dec+ (text;size poly)) poly)
+      (#;Some clean-poly)
+      (case (list;reverse args)
+        #;Nil
+        #;None
+
+        (#;Cons type #;Nil)
+        (#;Some (format type "/" clean-poly))
+
+        (#;Cons type args)
+        (#;Some (format type "/" clean-poly "@" (|> args list;reverse (text;join-with ",")))))
+      
+      #;None
+      #;None)
+    #;None))
+
+(syntax: #export (derived: {_ex-lev common;export-level}
+                   {?name (s;opt s;local-symbol)}
+                   {[poly-func poly-args] (s;either (s;form (s;seq s;symbol (s;many s;symbol)))
+                                                    (s;seq s;symbol (:: @ wrap (;list))))}
+                   {?custom-impl (s;opt s;any)})
+  (do @
+    [name (case ?name
+            (#;Some name)
+            (wrap name)
+
+            (^=> #;None
+                 {(derivation-name (product;right poly-func) (List/map product;right poly-args))
+                  (#;Some derived-name)})
+            (wrap derived-name)
+
+            _
+            (compiler;fail "derived: was given no explicit name, and can't generate one from given information."))
+     #let [impl (case ?custom-impl
+                  (#;Some custom-impl)
+                  custom-impl
+
+                  #;None
+                  (` ((~ (ast;symbol poly-func)) (~@ (List/map ast;symbol poly-args)))))]]
+    (wrap (;list (` (def: (~@ (common;gen-export-level _ex-lev))
+                      (~ (ast;symbol ["" name]))
+                      (~ impl)))))))
+
+## [Derivers]
+(def: #export (gen-type converter type-fun tvars type)
+  (-> (-> AST AST) AST (List AST) Type AST)
+  (let [type' (type;type-to-ast type)]
+    (case tvars
+      #;Nil
+      (converter type')
+
+      _
+      (` (All (~ type-fun) [(~@ tvars)]
+           (-> (~@ (List/map converter tvars))
+               (~ (converter (` ((~ type') (~@ tvars)))))))))))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
new file mode 100644
index 000000000..b0506c5ed
--- /dev/null
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -0,0 +1,103 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                [eq])
+       (data [text]
+             text/format
+             (struct [list "List/" Monad]
+                     [dict #+ Dict])
+             [number]
+             [product]
+             [bool]
+             [char]
+             [maybe])
+       [compiler #+ Monad with-gensyms]
+       (macro [ast]
+              [syntax #+ syntax: Syntax]
+              (syntax [common])
+              [poly #+ poly:])
+       [type]
+       ))
+
+## [Derivers]
+(poly: #export (|Eq| env :x:)
+  (let [->Eq (: (-> AST AST)
+                (lambda [.type.] (` (eq;Eq (~ .type.)))))]
+    (let% [ (do-template [  ]
+                     [(do @
+                        [_ ( :x:)]
+                        (wrap (` (: (~ (->Eq (` )))
+                                    ))))]
+
+                     [Unit poly;unit (lambda [(~' test) (~' input)] true)]
+                     [Bool poly;bool bool;Eq]
+                     [Nat  poly;nat  number;Eq]
+                     [Int  poly;int  number;Eq]
+                     [Frac poly;frac number;Eq]
+                     [Real poly;real number;Eq]
+                     [Char poly;char char;Eq]
+                     [Text poly;text text;Eq])]
+      ($_ compiler;either
+          ## Primitive types
+          
+          ## Variants
+          (with-gensyms [g!type-fun g!left g!right]
+            (do @
+              [[g!vars cases] (poly;variant :x:)
+               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               pattern-matching (mapM @
+                                      (lambda [[name :case:]]
+                                        (do @
+                                          [encoder (|Eq| new-env :case:)]
+                                          (wrap (list (` [((~ (ast;tag name)) (~ g!left))
+                                                          ((~ (ast;tag name)) (~ g!right))])
+                                                      (` ((~ encoder) (~ g!left) (~ g!right)))))))
+                                      cases)]
+              (wrap (` (: (~ (poly;gen-type ->Eq g!type-fun g!vars :x:))
+                          (lambda [(~@ g!vars)]
+                            (lambda [(~ g!left) (~ g!right)]
+                              (case [(~ g!left) (~ g!right)]
+                                (~@ (List/join pattern-matching)))))
+                          )))))
+          ## Tuples
+          (with-gensyms [g!type-fun g!left g!right]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               pattern-matching (mapM @
+                                      (lambda [:member:]
+                                        (do @
+                                          [g!left (compiler;gensym "g!left")
+                                           g!right (compiler;gensym "g!right")
+                                           encoder (|Eq| new-env :member:)]
+                                          (wrap [g!left g!right encoder])))
+                                      members)
+               #let [.left. (` [(~@ (List/map product;left pattern-matching))])
+                     .right. (` [(~@ (List/map (|>. product;right product;left) pattern-matching))])]]
+              (wrap (` (: (~ (poly;gen-type ->Eq g!type-fun g!vars :x:))
+                          (lambda [(~@ g!vars)]
+                            (lambda [(~ g!left) (~ g!right)]
+                              (case [(~ g!left) (~ g!right)]
+                                [(~ .left.) (~ .right.)]
+                                (;;array (list (~@ (List/map (lambda [[g!left g!right g!encoder]]
+                                                               (` ((~ g!encoder) (~ g!left) (~ g!right))))
+                                                             pattern-matching)))))))
+                          )))
+              ))
+          ## Type applications
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (|Eq| env :func:)
+             .args. (mapM @ (|Eq| env) :args:)]
+            (wrap (` (: (~ (->Eq (type;type-to-ast :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          ## Bound type-vars
+          (poly;bound env :x:)
+          ## If all else fails...
+          (compiler;fail (format "Can't create Eq for: " (type;type-to-text :x:)))
+          ))))
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
new file mode 100644
index 000000000..78b668f2c
--- /dev/null
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -0,0 +1,126 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                [functor])
+       (data [text]
+             text/format
+             (struct [list "List/" Monad]
+                     [dict #+ Dict])
+             [number]
+             [product]
+             [bool]
+             [char]
+             [maybe]
+             [ident "Ident/" Codec]
+             error)
+       [compiler #+ Monad with-gensyms]
+       (macro [ast]
+              [syntax #+ syntax: Syntax]
+              (syntax [common])
+              [poly #+ poly:])
+       [type]
+       ))
+
+## [Derivers]
+(poly: #export (|Functor| env :x:)
+  (with-gensyms [g!type-fun g!func g!input]
+    (do @
+      [#let [g!map (' map)]
+       [g!vars _] (poly;polymorphic :x:)
+       #let [num-vars (list;size g!vars)
+             new-env (poly;extend-env g!type-fun g!vars env)]
+       _ (compiler;assert (>+ +0 num-vars)
+                      "Functors must have at least 1 type-variable.")]
+      (let [->Functor (: (-> AST AST)
+                         (lambda [.type.] (` (functor;Functor (~ .type.)))))
+            |elem| (: (-> AST (poly;Matcher AST))
+                      (lambda |elem| [value :type:]
+                        ($_ compiler;either
+                            ## Nothing to do.
+                            (do @
+                              [_ (poly;primitive :type:)]
+                              (wrap value))
+                            ## Type-var
+                            (do @
+                              [_ (poly;var new-env (dec+ num-vars) :type:)]
+                              (wrap (` ((~ g!func) (~ value)))))
+                            ## Tuples/records
+                            (do @
+                              [[g!vars members] (poly;tuple :x:)
+                               pm (mapM @
+                                        (lambda [:slot:]
+                                          (do @
+                                            [g!slot (compiler;gensym "g!slot")
+                                             body (|elem| g!slot :slot:)]
+                                            (wrap [g!slot body])))
+                                        members)]
+                              (wrap (` (case (~ g!input)
+                                         [(~@ (List/map product;left pm))]
+                                         [(~@ (List/map product;right pm))])
+                                       )))
+                            ## Recursion
+                            (do @
+                              [_ (poly;recur new-env :type:)]
+                              (wrap (` ((~ g!map) (~ g!func) (~ value)))))
+                            )))]
+        ($_ compiler;either
+            ## Variants
+            (do @
+              [[g!vars cases] (poly;variant :x:)
+               pattern-matching (mapM @
+                                      (lambda [[name :case:]]
+                                        (do @
+                                          [#let [analysis (` ((~ (ast;tag name)) (~ g!input)))]
+                                           synthesis (|elem| g!input :case:)]
+                                          (wrap (list analysis
+                                                      synthesis))))
+                                      cases)]
+              (wrap (` (: (~ (->Functor (type;type-to-ast :x:)))
+                          (struct (def: ((~ g!map) (~ g!func) (~ g!input))
+                                    (case (~ g!input)
+                                      (~@ (List/join pattern-matching)))))
+                          ))))
+            ## Tuples/Records
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               pm (mapM @
+                        (lambda [:slot:]
+                          (do @
+                            [g!slot (compiler;gensym "g!slot")
+                             body (|elem| g!slot :slot:)]
+                            (wrap [g!slot body])))
+                        members)]
+              (wrap (` (: (~ (->Functor (type;type-to-ast :x:)))
+                          (struct (def: ((~ g!map) (~ g!func) (~ g!input))
+                                    (case (~ g!input)
+                                      [(~@ (List/map product;left pm))]
+                                      [(~@ (List/map product;right pm))])))
+                          ))))
+            ## Functions
+            (with-gensyms [g!out]
+              (do @
+                [[g!vars [:ins: :out:]] (poly;function :x:)
+                 .out. (|elem| g!out :out:)
+                 g!ins (seqM @
+                             (list;repeat (list;size :ins:)
+                                          (compiler;gensym "g!arg")))]
+                (wrap (` (: (~ (->Functor (type;type-to-ast :x:)))
+                            (struct (def: ((~ g!map) (~ g!func) (~ g!input))
+                                      (lambda [(~@ g!ins)]
+                                        (let [(~ g!out) ((~ g!input) (~@ g!ins))]
+                                          (~ .out.))))))))))
+            ## No structure (as you'd expect from Identity)
+            (do @
+              [_ (poly;var new-env (dec+ num-vars) :x:)]
+              (wrap (` (: (~ (->Functor (type;type-to-ast :x:)))
+                          (struct (def: ((~ g!map) (~ g!func) (~ g!input))
+                                    ((~ g!func) (~ g!input))))))))
+            ## Failure...
+            (compiler;fail (format "Can't create Functor for: " (type;type-to-text :x:)))
+            ))
+      )))
diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux
new file mode 100644
index 000000000..49d06daf4
--- /dev/null
+++ b/stdlib/source/lux/macro/poly/text-encoder.lux
@@ -0,0 +1,126 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                [codec])
+       (data [text]
+             text/format
+             (struct [list "List/" Monad]
+                     [dict #+ Dict])
+             [number]
+             [product]
+             [bool]
+             [char]
+             [maybe]
+             [ident "Ident/" Codec]
+             error)
+       [compiler #+ Monad with-gensyms]
+       (macro [ast]
+              [syntax #+ syntax: Syntax]
+              (syntax [common])
+              [poly #+ poly:])
+       [type]
+       ))
+
+## [Derivers]
+(poly: #export (|Codec@Text//encode| env :x:)
+  (let [->Codec//encode (: (-> AST AST)
+                           (lambda [.type.] (` (-> (~ .type.) Text))))]
+    (let% [ (do-template [  ]
+                     [(do @
+                        [_ ( :x:)]
+                        (wrap (` (: (~ (->Codec//encode (` )))
+                                    (~' )))))]
+
+                     [Unit poly;unit (lambda [_0] "[]")]
+                     [Bool poly;bool (:: bool;Codec encode)]
+                     [Nat  poly;nat  (:: number;Codec encode)]
+                     [Int  poly;int  (:: number;Codec encode)]
+                     [Frac poly;frac (:: number;Codec encode)]
+                     [Real poly;real (:: number;Codec encode)]
+                     [Char poly;char (:: char;Codec encode)]
+                     [Text poly;text (:: text;Codec encode)])]
+      ($_ compiler;either
+          ## Primitives
+          
+          ## Variants
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars cases] (poly;variant :x:)
+               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               pattern-matching (mapM @
+                                      (lambda [[name :case:]]
+                                        (do @
+                                          [encoder (|Codec@Text//encode| new-env :case:)]
+                                          (wrap (list (` ((~ (ast;tag name)) (~ g!case)))
+                                                      (` (format "(#"
+                                                                 (~ (ast;text (Ident/encode name)))
+                                                                 " "
+                                                                 ((~ encoder) (~ g!case))
+                                                                 ")"))))))
+                                      cases)]
+              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
+                          (lambda [(~@ g!vars)]
+                            (lambda [(~ g!input)]
+                              (case (~ g!input)
+                                (~@ (List/join pattern-matching)))))
+                          )))))
+          ## Records
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars slots] (poly;record :x:)
+               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               synthesis (mapM @
+                               (lambda [[name :slot:]]
+                                 (do @
+                                   [encoder (|Codec@Text//encode| new-env :slot:)]
+                                   (wrap (` (format "#"
+                                                    (~ (ast;text (Ident/encode name)))
+                                                    " "
+                                                    ((~ encoder) (get@ (~ (ast;tag name)) (~ g!input))))))))
+                               slots)]
+              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
+                          (lambda [(~@ g!vars)]
+                            (lambda [(~ g!input)]
+                              (format "{" (~@ (list;interpose (' " ") synthesis)) "}")))
+                          )))))
+          ## Tuples
+          (with-gensyms [g!type-fun g!case g!input]
+            (do @
+              [[g!vars members] (poly;tuple :x:)
+               #let [new-env (poly;extend-env g!type-fun g!vars env)]
+               parts (mapM @
+                           (lambda [:member:]
+                             (do @
+                               [g!member (compiler;gensym "g!member")
+                                encoder (|Codec@Text//encode| new-env :member:)]
+                               (wrap [g!member encoder])))
+                           members)
+               #let [analysis (` [(~@ (List/map product;left parts))])
+                     synthesis (List/map (lambda [[g!member g!encoder]]
+                                           (` ((~ g!encoder) (~ g!member))))
+                                         parts)]]
+              (wrap (` (: (~ (poly;gen-type ->Codec//encode g!type-fun g!vars :x:))
+                          (lambda [(~@ g!vars)]
+                            (lambda [(~ g!input)]
+                              (case (~ g!input)
+                                (~ analysis)
+                                (format "[" (~@ (list;interpose (' " ") synthesis)) "]"))))
+                          )))
+              ))
+          ## Type applications
+          (do @
+            [[:func: :args:] (poly;apply :x:)
+             .func. (|Codec@Text//encode| env :func:)
+             .args. (mapM @ (|Codec@Text//encode| env) :args:)]
+            (wrap (` (: (~ (->Codec//encode (type;type-to-ast :x:)))
+                        ((~ .func.) (~@ .args.))))))
+          ## Bound type-variables
+          (poly;bound env :x:)
+          ## Failure...
+          (compiler;fail (format "Can't create Text encoder for: " (type;type-to-text :x:)))
+          ))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
new file mode 100644
index 000000000..367dc10b6
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -0,0 +1,472 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  [lux #- not default]
+  (lux [compiler #+ Monad with-gensyms]
+       (control functor
+                applicative
+                monad
+                eq)
+       (data [bool]
+             [char]
+             [number]
+             [text "Text/" Monoid]
+             [ident]
+             (struct [list #* "" Functor Fold "List/" Monoid])
+             [product]
+             error))
+  (.. [ast]))
+
+## [Utils]
+(def: (join-pairs pairs)
+  (All [a] (-> (List [a a]) (List a)))
+  (case pairs
+    #;Nil                   #;Nil
+    (#;Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))
+
+## [Types]
+(type: #export (Syntax a)
+  (-> (List AST) (Error [(List AST) a])))
+
+## [Structures]
+(struct: #export _ (Functor Syntax)
+  (def: (map f ma)
+    (lambda [tokens]
+      (case (ma tokens)
+        (#;Left msg)
+        (#;Left msg)
+
+        (#;Right [tokens' a])
+        (#;Right [tokens' (f a)])))))
+
+(struct: #export _ (Applicative Syntax)
+  (def: functor Functor)
+
+  (def: (wrap x tokens)
+    (#;Right [tokens x]))
+
+  (def: (apply ff fa)
+    (lambda [tokens]
+      (case (ff tokens)
+        (#;Right [tokens' f])
+        (case (fa tokens')
+          (#;Right [tokens'' a])
+          (#;Right [tokens'' (f a)])
+
+          (#;Left msg)
+          (#;Left msg))
+
+        (#;Left msg)
+        (#;Left msg)))))
+
+(struct: #export _ (Monad Syntax)
+  (def: applicative Applicative)
+
+  (def: (join mma)
+    (lambda [tokens]
+      (case (mma tokens)
+        (#;Left msg)
+        (#;Left msg)
+
+        (#;Right [tokens' ma])
+        (ma tokens')))))
+
+## [Utils]
+(def: (remaining-inputs asts)
+  (-> (List AST) Text)
+  ($_ Text/append " | Remaining input: "
+      (|> asts (map ast;ast-to-text) (interpose " ") (text;join-with ""))))
+
+## [Syntaxs]
+(def: #export any
+  {#;doc "Just returns the next input without applying any logic."}
+  (Syntax AST)
+  (lambda [tokens]
+    (case tokens
+      #;Nil                (#;Left "There are no tokens to parse!")
+      (#;Cons [t tokens']) (#;Right [tokens' t]))))
+
+(do-template [      ]
+  [(def: #export 
+     (Syntax )
+     (lambda [tokens]
+       (case tokens
+         (#;Cons [[_ ( x)] tokens'])
+         (#;Right [tokens' x])
+
+         _
+         (#;Left ($_ Text/append "Can't parse "  (remaining-inputs tokens))))))
+
+   (def: #export ( v)
+     (->  (Syntax Bool))
+     (lambda [tokens]
+       (case tokens
+         (#;Cons [[_ ( x)] tokens'])
+         (let [is-it? (::  = v x)
+               remaining (if is-it?
+                           tokens'
+                           tokens)]
+           (#;Right [remaining is-it?]))
+
+         _
+         (#;Right [tokens false]))))
+
+   (def: #export ( v)
+     (->  (Syntax Unit))
+     (lambda [tokens]
+       (case tokens
+         (#;Cons [[_ ( x)] tokens'])
+         (if (::  = v x)
+           (#;Right [tokens' []])
+           (#;Left ($_ Text/append "Expected a "  " but instead got " (ast;ast-to-text [_ ( x)]) (remaining-inputs tokens))))
+
+         _
+         (#;Left ($_ Text/append "Can't parse "  (remaining-inputs tokens))))))]
+
+  [  bool   bool?   bool!  Bool   #;BoolS   bool;Eq "bool"]
+  [   nat    nat?    nat!   Nat    #;NatS  number;Eq "nat"]
+  [   int    int?    int!   Int    #;IntS  number;Eq "int"]
+  [  real   real?   real!  Real   #;RealS number;Eq "real"]
+  [  char   char?   char!  Char   #;CharS   char;Eq "char"]
+  [  text   text?   text!  Text   #;TextS   text;Eq "text"]
+  [symbol symbol? symbol! Ident #;SymbolS ident;Eq "symbol"]
+  [   tag    tag?    tag! Ident    #;TagS ident;Eq "tag"]
+  )
+
+(def: #export (assert v message)
+  (-> Bool Text (Syntax Unit))
+  (lambda [tokens]
+    (if v
+      (#;Right [tokens []])
+      (#;Left ($_ Text/append message (remaining-inputs tokens))))))
+
+(do-template [  ]
+  [(def: #export 
+     (Syntax Int)
+     (do Monad
+       [n int
+        _ (assert ( 0 n) )]
+       (wrap n)))]
+
+  [pos-int > "Expected a positive integer: N > 0"]
+  [neg-int < "Expected a negative integer: N < 0"]
+  )
+
+(do-template [  ]
+  [(def: #export 
+     (Syntax Text)
+     (lambda [tokens]
+       (case tokens
+         (#;Cons [[_ ( ["" x])] tokens'])
+         (#;Right [tokens' x])
+
+         _
+         (#;Left ($_ Text/append "Can't parse "  (remaining-inputs tokens))))))]
+
+  [local-symbol #;SymbolS "local symbol"]
+  [   local-tag #;TagS    "local tag"]
+  )
+
+(do-template [  ]
+  [(def: #export ( p)
+     (All [a]
+       (-> (Syntax a) (Syntax a)))
+     (lambda [tokens]
+       (case tokens
+         (#;Cons [[_ ( members)] tokens'])
+         (case (p members)
+           (#;Right [#;Nil x]) (#;Right [tokens' x])
+           _                   (#;Left ($_ Text/append "Syntax was expected to fully consume "  (remaining-inputs tokens))))
+
+         _
+         (#;Left ($_ Text/append "Can't parse "  (remaining-inputs tokens))))))]
+
+  [ form  #;FormS "form"]
+  [tuple #;TupleS "tuple"]
+  )
+
+(def: #export (record p)
+  (All [a]
+    (-> (Syntax a) (Syntax a)))
+  (lambda [tokens]
+    (case tokens
+      (#;Cons [[_ (#;RecordS pairs)] tokens'])
+      (case (p (join-pairs pairs))
+        (#;Right [#;Nil x]) (#;Right [tokens' x])
+        _                   (#;Left ($_ Text/append "Syntax was expected to fully consume record" (remaining-inputs tokens))))
+
+      _
+      (#;Left ($_ Text/append "Can't parse record" (remaining-inputs tokens))))))
+
+(def: #export (opt p)
+  {#;doc "Optionality combinator."}
+  (All [a]
+    (-> (Syntax a) (Syntax (Maybe a))))
+  (lambda [tokens]
+    (case (p tokens)
+      (#;Left _)            (#;Right [tokens #;None])
+      (#;Right [tokens' x]) (#;Right [tokens' (#;Some x)]))))
+
+(def: #export (run tokens p)
+  (All [a]
+    (-> (List AST) (Syntax a) (Error [(List AST) a])))
+  (p tokens))
+
+(def: #export (some p)
+  {#;doc "0-or-more combinator."}
+  (All [a]
+    (-> (Syntax a) (Syntax (List a))))
+  (lambda [tokens]
+    (case (p tokens)
+      (#;Left _)            (#;Right [tokens (list)])
+      (#;Right [tokens' x]) (run tokens'
+                                 (do Monad
+                                   [xs (some p)]
+                                   (wrap (list& x xs)))
+                                 ))))
+
+(def: #export (many p)
+  {#;doc "1-or-more combinator."}
+  (All [a]
+    (-> (Syntax a) (Syntax (List a))))
+  (do Monad
+    [x p
+     xs (some p)]
+    (wrap (list& x xs))))
+
+(def: #export (seq p1 p2)
+  {#;doc "Sequencing combinator."}
+  (All [a b]
+    (-> (Syntax a) (Syntax b) (Syntax [a b])))
+  (do Monad
+    [x1 p1
+     x2 p2]
+    (wrap [x1 x2])))
+
+(def: #export (alt p1 p2)
+  {#;doc "Heterogeneous alternative combinator."}
+  (All [a b]
+    (-> (Syntax a) (Syntax b) (Syntax (| a b))))
+  (lambda [tokens]
+    (case (p1 tokens)
+      (#;Right [tokens' x1]) (#;Right [tokens' (+0 x1)])
+      (#;Left _)             (run tokens
+                                  (do Monad
+                                    [x2 p2]
+                                    (wrap (+1 x2))))
+      )))
+
+(def: #export (either pl pr)
+  {#;doc "Homogeneous alternative combinator."}
+  (All [a]
+    (-> (Syntax a) (Syntax a) (Syntax a)))
+  (lambda [tokens]
+    (case (pl tokens)
+      (#;Left _) (pr tokens)
+      output     output
+      )))
+
+(def: #export end
+  {#;doc "Ensures there are no more inputs."}
+  (Syntax Unit)
+  (lambda [tokens]
+    (case tokens
+      #;Nil (#;Right [tokens []])
+      _     (#;Left ($_ Text/append "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
+
+(def: #export end?
+  {#;doc "Checks whether there are no more inputs."}
+  (Syntax Bool)
+  (lambda [tokens]
+    (case tokens
+      #;Nil (#;Right [tokens true])
+      _     (#;Right [tokens false]))))
+
+(def: #export (exactly n p)
+  (All [a] (-> Nat (Syntax a) (Syntax (List a))))
+  (if (>+ +0 n)
+    (do Monad
+      [x p
+       xs (exactly (dec+ n) p)]
+      (wrap (#;Cons x xs)))
+    (:: Monad wrap (list))))
+
+(def: #export (at-least n p)
+  (All [a] (-> Nat (Syntax a) (Syntax (List a))))
+  (do Monad
+    [min (exactly n p)
+     extra (some p)]
+    (wrap (List/append min extra))))
+
+(def: #export (at-most n p)
+  (All [a] (-> Nat (Syntax a) (Syntax (List a))))
+  (if (>+ +0 n)
+    (lambda [input]
+      (case (p input)
+        (#;Left msg)
+        (#;Right [input (list)])
+
+        (#;Right [input' x])
+        (run input'
+             (do Monad
+               [xs (at-most (dec+ n) p)]
+               (wrap (#;Cons x xs))))
+        ))
+    (:: Monad wrap (list))))
+
+(def: #export (between from to p)
+  (All [a] (-> Nat Nat (Syntax a) (Syntax (List a))))
+  (do Monad
+    [min-xs (exactly from p)
+     max-xs (at-most (-+ from to) p)]
+    (wrap (:: Monad join (list min-xs max-xs)))))
+
+(def: #export (sep-by sep p)
+  {#;doc "Parsers instances of 'p' that are separated by instances of 'sep'."}
+  (All [a b] (-> (Syntax b) (Syntax a) (Syntax (List a))))
+  (do Monad
+    [?x (opt p)]
+    (case ?x
+      #;None
+      (wrap #;Nil)
+      
+      (#;Some x)
+      (do @
+        [xs' (some (seq sep p))]
+        (wrap (#;Cons x (map product;right xs'))))
+      )))
+
+(def: #export (not p)
+  (All [a] (-> (Syntax a) (Syntax Unit)))
+  (lambda [input]
+    (case (p input)
+      (#;Left msg)
+      (#;Right [input []])
+      
+      _
+      (#;Left "Expected to fail; yet succeeded."))))
+
+(def: #export (fail message)
+  (All [a] (-> Text (Syntax a)))
+  (lambda [input]
+    (#;Left message)))
+
+(def: #export (default value parser)
+  {#;doc "If the given parser fails, returns the default value."}
+  (All [a] (-> a (Syntax a) (Syntax a)))
+  (lambda [input]
+    (case (parser input)
+      (#;Left error)
+      (#;Right [input value])
+
+      (#;Right [input' output])
+      (#;Right [input' output]))))
+
+(def: #export (on compiler meta)
+  (All [a] (-> Compiler (Lux a) (Syntax a)))
+  (lambda [input]
+    (case (meta compiler)
+      (#;Left error)
+      (#;Left error)
+
+      (#;Right [_ value])
+      (#;Right [input value])
+      )))
+
+(def: #export (local local-inputs syntax)
+  (All [a] (-> (List AST) (Syntax a) (Syntax a)))
+  (lambda [real-inputs]
+    (case (syntax local-inputs)
+      (#;Left error)
+      (#;Left error)
+
+      (#;Right [unconsume-inputs value])
+      (case unconsume-inputs
+        #;Nil
+        (#;Right [real-inputs value])
+
+        _
+        (#;Left "Unconsumed inputs.")))))
+
+## [Syntax]
+(def: #hidden text.join-with text;join-with)
+
+(macro: #export (syntax: tokens)
+  {#;doc (doc "A more advanced way to define macros than macro:."
+              "The inputs to the macro can be parsed in complex ways through the use of syntax parsers."
+              "The macro body is also (implicitly) run in the Monad, to save some typing."
+              "Also, the compiler state can be accessed through the *compiler* binding."
+              (syntax: #export (object [#let [imports (class-imports *compiler*)]]
+                                 [#let [class-vars (list)]]
+                                 [super (opt (super-class-decl^ imports class-vars))]
+                                 [interfaces (tuple (some (super-class-decl^ imports class-vars)))]
+                                 [constructor-args (constructor-args^ imports class-vars)]
+                                 [methods (some (overriden-method-def^ imports))])
+                (let [def-code ($_ Text/append "anon-class:"
+                                   (spaced (list (super-class-decl$ (;default object-super-class super))
+                                                 (with-brackets (spaced (map super-class-decl$ interfaces)))
+                                                 (with-brackets (spaced (map constructor-arg$ constructor-args)))
+                                                 (with-brackets (spaced (map (method-def$ id) methods))))))]
+                  (wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] [])))))))}
+  (let [[exported? tokens] (case tokens
+                             (^ (list& [_ (#;TagS ["" "export"])] tokens'))
+                             [true tokens']
+
+                             _
+                             [false tokens])
+        ?parts (: (Maybe [Text (List AST) AST AST])
+                  (case tokens
+                    (^ (list [_ (#;FormS (list& [_ (#;SymbolS ["" name])] args))]
+                             body))
+                    (#;Some name args (` {}) body)
+
+                    (^ (list [_ (#;FormS (list& [_ (#;SymbolS ["" name])] args))]
+                             meta-data
+                             body))
+                    (#;Some name args meta-data body)
+
+                    _
+                    #;None))]
+    (case ?parts
+      (#;Some [name args meta body])
+      (with-gensyms [g!tokens g!body g!msg]
+        (do Monad
+          [vars+parsers (mapM Monad
+                              (: (-> AST (Lux [AST AST]))
+                                 (lambda [arg]
+                                   (case arg
+                                     (^ [_ (#;RecordS (list [var parser]))])
+                                     (wrap [var parser])
+
+                                     [_ (#;SymbolS var-name)]
+                                     (wrap [(ast;symbol var-name) (` any)])
+
+                                     _
+                                     (compiler;fail "Syntax pattern expects records or symbols."))))
+                              args)
+           #let [g!state (ast;symbol ["" "*compiler*"])
+                 g!end (ast;symbol ["" ""])
+                 error-msg (ast;text (Text/append "Wrong syntax for " name))
+                 export-ast (: (List AST) (if exported? (list (' #export)) (list)))]]
+          (wrap (list (` (macro: (~@ export-ast) ((~ (ast;symbol ["" name])) (~ g!tokens))
+                           (~ meta)
+                           (lambda [(~ g!state)]
+                             (;_lux_case (run (~ g!tokens)
+                                              (: (Syntax (Lux (List AST)))
+                                                 (do Monad
+                                                   [(~@ (join-pairs vars+parsers))
+                                                    (~ g!end) end]
+                                                   ((~' wrap) (do Monad
+                                                                []
+                                                                (~ body))))))
+                               (#;Right [(~ g!tokens) (~ g!body)])
+                               ((~ g!body) (~ g!state))
+
+                               (#;Left (~ g!msg))
+                               (#;Left (text.join-with ": " (list (~ error-msg) (~ g!msg))))))))))))
+      
+      _
+      (compiler;fail "Wrong syntax for syntax:"))))
diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux
new file mode 100644
index 000000000..743768fe6
--- /dev/null
+++ b/stdlib/source/lux/macro/syntax/common.lux
@@ -0,0 +1,164 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data (struct [list])
+             text/format)
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## Exports
+(type: #export Export-Level
+  #Exported
+  #Hidden)
+
+(def: #export export-level
+  (Syntax (Maybe Export-Level))
+  (s;opt (s;alt (s;tag! ["" "export"])
+                (s;tag! ["" "hidden"]))))
+
+(def: #export (gen-export-level ?el)
+  (-> (Maybe Export-Level) (List AST))
+  (case ?el
+    #;None
+    (list)
+
+    (#;Some #Exported)
+    (list (' #export))
+
+    (#;Some #Hidden)
+    (list (' #hidden))))
+
+## Declarations
+(type: #export Decl
+  {#decl-name Text
+   #decl-args (List Text)})
+
+(def: #export decl
+  (s;either (s;seq s;local-symbol
+                   (:: s;Monad wrap (list)))
+            (s;form (s;seq s;local-symbol
+                           (s;many s;local-symbol)))))
+
+## Definitions
+(type: #export Def-Syntax
+  {#def-name Text
+   #def-type (Maybe AST)
+   #def-value AST
+   #def-meta (List [Ident AST])
+   #def-args (List Text)
+   })
+
+(def: check^
+  (Syntax [(Maybe AST) AST])
+  (s;either (s;form (do s;Monad
+                      [_ (s;symbol! ["lux" "_lux_:"])
+                       type s;any
+                       value s;any]
+                      (wrap [(#;Some type) value])))
+            (s;seq (:: s;Monad wrap #;None)
+                   s;any)))
+
+(def: _def-meta-tag^
+  (Syntax Ident)
+  (s;tuple (s;seq s;text s;text)))
+
+(def: (_def-meta^ _)
+  (-> Top (Syntax (List [Ident AST])))
+  (s;alt (s;tag! ["lux" "Nil"])
+         (s;form (do s;Monad
+                   [_ (s;tag! ["lux" "Cons"])
+                    [head tail] (s;seq (s;tuple (s;seq _def-meta-tag^ s;any))
+                                       (_def-meta^ []))]
+                   (wrap [head tail])))
+         ))
+
+(def: (flat-list^ _)
+  (-> Top (Syntax (List AST)))
+  (s;either (do s;Monad
+              [_ (s;tag! ["lux" "Nil"])]
+              (wrap (list)))
+            (s;form (do s;Monad
+                      [_ (s;tag! ["lux" "Cons"])
+                       [head tail] (s;tuple (s;seq s;any s;any))
+                       tail (s;local (list tail) (flat-list^ []))]
+                      (wrap (#;Cons head tail))))))
+
+(def: list-meta^
+  (Syntax (List AST))
+  (s;form (do s;Monad
+            [_ (s;tag! ["lux" "ListM"])]
+            (flat-list^ []))))
+
+(def: text-meta^
+  (Syntax Text)
+  (s;form (do s;Monad
+            [_ (s;tag! ["lux" "TextM"])]
+            s;text)))
+
+(def: (find-def-args meta-data)
+  (-> (List [Ident AST]) (List Text))
+  (default (list)
+    (list;find (lambda [[tag value]]
+                 (case tag
+                   (^=> ["lux" "func-args"]
+                        {(s;run (list value) list-meta^)
+                         (#;Right [_ args])}
+                        {(s;run args (s;some text-meta^))
+                         (#;Right [_ args])})
+                   (#;Some args)
+
+                   _
+                   #;None))
+               meta-data)))
+
+(def: #export (def compiler)
+  (-> Compiler (Syntax Def-Syntax))
+  (do s;Monad
+    [def-raw s;any
+     me-def-raw (s;on compiler
+                      (compiler;macro-expand-all def-raw))]
+    (s;local me-def-raw
+             (s;form (do @
+                       [_ (s;symbol! ["lux" "_lux_def"])
+                        def-name s;local-symbol
+                        [?def-type def-value] check^
+                        def-meta s;any
+                        def-meta (s;local (list def-meta)
+                                          (_def-meta^ []))
+                        #let [def-args (find-def-args def-meta)]]
+                       (wrap {#def-name def-name
+                              #def-type ?def-type
+                              #def-meta def-meta
+                              #def-value def-value
+                              #def-args def-args}))))))
+
+(def: #export (typed-de compiler)
+  (-> Compiler (Syntax Def-Syntax))
+  (do s;Monad
+    [_def (def compiler)
+     _ (case (get@ #def-type _def)
+         (#;Some _)
+         (wrap [])
+
+         #;None
+         (s;fail "Typed def must have a type!")
+         )]
+    (wrap _def)))
+
+(def: #export def-meta
+  (Syntax (List [Ident AST]))
+  (s;record (s;some (s;seq s;tag s;any))))
+
+(def: #export typed-arg
+  (Syntax [Text AST])
+  (s;record (s;seq s;local-symbol s;any)))
+
+(def: #export type-params
+  (Syntax (List Text))
+  (s;tuple (s;some s;local-symbol)))
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
new file mode 100644
index 000000000..0288f05cf
--- /dev/null
+++ b/stdlib/source/lux/macro/template.lux
@@ -0,0 +1,54 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data (struct [list "" Monad Fold]
+                     [dict #+ Dict])
+             [text])
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax]
+              (syntax [common]))))
+
+## [Syntax]
+(def: decl^
+  (Syntax [Text (List Text)])
+  (s;form (s;seq s;local-symbol (s;many s;local-symbol))))
+
+(def: (prepare bindings template)
+  (-> (Dict Text AST) AST AST)
+  (case template
+    (^=> [_ (#;SymbolS "" name)]
+         {(dict;get name bindings) (#;Some found)})
+    found
+    
+    (^template []
+      [meta ( parts)]
+      [meta ( (map (prepare bindings ) parts))])
+    ([#;FormS]
+     [#;TupleS])
+
+    
+    [meta (#;RecordS pairs)]
+    [meta (#;RecordS (map (lambda [[slot value]]
+                            [(prepare bindings slot)
+                             (prepare bindings value)])
+                          pairs))]
+
+    _
+    template
+    ))
+
+(syntax: #export (template: {_ex-lev common;export-level} {[name args] decl^} template)
+  (let [bindings (fold (lambda [arg bindings]
+                         (dict;put arg (` ((~' ~) (~ (ast;symbol ["" arg])))) bindings))
+                       (: (Dict Text AST) (dict;new text;Hash))
+                       args)]
+    (wrap (list (` (syntax: (~@ (common;gen-export-level _ex-lev)) ((~ (ast;symbol ["" name]))
+                                                                (~@ (map (|>. [""] ast;symbol) args)))
+                     ((~' wrap) (list (` (~ (prepare bindings template)))))))))
+    ))
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
new file mode 100644
index 000000000..ffc13818f
--- /dev/null
+++ b/stdlib/source/lux/math.lux
@@ -0,0 +1,158 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module: {#;doc "Common numerical operations."}
+  lux
+  (lux (control monad)
+       (data (struct [list "" Fold])
+             [number "Int/" Number]
+             [product]
+             text/format)
+       host
+       [compiler]
+       (macro ["s" syntax #+ syntax: Syntax "Syntax/" Functor]
+              [ast])))
+
+## [Values]
+(do-template [ ]
+  [(def: #export 
+     Real
+     (_lux_proc ["jvm" ] []))]
+
+  [e  "getstatic:java.lang.Math:E"]
+  [pi "getstatic:java.lang.Math:PI"]
+  )
+
+(def: #export tau Real 6.28318530717958647692)
+
+(do-template [ ]
+  [(def: #export ( n)
+     (-> Real Real)
+     (_lux_proc ["jvm" ] [n]))]
+
+  [cos   "invokestatic:java.lang.Math:cos:double"]
+  [sin   "invokestatic:java.lang.Math:sin:double"]
+  [tan   "invokestatic:java.lang.Math:tan:double"]
+
+  [acos  "invokestatic:java.lang.Math:acos:double"]
+  [asin  "invokestatic:java.lang.Math:asin:double"]
+  [atan  "invokestatic:java.lang.Math:atan:double"]
+  
+  [cosh  "invokestatic:java.lang.Math:cosh:double"]
+  [sinh  "invokestatic:java.lang.Math:sinh:double"]
+  [tanh  "invokestatic:java.lang.Math:tanh:double"]
+
+  [exp   "invokestatic:java.lang.Math:exp:double"]
+  [log   "invokestatic:java.lang.Math:log:double"]
+  
+  [cbrt  "invokestatic:java.lang.Math:cbrt:double"]
+  [sqrt  "invokestatic:java.lang.Math:sqrt:double"]
+
+  [degrees "invokestatic:java.lang.Math:toDegrees:double"]
+  [radians "invokestatic:java.lang.Math:toRadians:double"]
+  )
+
+(do-template [ ]
+  [(def: #export ( n)
+     (-> Real Real)
+     (_lux_proc ["jvm" ] [n]))]
+
+  [ceil  "invokestatic:java.lang.Math:ceil:double"]
+  [floor "invokestatic:java.lang.Math:floor:double"]
+  )
+
+(def: #export (round n)
+  (-> Real Real)
+  (int-to-real (_lux_proc ["jvm" "invokestatic:java.lang.Math:round:double"] [n])))
+
+(do-template [ ]
+  [(def: #export ( param subject)
+     (-> Real Real Real)
+     (_lux_proc ["jvm" ] [subject param]))]
+
+  [atan2 "invokestatic:java.lang.Math:atan2:double,double"]
+  [pow   "invokestatic:java.lang.Math:pow:double,double"]
+  )
+
+(def: (gcd' a b)
+  (-> Int Int Int)
+  (case b
+    0 a
+    _ (gcd' b (% b a))))
+
+(def: #export (gcd a b)
+  {#;doc "Greatest Common Divisor."}
+  (-> Int Int Int)
+  (gcd' (Int/abs a) (Int/abs b)))
+
+(def: #export (lcm x y)
+  {#;doc "Least Common Multiple."}
+  (-> Int Int Int)
+  (case [x y]
+    (^or [_ 0] [0 _])
+    0
+
+    _
+    (|> x (/ (gcd x y)) (* y) Int/abs)
+    ))
+
+## [Syntax]
+(type: #rec Infix
+  (#Const AST)
+  (#Call (List AST))
+  (#Infix Infix AST Infix))
+
+(def: (infix^ _)
+  (-> Unit (Syntax Infix))
+  ($_ s;alt
+      ($_ s;either
+          (Syntax/map ast;bool s;bool)
+          (Syntax/map ast;int s;int)
+          (Syntax/map ast;real s;real)
+          (Syntax/map ast;char s;char)
+          (Syntax/map ast;text s;text)
+          (Syntax/map ast;symbol s;symbol)
+          (Syntax/map ast;tag s;tag))
+      (s;form (s;many s;any))
+      (s;tuple (s;either (do s;Monad
+                           [_ (s;tag! ["" "and"])
+                            init-subject (infix^ [])
+                            init-op s;any
+                            init-param (infix^ [])
+                            steps (s;some (s;seq s;any (infix^ [])))]
+                           (wrap (product;right (fold (lambda [[op param] [subject [_subject _op _param]]]
+                                                        [param [(#Infix _subject _op _param)
+                                                                (` and)
+                                                                (#Infix subject op param)]])
+                                                      [init-param [init-subject init-op init-param]]
+                                                      steps))))
+                         (do s;Monad
+                           [_ (wrap [])
+                            init-subject (infix^ [])
+                            init-op s;any
+                            init-param (infix^ [])
+                            steps (s;some (s;seq s;any (infix^ [])))]
+                           (wrap (fold (lambda [[op param] [_subject _op _param]]
+                                         [(#Infix _subject _op _param) op param])
+                                       [init-subject init-op init-param]
+                                       steps)))
+                         ))
+      ))
+
+(def: (infix-to-prefix infix)
+  (-> Infix AST)
+  (case infix
+    (#Const value)
+    value
+    
+    (#Call parts)
+    (ast;form parts)
+    
+    (#Infix left op right)
+    (` ((~ op) (~ (infix-to-prefix right)) (~ (infix-to-prefix left))))
+    ))
+
+(syntax: #export (infix {expr (infix^ [])})
+  (wrap (list (infix-to-prefix expr))))
diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux
new file mode 100644
index 000000000..eb7796bb2
--- /dev/null
+++ b/stdlib/source/lux/math/complex.lux
@@ -0,0 +1,291 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux [math]
+       (control eq
+                [ord]
+                number
+                codec
+                monad)
+       (data [number "r:" Number Codec]
+             [text "Text/" Monoid]
+             error
+             maybe
+             (struct [list "List/" Monad]))
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## Based on org.apache.commons.math4.complex.Complex
+
+(type: #export Complex
+  {#real Real
+   #imaginary Real})
+
+(syntax: #export (complex real {?imaginary (s;opt s;any)})
+  (wrap (list (` {#;;real (~ real)
+                  #;;imaginary (~ (default (` 0.0)
+                                    ?imaginary))}))))
+
+(def: #export i Complex (complex 0.0 1.0))
+
+(def: #export one Complex (complex 1.0 0.0))
+
+(def: #export zero Complex (complex 0.0 0.0))
+
+(def: #export (c= param input)
+  (-> Complex Complex Bool)
+  (and (=. (get@ #real param)
+           (get@ #real input))
+       (=. (get@ #imaginary param)
+           (get@ #imaginary input))))
+
+(do-template [ ]
+  [(def: #export ( param input)
+     (-> Complex Complex Complex)
+     {#real ( (get@ #real param)
+                  (get@ #real input))
+      #imaginary ( (get@ #imaginary param)
+                       (get@ #imaginary input))})]
+
+  [c+ +.]
+  [c- -.]
+  )
+
+(struct: #export _ (Eq Complex)
+  (def: = c=))
+
+(def: #export negate
+  (-> Complex Complex)
+  (|>. (update@ #real r:negate)
+       (update@ #imaginary r:negate)))
+
+(def: #export signum
+  (-> Complex Complex)
+  (|>. (update@ #real r:signum)
+       (update@ #imaginary r:signum)))
+
+(def: #export conjugate
+  (-> Complex Complex)
+  (update@ #imaginary r:negate))
+
+(def: #export (c*' param input)
+  (-> Real Complex Complex)
+  {#real (*. param
+             (get@ #real input))
+   #imaginary (*. param
+                  (get@ #imaginary input))})
+
+(def: #export (c* param input)
+  (-> Complex Complex Complex)
+  {#real (-. (*. (get@ #imaginary param)
+                 (get@ #imaginary input))
+             (*. (get@ #real param)
+                 (get@ #real input)))
+   #imaginary (+. (*. (get@ #real param)
+                      (get@ #imaginary input))
+                  (*. (get@ #imaginary param)
+                      (get@ #real input)))})
+
+(def: #export (c/ (^slots [#real #imaginary]) input)
+  (-> Complex Complex Complex)
+  (if (<. (r:abs imaginary)
+          (r:abs real))
+    (let [quot (/. imaginary real)
+          denom (|> real (*. quot) (+. imaginary))]
+      {#real (|> (get@ #real input) (*. quot) (+. (get@ #imaginary input)) (/. denom))
+       #imaginary (|> (get@ #imaginary input) (*. quot) (-. (get@ #real input)) (/. denom))})
+    (let [quot (/. real imaginary)
+          denom (|> imaginary (*. quot) (+. real))]
+      {#real (|> (get@ #imaginary input) (*. quot) (+. (get@ #real input)) (/. denom))
+       #imaginary (|> (get@ #imaginary input) (-. (*. quot (get@ #real input))) (/. denom))})))
+
+(def: #export (c/' param (^slots [#real #imaginary]))
+  (-> Real Complex Complex)
+  {#real (/. param real)
+   #imaginary (/. param imaginary)})
+
+(def: #export (cos (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  {#real (*. (math;cosh imaginary)
+             (math;cos real))
+   #imaginary (*. (math;sinh imaginary)
+                  (r:negate (math;sin real)))})
+
+(def: #export (cosh (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  {#real (*. (math;cos imaginary)
+             (math;cosh real))
+   #imaginary (*. (math;sin imaginary)
+                  (math;sinh real))})
+
+(def: #export (sin (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  {#real (*. (math;cosh imaginary)
+             (math;sin real))
+   #imaginary (*. (math;sinh imaginary)
+                  (math;cos real))})
+
+(def: #export (sinh (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  {#real (*. (math;cos imaginary)
+             (math;sinh real))
+   #imaginary (*. (math;sin imaginary)
+                  (math;cosh real))})
+
+(def: #export (tan (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  (let [r2 (*. 2.0 real)
+        i2 (*. 2.0 imaginary)
+        d (+. (math;cos r2) (math;cosh i2))]
+    {#real (/. d (math;sin r2))
+     #imaginary (/. d (math;sinh i2))}))
+
+(def: #export (tanh (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  (let [r2 (*. 2.0 real)
+        i2 (*. 2.0 imaginary)
+        d (+. (math;cosh r2) (math;cos i2))]
+    {#real (/. d (math;sinh r2))
+     #imaginary (/. d (math;sin i2))}))
+
+(def: #export (abs (^slots [#real #imaginary]))
+  (-> Complex Real)
+  (if (<. (r:abs imaginary)
+          (r:abs real))
+    (if (=. 0.0 imaginary)
+      (r:abs real)
+      (let [q (/. imaginary real)]
+        (*. (math;sqrt (+. 1.0 (*. q q)))
+            (r:abs imaginary))))
+    (if (=. 0.0 real)
+      (r:abs imaginary)
+      (let [q (/. real imaginary)]
+        (*. (math;sqrt (+. 1.0 (*. q q)))
+            (r:abs real))))
+    ))
+
+(def: #export (exp (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  (let [r-exp (math;exp real)]
+    {#real (*. r-exp (math;cos imaginary))
+     #imaginary (*. r-exp (math;sin imaginary))}))
+
+(def: #export (log (^@ input (^slots [#real #imaginary])))
+  (-> Complex Complex)
+  {#real (math;log (abs input))
+   #imaginary (math;atan2 real imaginary)})
+
+(do-template [  ]
+  [(def: #export ( param input)
+     (->  Complex Complex)
+     (|> input log ( param) exp))]
+
+  [pow  Complex c*]
+  [pow' Real    c*']
+  )
+
+(def: (copy-sign sign magnitude)
+  (-> Real Real Real)
+  (*. (r:signum sign) magnitude))
+
+(def: #export (sqrt (^@ input (^slots [#real #imaginary])))
+  (-> Complex Complex)
+  (let [t (|> input abs (+. (r:abs real)) (/. 2.0) math;sqrt)]
+    (if (>=. 0.0 real)
+      {#real t
+       #imaginary (/. (*. 2.0 t)
+                      imaginary)}
+      {#real (/. (*. 2.0 t)
+                 (r:abs imaginary))
+       #imaginary (*. t (copy-sign imaginary 1.0))})))
+
+(def: #export (sqrt-1z input)
+  (-> Complex Complex)
+  (|> (complex 1.0) (c- (c* input input)) sqrt))
+
+(def: #export (reciprocal (^slots [#real #imaginary]))
+  (-> Complex Complex)
+  (if (<. (r:abs imaginary)
+          (r:abs real))
+    (let [q (/. imaginary real)
+          scale (/. (|> real (*. q) (+. imaginary))
+                    1.0)]
+      {#real (*. q scale)
+       #imaginary (r:negate scale)})
+    (let [q (/. real imaginary)
+          scale (/. (|> imaginary (*. q) (+. real))
+                    1.0)]
+      {#real scale
+       #imaginary (|> scale r:negate (*. q))})))
+
+(def: #export (acos input)
+  (-> Complex Complex)
+  (|> input
+      (c+ (|> input sqrt-1z (c* i)))
+      log
+      (c* (negate i))))
+
+(def: #export (asin input)
+  (-> Complex Complex)
+  (|> input
+      sqrt-1z
+      (c+ (c* i input))
+      log
+      (c* (negate i))))
+
+(def: #export (atan input)
+  (-> Complex Complex)
+  (|> input
+      (c+ i)
+      (c/ (c- input i))
+      log
+      (c* (c/ (complex 2.0) i))))
+
+(def: #export (argument (^slots [#real #imaginary]))
+  (-> Complex Real)
+  (math;atan2 real imaginary))
+
+(def: #export (nth-root nth input)
+  (-> Nat Complex (List Complex))
+  (if (=+ +0 nth)
+    (list)
+    (let [r-nth (|> nth nat-to-int int-to-real)
+          nth-root-of-abs (math;pow (/. r-nth 1.0)
+                                    (abs input))
+          nth-phi (|> input argument (/. r-nth))
+          slice (|> math;pi (*. 2.0) (/. r-nth))]
+      (|> (list;range+ +0 (dec+ nth))
+          (List/map (lambda [nth']
+                      (let [inner (|> nth' nat-to-int int-to-real
+                                      (*. slice)
+                                      (+. nth-phi))
+                            real (*. nth-root-of-abs
+                                     (math;cos inner))
+                            imaginary (*. nth-root-of-abs
+                                          (math;sin inner))]
+                        {#real real
+                         #imaginary imaginary})))))))
+
+(struct: #export _ (Codec Text Complex)
+  (def: (encode (^slots [#real #imaginary]))
+    ($_ Text/append "(" (r:encode real) ", " (r:encode imaginary) ")"))
+
+  (def: (decode input)
+    (case (do Monad
+            [input' (text;sub +1 (-+ +1 (text;size input)) input)]
+            (text;split-with "," input'))
+      #;None
+      (#;Left (Text/append "Wrong syntax for complex numbers: " input))
+
+      (#;Some [r' i'])
+      (do Monad
+        [r (r:decode (text;trim r'))
+         i (r:decode (text;trim i'))]
+        (wrap {#real r
+               #imaginary i}))
+      )))
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
new file mode 100644
index 000000000..aee5674ad
--- /dev/null
+++ b/stdlib/source/lux/math/random.lux
@@ -0,0 +1,283 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  [lux #- list]
+  (lux (control functor
+                applicative
+                monad
+                hash)
+       (data [bit]
+             [char]
+             [text "Text/" Monoid]
+             text/format
+             [product]
+             [number]
+             (struct [list "List/" Fold]
+                     ["A" array]
+                     ["D" dict]
+                     ["Q" queue]
+                     ["S" set]
+                     ["ST" stack]
+                     ["V" vector]))
+       (math ["r" ratio]
+             ["c" complex])))
+
+## [Exports]
+(type: #export #rec PRNG
+  (-> Unit [PRNG Nat]))
+
+(type: #export (Random a)
+  (-> PRNG [PRNG a]))
+
+(struct: #export _ (Functor Random)
+  (def: (map f fa)
+    (lambda [state]
+      (let [[state' a] (fa state)]
+        [state' (f a)]))))
+
+(struct: #export _ (Applicative Random)
+  (def: functor Functor)
+
+  (def: (wrap a)
+    (lambda [state]
+      [state a]))
+
+  (def: (apply ff fa)
+    (lambda [state]
+      (let [[state' f] (ff state)
+            [state'' a] (fa state')]
+        [state'' (f a)]))))
+
+(struct: #export _ (Monad Random)
+  (def: applicative Applicative)
+
+  (def: (join ffa)
+    (lambda [state]
+      (let [[state' fa] (ffa state)]
+        (fa state')))))
+
+(def: #export nat
+  (Random Nat)
+  (lambda [prng]
+    (let [[prng left] (prng [])
+          [prng right] (prng [])]
+      [prng (++ (bit;<< +32 left)
+                right)])))
+
+(def: #export int
+  (Random Int)
+  (lambda [prng]
+    (let [[prng left] (prng [])
+          [prng right] (prng [])]
+      [prng (nat-to-int (++ (bit;<< +32 left)
+                            right))])))
+
+(def: #export bool
+  (Random Bool)
+  (lambda [prng]
+    (let [[prng output] (prng [])]
+      [prng (|> output (bit;& +1) (=+ +1))])))
+
+(def: (bits n)
+  (-> Nat (Random Nat))
+  (lambda [prng]
+    (let [[prng output] (prng [])]
+      [prng (bit;>>> (-+ n +64) output)])))
+
+(def: #export real
+  (Random Real)
+  (do Monad
+    [left (bits +26)
+     right (bits +27)]
+    (wrap (|> right
+              (++ (bit;<< +27 left))
+              nat-to-int
+              int-to-real
+              (/. (|> +1 (bit;<< +53) nat-to-int int-to-real))))))
+
+(def: #export frac
+  (Random Frac)
+  (:: Monad map real-to-frac real))
+
+(def: #export char
+  (Random Char)
+  (do Monad
+    [base nat]
+    (wrap (char;char base))))
+
+(def: #export (text' char-gen size)
+  (-> (Random Char) Nat (Random Text))
+  (if (=+ +0 size)
+    (:: Monad wrap "")
+    (do Monad
+      [x char-gen
+       xs (text' char-gen (dec+ size))]
+      (wrap (Text/append (char;as-text x) xs)))))
+
+(def: #export (text size)
+  (-> Nat (Random Text))
+  (text' char size))
+
+(do-template [   ]
+  [(def: #export 
+     (Random )
+     (do Monad
+       [left 
+        right ]
+       (wrap ( left right))))]
+
+  [ratio   r;Ratio   r;ratio   int]
+  [complex c;Complex c;complex real]
+  )
+
+(def: #export (seq left right)
+  (All [a b] (-> (Random a) (Random b) (Random [a b])))
+  (do Monad
+    [=left left
+     =right right]
+    (wrap [=left =right])))
+
+(def: #export (alt left right)
+  (All [a b] (-> (Random a) (Random b) (Random (| a b))))
+  (do Monad
+    [? bool]
+    (if ?
+      (do @
+        [=left left]
+        (wrap (+0 =left)))
+      (do @
+        [=right right]
+        (wrap (+1 =right))))))
+
+(def: #export (either left right)
+  (All [a] (-> (Random a) (Random a) (Random a)))
+  (do Monad
+    [? bool]
+    (if ?
+      left
+      right)))
+
+(def: #export (rec gen)
+  (All [a] (-> (-> (Random a) (Random a)) (Random a)))
+  (lambda [state]
+    (let [gen' (gen (rec gen))]
+      (gen' state))))
+
+(def: #export (filter pred gen)
+  (All [a] (-> (-> a Bool) (Random a) (Random a)))
+  (do Monad
+    [sample gen]
+    (if (pred sample)
+      (wrap sample)
+      (filter pred gen))))
+
+(do-template [   ]
+  [(def: #export ( size value-gen)
+     (All [a] (-> Nat (Random a) (Random ( a))))
+     (if (>+ +0 size)
+       (do Monad
+         [x value-gen
+          xs ( (dec+ size) value-gen)]
+         (wrap ( x xs)))
+       (:: Monad wrap )))]
+
+  [list   List    (;list)  #;Cons]
+  [vector V;Vector V;empty V;add]
+  )
+
+(do-template [  ]
+  [(def: #export ( size value-gen)
+     (All [a] (-> Nat (Random a) (Random ( a))))
+     (do Monad
+       [values (list size value-gen)]
+       (wrap (|> values ))))]
+
+  [array A;Array  A;from-list]
+  [queue Q;Queue  Q;from-list]
+  [stack ST;Stack (List/fold ST;push ST;empty)]
+  )
+
+(def: #export (set a/Hash size value-gen)
+  (All [a] (-> (Hash a) Nat (Random a) (Random (S;Set a))))
+  (if (>+ +0 size)
+    (do Monad
+      [xs (set a/Hash (dec+ size) value-gen)]
+      (loop [_ []]
+        (do @
+          [x value-gen
+           #let [xs+ (S;add x xs)]]
+          (if (=+ size (S;size xs+))
+            (wrap xs+)
+            (recur [])))))
+    (:: Monad wrap (S;new a/Hash))))
+
+(def: #export (dict a/Hash size key-gen value-gen)
+  (All [k v] (-> (Hash k) Nat (Random k) (Random v) (Random (D;Dict k v))))
+  (if (>+ +0 size)
+    (do Monad
+      [kv (dict a/Hash (dec+ size) key-gen value-gen)]
+      (loop [_ []]
+        (do @
+          [k key-gen
+           v value-gen
+           #let [kv+ (D;put k v kv)]]
+          (if (=+ size (D;size kv+))
+            (wrap kv+)
+            (recur [])))))
+    (:: Monad wrap (D;new a/Hash))))
+
+(def: #export (run prng calc)
+  (All [a] (-> PRNG (Random a) [PRNG a]))
+  (calc prng))
+
+## [PRNGs]
+## PCG32 http://www.pcg-random.org/
+## Based on this Java implementation: https://github.com/alexeyr/pcg-java
+
+(def: pcg-32-magic-mult Nat +6364136223846793005)
+
+(def: #export (pcg-32 [inc seed])
+  (-> [Nat Nat] PRNG)
+  (lambda [_]
+    (let [seed' (|> seed (*+ pcg-32-magic-mult) (++ inc))
+          xor-shifted (|> seed (bit;>>> +18) (bit;^ seed) (bit;>>> +27))
+          rot (|> seed (bit;>>> +59))]
+      [(pcg-32 [inc seed']) (bit;rotate-right rot xor-shifted)]
+      )))
+
+## Xoroshiro128+ http://xoroshiro.di.unimi.it/
+(def: #export (xoroshiro-128+ [s0 s1])
+  (-> [Nat Nat] PRNG)
+  (lambda [_]
+    (let [result (++ s0 s1)
+          s01 (bit;^ s0 s1)
+          s0' (|> (bit;rotate-left +55 s0)
+                  (bit;^ s01)
+                  (bit;^ (bit;<< +14 s01)))
+          s1' (bit;rotate-left +36 s01)]
+      [(xoroshiro-128+ [s0' s1']) result])
+    ))
+
+## [Values]
+(def: (swap from to vec)
+  (All [a] (-> Nat Nat (V;Vector a) (V;Vector a)))
+  (V;put to (default (undefined)
+              (V;at from vec))
+         vec))
+
+(def: #export (shuffle seed vector)
+  (All [a] (-> Nat (V;Vector a) (V;Vector a)))
+  (let [_size (V;size vector)
+        _shuffle (foldM Monad
+                        (lambda [idx vec]
+                          (do Monad
+                            [rand nat]
+                            (wrap (swap idx (%+ _size rand) vec))))
+                        vector
+                        (list;range+ +0 (dec+ _size)))]
+    (|> _shuffle
+        (run (pcg-32 [+123 seed]))
+        product;right)))
diff --git a/stdlib/source/lux/math/ratio.lux b/stdlib/source/lux/math/ratio.lux
new file mode 100644
index 000000000..89d93aa5d
--- /dev/null
+++ b/stdlib/source/lux/math/ratio.lux
@@ -0,0 +1,141 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux [math]
+       (control eq
+                [ord]
+                number
+                codec
+                monad)
+       (data [number "i:" Number Codec]
+             [text "Text/" Monoid]
+             error)
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+(type: #export Ratio
+  {#numerator Int
+   #denominator Int})
+
+(def: #hidden (normalize (^slots [#numerator #denominator]))
+  (-> Ratio Ratio)
+  (let [common (math;gcd numerator denominator)
+        numerator (/ common numerator)
+        denominator (/ common denominator)]
+    {#numerator (if (and (< 0 numerator)
+                         (< 0 denominator))
+                  (i:abs numerator)
+                  numerator)
+     #denominator (i:abs denominator)}))
+
+(def: #export (r* param input)
+  (-> Ratio Ratio Ratio)
+  (normalize [(* (get@ #numerator param)
+                 (get@ #numerator input))
+              (* (get@ #denominator param)
+                 (get@ #denominator input))]))
+
+(def: #export (r/ param input)
+  (-> Ratio Ratio Ratio)
+  (normalize [(* (get@ #denominator param)
+                 (get@ #numerator input))
+              (* (get@ #numerator param)
+                 (get@ #denominator input))]))
+
+(def: #export (r+ param input)
+  (-> Ratio Ratio Ratio)
+  (normalize [(+ (* (get@ #denominator input)
+                    (get@ #numerator param))
+                 (* (get@ #denominator param)
+                    (get@ #numerator input)))
+              (* (get@ #denominator param)
+                 (get@ #denominator input))]))
+
+(def: #export (r- param input)
+  (-> Ratio Ratio Ratio)
+  (normalize [(- (* (get@ #denominator input)
+                    (get@ #numerator param))
+                 (* (get@ #denominator param)
+                    (get@ #numerator input)))
+              (* (get@ #denominator param)
+                 (get@ #denominator input))]))
+
+(def: #export (r% param input)
+  (-> Ratio Ratio Ratio)
+  (let [quot (/ (* (get@ #denominator input)
+                   (get@ #numerator param))
+                (* (get@ #denominator param)
+                   (get@ #numerator input)))]
+    (r- (update@ #numerator (* quot) param)
+        input)))
+
+(def: #export (r= param input)
+  (-> Ratio Ratio Bool)
+  (and (= (get@ #numerator param)
+          (get@ #numerator input))
+       (= (get@ #denominator param)
+          (get@ #denominator input))))
+
+(do-template [ ]
+  [(def: #export ( param input)
+     (-> Ratio Ratio Bool)
+     (and ( (* (get@ #denominator input)
+                   (get@ #numerator param))
+                (* (get@ #denominator param)
+                   (get@ #numerator input)))))]
+
+  [r<  <]
+  [r<= <=]
+  [r>  >]
+  [r>= >=]
+  )
+
+(struct: #export _ (Eq Ratio)
+  (def: = r=))
+
+(struct: #export _ (ord;Ord Ratio)
+  (def: eq Eq)
+  (def: < r<)
+  (def: <= r<=)
+  (def: > r>)
+  (def: >= r>=))
+
+(struct: #export _ (Number Ratio)
+  (def: ord Ord)
+  (def: + r+)
+  (def: - r-)
+  (def: * r*)
+  (def: / r/)
+  (def: % r%)
+  (def: negate (|>. (update@ #numerator i:negate) normalize))
+  (def: abs (|>. (update@ #numerator i:abs) (update@ #denominator i:abs)))
+  (def: (signum x)
+    {#numerator (i:signum (get@ #numerator x))
+     #denominator 1}))
+
+(def: separator Text ":")
+
+(struct: #export _ (Codec Text Ratio)
+  (def: (encode (^slots [#numerator #denominator]))
+    ($_ Text/append (i:encode numerator) separator (i:encode denominator)))
+
+  (def: (decode input)
+    (case (text;split-with separator input)
+      (#;Some [num denom])
+      (do Monad
+        [numerator (i:decode num)
+         denominator (i:decode denom)]
+        (wrap (normalize {#numerator numerator
+                          #denominator denominator})))
+      
+      #;None
+      (#;Left (Text/append "Invalid syntax for ratio: " input)))))
+
+(syntax: #export (ratio numerator denominator)
+  (wrap (list (` (normalize {#;;numerator (~ numerator)
+                             #;;denominator (~ denominator)})))))
diff --git a/stdlib/source/lux/pipe.lux b/stdlib/source/lux/pipe.lux
new file mode 100644
index 000000000..b1316f238
--- /dev/null
+++ b/stdlib/source/lux/pipe.lux
@@ -0,0 +1,147 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module: {#;doc "Composable extensions to the piping macro |> that enhance it with various abilities."}
+  lux
+  (lux (control monad)
+       (data (struct [list #+ Monad "" Fold "List/" Monad])
+             maybe)
+       [compiler #+ with-gensyms Monad]
+       (macro ["s" syntax #+ syntax: Syntax]
+              [ast])
+       ))
+
+## [Syntax]
+(def: body^
+  (Syntax (List AST))
+  (s;tuple (s;many s;any)))
+
+(syntax: #export (_> {tokens (s;at-least +2 s;any)})
+  {#;doc (doc "Ignores the piped argument, and begins a new pipe."
+              (|> 20
+                  (* 3)
+                  (+ 4)
+                  (_> 0 inc)))}
+  (case (list;reverse tokens)
+    (^ (list& _ r-body))
+    (wrap (list (` (|> (~@ (list;reverse r-body))))))
+
+    _
+    (undefined)))
+
+(syntax: #export (@> {body body^}
+                     prev)
+  {#;doc (doc "Gives the name '@' to the piped-argument, within the given expression."
+              (|> 5
+                  (@> [(+ @ @)])))}
+  (wrap (list (fold (lambda [next prev]
+                      (` (let% [(~' @) (~ prev)]
+                           (~ next))))
+                    prev
+                    body))))
+
+(syntax: #export (?> {branches (s;many (s;seq body^ body^))}
+                     {?else (s;opt body^)}
+                     prev)
+  {#;doc (doc "Branching for pipes."
+              "Both the tests and the bodies are piped-code, and must be given inside a tuple."
+              "If a last else-pipe isn't given, the piped-argument will be used instead."
+              (|> 5
+                  (?> [even?] [(* 2)]
+                      [odd?] [(* 3)]
+                      [(_> -1)])))}
+  (with-gensyms [g!temp]
+    (wrap (list (` (let% [(~ g!temp) (~ prev)]
+                     (cond (~@ (do Monad
+                                 [[test then] branches]
+                                 (list (` (|> (~ g!temp) (~@ test)))
+                                       (` (|> (~ g!temp) (~@ then))))))
+                           (~ (case ?else
+                                (#;Some else)
+                                (` (|> (~ g!temp) (~@ else)))
+
+                                _
+                                g!temp)))))))))
+
+(syntax: #export (!> {test body^} {then body^} prev)
+  {#;doc (doc
+          "Loops for pipes."
+          "Both the testing and calculating steps are pipes and must be given inside tuples."
+          (|> 1
+              (!> [(< 10)]
+                  [inc])))}
+  (with-gensyms [g!temp]
+    (wrap (list (` (loop [(~ g!temp) (~ prev)]
+                     (if (|> (~ g!temp) (~@ test))
+                       ((~' recur) (|> (~ g!temp) (~@ then)))
+                       (~ g!temp))))))))
+
+(syntax: #export (%> monad {steps (s;some body^)} prev)
+  {#;doc (doc "Monadic pipes."
+              "Each steps in the monadic computation is a pipe and must be given inside a tuple."
+              (|> 5
+                  (%> Id/Monad
+                      [(* 3)]
+                      [(+ 4)]
+                      [inc])))}
+  (with-gensyms [g!temp]
+    (case (list;reverse steps)
+      (^ (list& last-step prev-steps))
+      (let [step-bindings (do Monad
+                            [step (list;reverse prev-steps)]
+                            (list g!temp (` (|> (~ g!temp) (~@ step)))))]
+        (wrap (list (` (do (~ monad)
+                         [(~ g!temp) (~ prev)
+                          (~@ step-bindings)]
+                         (|> (~ g!temp) (~@ last-step)))))))
+
+      _
+      (wrap (list prev)))))
+
+(syntax: #export (~> {body body^} prev)
+  {#;doc (doc "Non-updating pipes."
+              "Will generate piped computations, but their results won't be used in the larger scope."
+              (|> 5
+                  (~> [int-to-nat %n log!])
+                  (* 10)))}
+  (do @
+    [g!temp (compiler;gensym "")]
+    (wrap (list (` (let [(~ g!temp) (~ prev)]
+                     (exec (|> (~ g!temp) (~@ body))
+                       (~ g!temp))))))))
+
+(syntax: #export (&> {paths (s;many body^)} prev)
+  {#;doc (doc "Parallel branching for pipes."
+              "Allows to run multiple pipelines for a value and gives you a tuple of the outputs."
+              (|> 5
+                  (&> [(* 10)]
+                      [dec (/ 2)]
+                      [Int/encode]))
+              "Will become: [50 2 \"5\"]")}
+  (do @
+    [g!temp (compiler;gensym "")]
+    (wrap (list (` (let [(~ g!temp) (~ prev)]
+                     [(~@ (List/map (lambda [body] (` (|> (~ g!temp) (~@ body))))
+                                    paths))]))))))
+
+(syntax: #export (case> {branches (s;many (s;seq s;any s;any))} prev)
+  {#;doc (doc "Pattern-matching for pipes."
+              "The bodies of each branch are NOT pipes; just regular values."
+              (|> 5
+                  (case> 0 "zero"
+                         1 "one"
+                         2 "two"
+                         3 "three"
+                         4 "four"
+                         5 "five"
+                         6 "six"
+                         7 "seven"
+                         8 "eight"
+                         9 "nine"
+                         _ "???")))}
+  (let [(^open "List/") Monad]
+    (wrap (list (` (case (~ prev)
+                     (~@ (List/join (List/map (lambda [[pattern body]] (list pattern body))
+                                              branches)))))))))
diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/regex.lux
new file mode 100644
index 000000000..1d98d6bf5
--- /dev/null
+++ b/stdlib/source/lux/regex.lux
@@ -0,0 +1,432 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data [char]
+             [text]
+             text/format
+             [number "Int/" Codec]
+             [product]
+             (struct [list "" Fold "List/" Monad]))
+       [compiler #- run]
+       (macro [ast]
+              [syntax #+ syntax:])
+       ["&" lexer #+ Lexer Monad]))
+
+## [Utils]
+(def: #hidden (->Text lexer^)
+  (-> (Lexer Char) (Lexer Text))
+  (do Monad
+    [output lexer^]
+    (wrap (char;as-text output))))
+
+(def: regex-char^
+  (Lexer Char)
+  (&;none-of "\\.|&()[]{}"))
+
+(def: escaped-char^
+  (Lexer Char)
+  (do Monad
+    [? (&;opt (&;this-char #"\\"))
+     char (case ?
+            (#;Some _) &;any
+            #;None     regex-char^)]
+    (wrap char)))
+
+(def: (local^ state lexer)
+  (All [a] (-> Text (Lexer a) (Lexer a)))
+  (lambda [old-state]
+    (case (lexer state)
+      (#;Left error)
+      (#;Left error)
+
+      (#;Right [_ value])
+      (#;Right [old-state value]))))
+
+(def: #hidden (refine^ refinement^ base^)
+  (All [a] (-> (Lexer a) (Lexer Text) (Lexer Text)))
+  (do Monad
+    [output base^
+     _ (local^ output refinement^)]
+    (wrap output)))
+
+(def: #hidden word^
+  (Lexer Char)
+  (&;either &;alpha-num
+            (&;this-char #"_")))
+
+(def: #hidden (join-text^ part^)
+  (-> (Lexer (List Text)) (Lexer Text))
+  (do Monad
+    [parts part^]
+    (wrap (text;join-with "" parts))))
+
+(def: identifier-char^
+  (Lexer Char)
+  (&;none-of "[]{}()s\"#;<>"))
+
+(def: identifier-part^
+  (Lexer Text)
+  (do Monad
+    [head (refine^ (&;not &;digit)
+                   (->Text identifier-char^))
+     tail (&;some' identifier-char^)]
+    (wrap (format head tail))))
+
+(def: (identifier^ current-module)
+  (-> Text (Lexer Ident))
+  (do Monad
+    []
+    ($_ &;either
+        (&;seq (wrap current-module) (&;_& (&;this ";;") identifier-part^))
+        (&;seq identifier-part^ (&;_& (&;this ";") identifier-part^))
+        (&;seq (wrap "lux") (&;_& (&;this ";") identifier-part^))
+        (&;seq (wrap "") identifier-part^))))
+
+(def: (re-var^ current-module)
+  (-> Text (Lexer AST))
+  (do Monad
+    [ident (&;enclosed ["\\@<" ">"] (identifier^ current-module))]
+    (wrap (` (: (Lexer Text) (~ (ast;symbol ident)))))))
+
+(def: re-char-range^
+  (Lexer AST)
+  (do Monad
+    [from regex-char^
+     _ (&;this-char #"-")
+     to regex-char^]
+    (wrap (` (&;char-range (~ (ast;char from)) (~ (ast;char to)))))))
+
+(def: re-char^
+  (Lexer AST)
+  (do Monad
+    [char escaped-char^]
+    (wrap (` (&;this-char (~ (ast;char char)))))))
+
+(def: re-char+^
+  (Lexer AST)
+  (do Monad
+    [base re-char^]
+    (wrap (` (->Text (~ base))))))
+
+(def: re-char-options^
+  (Lexer AST)
+  (do Monad
+    [options (&;many' escaped-char^)]
+    (wrap (` (&;one-of (~ (ast;text options)))))))
+
+(def: re-user-class^'
+  (Lexer AST)
+  (do Monad
+    [negate? (&;opt (&;this-char #"^"))
+     parts (&;many ($_ &;either
+                       re-char-range^
+                       re-char-options^))]
+    (wrap (case negate?
+            (#;Some _) (` (->Text (&;not ($_ &;either (~@ parts)))))
+            #;None     (` (->Text ($_ &;either (~@ parts))))))))
+
+(def: re-user-class^
+  (Lexer AST)
+  (do Monad
+    [_ (wrap [])
+     init re-user-class^'
+     rest (&;some (&;_& (&;this "&&") (&;enclosed ["[" "]"] re-user-class^')))]
+    (wrap (fold (lambda [refinement base]
+                  (` (refine^ (~ refinement) (~ base))))
+                init
+                rest))))
+
+(def: #hidden blank^
+  (Lexer Char)
+  (&;one-of " \t"))
+
+(def: #hidden ascii^
+  (Lexer Char)
+  (&;char-range #"\u0000" #"\u007F"))
+
+(def: #hidden control^
+  (Lexer Char)
+  (&;either (&;char-range #"\u0000" #"\u001F")
+            (&;this-char #"\u007F")))
+
+(def: #hidden punct^
+  (Lexer Char)
+  (&;one-of "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"))
+
+(def: #hidden graph^
+  (Lexer Char)
+  (&;either punct^ &;alpha-num))
+
+(def: #hidden print^
+  (Lexer Char)
+  (&;either graph^
+            (&;this-char #"\u0020")))
+
+(def: re-system-class^
+  (Lexer AST)
+  (do Monad
+    []
+    ($_ &;either
+        (&;_& (&;this-char #".") (wrap (` (->Text &;any))))
+        (&;_& (&;this "\\d") (wrap (` (->Text &;digit))))
+        (&;_& (&;this "\\D") (wrap (` (->Text (&;not &;digit)))))
+        (&;_& (&;this "\\s") (wrap (` (->Text  &;space))))
+        (&;_& (&;this "\\S") (wrap (` (->Text (&;not &;space)))))
+        (&;_& (&;this "\\w") (wrap (` (->Text word^))))
+        (&;_& (&;this "\\W") (wrap (` (->Text (&;not word^)))))
+        (&;_& (&;this "\\d") (wrap (` (->Text &;digit))))
+
+        (&;_& (&;this "\\p{Lower}") (wrap (` (->Text &;lower))))
+        (&;_& (&;this "\\p{Upper}") (wrap (` (->Text &;upper))))
+        (&;_& (&;this "\\p{Alpha}") (wrap (` (->Text &;alpha))))
+        (&;_& (&;this "\\p{Digit}") (wrap (` (->Text &;digit))))
+        (&;_& (&;this "\\p{Alnum}") (wrap (` (->Text &;alpha-num))))
+        (&;_& (&;this "\\p{Space}") (wrap (` (->Text &;space))))
+        (&;_& (&;this "\\p{HexDigit}") (wrap (` (->Text &;hex-digit))))
+        (&;_& (&;this "\\p{OctDigit}") (wrap (` (->Text &;oct-digit))))
+        (&;_& (&;this "\\p{Blank}") (wrap (` (->Text blank^))))
+        (&;_& (&;this "\\p{ASCII}") (wrap (` (->Text ascii^))))
+        (&;_& (&;this "\\p{Contrl}") (wrap (` (->Text control^))))
+        (&;_& (&;this "\\p{Punct}") (wrap (` (->Text punct^))))
+        (&;_& (&;this "\\p{Graph}") (wrap (` (->Text graph^))))
+        (&;_& (&;this "\\p{Print}") (wrap (` (->Text print^))))
+        )))
+
+(def: re-class^
+  (Lexer AST)
+  (&;either re-system-class^
+            (&;enclosed ["[" "]"] re-user-class^)))
+
+(def: int^
+  (Lexer Int)
+  (&;codec number;Codec (&;many' &;digit)))
+
+(def: re-back-reference^
+  (Lexer AST)
+  (&;either (do Monad
+              [_ (&;this-char #"\\")
+               id int^]
+              (wrap (` (&;this (~ (ast;symbol ["" (Int/encode id)]))))))
+            (do Monad
+              [_ (&;this "\\k<")
+               captured-name identifier-part^
+               _ (&;this ">")]
+              (wrap (` (&;this (~ (ast;symbol ["" captured-name]))))))))
+
+(def: (re-simple^ current-module)
+  (-> Text (Lexer AST))
+  ($_ &;either
+      re-class^
+      (re-var^ current-module)
+      re-back-reference^
+      re-char+^
+      ))
+
+(def: (re-simple-quantified^ current-module)
+  (-> Text (Lexer AST))
+  (do Monad
+    [base (re-simple^ current-module)
+     quantifier (&;one-of "?*+")]
+    (case quantifier
+      #"?"
+      (wrap (` (&;default "" (~ base))))
+      
+      #"*"
+      (wrap (` (join-text^ (&;some (~ base)))))
+      
+      _
+      (wrap (` (join-text^ (&;many (~ base)))))
+      )))
+
+(def: (re-counted-quantified^ current-module)
+  (-> Text (Lexer AST))
+  (do Monad
+    [base (re-simple^ current-module)]
+    (&;enclosed ["{" "}"]
+                ($_ &;either
+                    (do @
+                      [[from to] (&;seq int^ (&;_& (&;this-char #",") int^))]
+                      (wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from)))
+                                                      (~ (ast;nat (int-to-nat to)))
+                                                      (~ base))))))
+                    (do @
+                      [limit (&;_& (&;this-char #",") int^)]
+                      (wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base))))))
+                    (do @
+                      [limit (&;&_ int^ (&;this-char #","))]
+                      (wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base))))))
+                    (do @
+                      [limit int^]
+                      (wrap (` (join-text^ (&;exactly (~ (ast;nat (int-to-nat limit))) (~ base))))))))))
+
+(def: (re-quantified^ current-module)
+  (-> Text (Lexer AST))
+  (&;either (re-simple-quantified^ current-module)
+            (re-counted-quantified^ current-module)))
+
+(def: (re-complex^ current-module)
+  (-> Text (Lexer AST))
+  ($_ &;either
+      (re-quantified^ current-module)
+      (re-simple^ current-module)))
+
+(def: #hidden _Text/append_
+  (-> Text Text Text)
+  (:: text;Monoid append))
+
+(type: Re-Group
+  #Non-Capturing
+  (#Capturing [(Maybe Text) Nat]))
+
+(def: (re-sequential^ capturing? re-scoped^ current-module)
+  (-> Bool
+      (-> Text (Lexer [Re-Group AST]))
+      Text
+      (Lexer [Nat AST]))
+  (do Monad
+    [parts (&;many (&;alt (re-complex^ current-module)
+                          (re-scoped^ current-module)))
+     #let [g!total (ast;symbol ["" "0total"])
+           g!temp (ast;symbol ["" "0temp"])
+           [_ names steps] (fold (: (-> (Either AST [Re-Group AST])
+                                        [Int (List AST) (List (List AST))]
+                                        [Int (List AST) (List (List AST))])
+                                    (lambda [part [idx names steps]]
+                                      (case part
+                                        (^or (#;Left complex) (#;Right [#Non-Capturing complex]))
+                                        [idx
+                                         names
+                                         (list& (list g!temp complex
+                                                      (' #let) (` [(~ g!total) (_Text/append_ (~ g!total) (~ g!temp))]))
+                                                steps)]
+                                        
+                                        (#;Right [(#Capturing [?name num-captures]) scoped])
+                                        (let [[idx! name!] (case ?name
+                                                             (#;Some _name)
+                                                             [idx (ast;symbol ["" _name])]
+
+                                                             #;None
+                                                             [(inc idx) (ast;symbol ["" (Int/encode idx)])])
+                                              access (if (>+ +0 num-captures)
+                                                       (` (product;left (~ name!)))
+                                                       name!)]
+                                          [idx!
+                                           (list& name! names)
+                                           (list& (list name! scoped
+                                                        (' #let) (` [(~ g!total) (_Text/append_ (~ g!total) (~ access))]))
+                                                  steps)])
+                                        )))
+                                 [0
+                                  (: (List AST) (list))
+                                  (: (List (List AST)) (list))]
+                                 parts)]]
+    (wrap [(if capturing?
+             (list;size names)
+             +0)
+           (` (do Monad
+                [(~ (' #let)) [(~ g!total) ""]
+                 (~@ (|> steps list;reverse List/join))]
+                ((~ (' wrap)) [(~ g!total) (~@ (list;reverse names))])))])
+    ))
+
+(def: #hidden (unflatten^ lexer)
+  (-> (Lexer Text) (Lexer [Text Unit]))
+  (&;seq lexer (:: Monad wrap [])))
+
+(def: #hidden (|||^ left right)
+  (All [l r] (-> (Lexer [Text l]) (Lexer [Text r]) (Lexer [Text (| l r)])))
+  (lambda [input]
+    (case (left input)
+      (#;Right [input' [lt lv]])
+      (#;Right [input' [lt (+0 lv)]])
+
+      (#;Left _)
+      (case (right input)
+        (#;Right [input' [rt rv]])
+        (#;Right [input' [rt (+1 rv)]])
+
+        (#;Left error)
+        (#;Left error)))))
+
+(def: #hidden (|||_^ left right)
+  (All [l r] (-> (Lexer [Text l]) (Lexer [Text r]) (Lexer Text)))
+  (lambda [input]
+    (case (left input)
+      (#;Right [input' [lt lv]])
+      (#;Right [input' lt])
+
+      (#;Left _)
+      (case (right input)
+        (#;Right [input' [rt rv]])
+        (#;Right [input' rt])
+
+        (#;Left error)
+        (#;Left error)))))
+
+(def: (prep-alternative [num-captures alt])
+  (-> [Nat AST] AST)
+  (if (>+ +0 num-captures)
+    alt
+    (` (unflatten^ (~ alt)))))
+
+(def: (re-alternative^ capturing? re-scoped^ current-module)
+  (-> Bool
+      (-> Text (Lexer [Re-Group AST]))
+      Text
+      (Lexer [Nat AST]))
+  (do Monad
+    [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
+     head sub^
+     tail (&;some (&;_& (&;this-char #"|") sub^))
+     #let [g!op (if capturing?
+                  (` |||^)
+                  (` |||_^))]]
+    (if (list;empty? tail)
+      (wrap head)
+      (wrap [(fold max+ (product;left head) (List/map product;left tail))
+             (` ($_ (~ g!op) (~ (prep-alternative head)) (~@ (List/map prep-alternative tail))))]))))
+
+(def: (re-scoped^ current-module)
+  (-> Text (Lexer [Re-Group AST]))
+  ($_ &;either
+      (do Monad
+        [_ (&;this "(?:")
+         [_ scoped] (re-alternative^ false re-scoped^ current-module)
+         _ (&;this-char #")")]
+        (wrap [#Non-Capturing scoped]))
+      (do Monad
+        [complex (re-complex^ current-module)]
+        (wrap [#Non-Capturing complex]))
+      (do Monad
+        [_ (&;this "(?<")
+         captured-name identifier-part^
+         _ (&;this ">")
+         [num-captures pattern] (re-alternative^ true re-scoped^ current-module)
+         _ (&;this-char #")")]
+        (wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern]))
+      (do Monad
+        [_ (&;this-char #"(")
+         [num-captures pattern] (re-alternative^ true re-scoped^ current-module)
+         _ (&;this-char #")")]
+        (wrap [(#Capturing [#;None num-captures]) pattern]))))
+
+(def: (regex^ current-module)
+  (-> Text (Lexer AST))
+  (:: Monad map product;right (re-alternative^ true re-scoped^ current-module)))
+
+## [Syntax]
+(syntax: #export (regex {pattern syntax;text})
+  (do @
+    [current-module compiler;current-module-name]
+    (case (&;run (&;&_ (regex^ current-module) &;end) pattern)
+      (#;Left error)
+      (compiler;fail error)
+
+      (#;Right regex)
+      (wrap (list regex))
+      )))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
new file mode 100644
index 000000000..eba8034f9
--- /dev/null
+++ b/stdlib/source/lux/test.lux
@@ -0,0 +1,330 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux [compiler #+ Monad with-gensyms]
+       (macro ["s" syntax #+ syntax: Syntax]
+              [ast])
+       (control functor
+                applicative
+                monad)
+       (concurrency [promise #* "Promise/" Monad])
+       (data (struct [list "List/" Monad])
+             [product]
+             [text]
+             text/format
+             [error #* "Error/" Monad])
+       (codata [io #- run])
+       (math ["R" random])
+       [host #- try]))
+
+## [Host]
+(jvm-import java.lang.System
+  (#static exit [int] #io void)
+  (#static currentTimeMillis [] #io long))
+
+(def: #hidden exit
+  (IO Unit)
+  (System.exit 0))
+
+## [Types]
+(type: #export (Test a)
+  (Promise (Error a)))
+
+## [Structs]
+(struct: #export _ (Functor Test)
+  (def: (map f fa)
+    (Promise/map (Error/map f) fa)))
+
+(struct: #export _ (Applicative Test)
+  (def: functor Functor)
+
+  (def: (wrap a)
+    (Promise/wrap (#;Right a)))
+
+  (def: (apply ff fa)
+    (do Monad
+      [f' ff
+       a' fa]
+      (case [f' a']
+        [(#;Right f) (#;Right a)]
+        (wrap (#;Right (f a)))
+
+        (^or [(#;Left msg) _] [_ (#;Left msg)])
+        (wrap (#;Left msg))))
+    ))
+
+(struct: #export _ (Monad Test)
+  (def: applicative Applicative)
+  
+  (def: (join mma)
+    (Promise/join (Promise/map (lambda [mma']
+                                 (case mma'
+                                   (#;Left msg)
+                                   (Promise/wrap (#;Left msg))
+
+                                   (#;Right ma)
+                                   ma))
+                               mma)))
+  )
+
+## [Values]
+(def: #export (fail message)
+  (All [a] (-> Text (Test a)))
+  (:: Monad wrap (#;Left message)))
+
+(def: #export (assert message test)
+  (-> Text Bool (Test Unit))
+  (if test
+    (:: Monad wrap [])
+    (fail message)))
+
+(def: #export (from-promise promise)
+  (All [a] (-> (Promise a) (Test a)))
+  (do Monad
+    [output promise]
+    (wrap (#;Right output))))
+
+(def: #hidden (run' tests)
+  (-> (List [Text (IO (Test Unit)) Text]) (Promise Unit))
+  (do Monad
+    [printings (mapM @
+                     (: (-> [Text (IO (Test Unit)) Text] (Promise Unit))
+                        (lambda [[module test description]]
+                          (do @
+                            [#let [pre (io;run (System.currentTimeMillis []))]
+                             outcome (io;run test)
+                             #let [post (io;run (System.currentTimeMillis []))]]
+                            (case outcome
+                              (#;Left error)
+                              (wrap (log! (format "Error: " (:: text;Codec encode description) " @ " module "\n" error "\n\n")))
+                              
+                              _
+                              (exec (log! (format "Success: " (:: text;Codec encode description) " @ " module
+                                                  " in " (%i (- pre post)) "ms"))
+                                (wrap []))))))
+                     tests)]
+    (wrap [])))
+
+(def: pcg-32-magic-inc Nat +12345)
+
+(type: #export Seed Nat)
+
+(def: #export (try seed random-test)
+  (-> Seed (R;Random (Test Unit)) (Test Seed))
+  (let [[prng [new-seed test]] (R;run (R;pcg-32 [pcg-32-magic-inc seed])
+                                      (do R;Monad
+                                        [test random-test
+                                         next-seed R;nat]
+                                        (wrap [next-seed test])))]
+    (do Monad
+      [_ test]
+      (wrap new-seed))))
+
+(def: (repeat' seed times random-test)
+  (-> Seed Nat (R;Random (Test Unit)) (Test Seed))
+  (case times
+    +0
+    (fail "Can't try a test 0 times.")
+    
+    +1
+    (try seed random-test)
+    
+    _
+    (do Monad
+      [output (try seed random-test)]
+      (case output
+        (#;Left error)
+        (fail (format "Test failed with this seed: " (%n seed) "\n" error))
+
+        (#;Right seed')
+        (repeat' seed' (dec+ times) random-test)))))
+
+(def: #export (repeat times random-test)
+  (-> Nat (R;Random (Test Unit)) (Test Unit))
+  (do Monad
+    [_ (repeat' (int-to-nat (io;run (System.currentTimeMillis [])))
+                times
+                random-test)]
+    (wrap [])))
+
+## [Syntax]
+(type: Property-Test
+  {#seed (Maybe (Either Nat Ident))
+   #bindings (List [AST AST])
+   #body AST})
+
+(type: Test-Kind
+  (#Property Property-Test)
+  (#Simple AST))
+
+(def: propery-test^
+  (Syntax Property-Test)
+  ($_ s;seq
+      (s;opt (s;alt s;nat
+                    s;symbol))
+      (s;tuple (s;some (s;seq s;any s;any)))
+      s;any))
+
+(def: test^
+  (Syntax Test-Kind)
+  (s;alt propery-test^
+         s;any))
+
+(def: (pair-to-list [x y])
+  (All [a] (-> [a a] (List a)))
+  (list x y))
+
+(syntax: #export (test: description {body test^})
+  {#;doc (doc "Macro for definint tests."
+              (test: "lux/pipe exports"
+                (all (match 1 (|> 20
+                                  (* 3)
+                                  (+ 4)
+                                  (_> 0 inc)))
+                     (match 10 (|> 5
+                                   (@> (+ @ @))))
+                     (match 15 (|> 5
+                                   (?> [even?] [(* 2)]
+                                       [odd?] [(* 3)]
+                                       [(_> -1)])))
+                     )))}
+  (let [body (case body
+               (#Property seed bindings body)
+               (let [seed' (case seed
+                             #;None
+                             (' +100)
+
+                             (#;Some (#;Left value))
+                             (ast;nat value)
+
+                             (#;Some (#;Right var))
+                             (ast;symbol var))
+                     bindings' (|> bindings (List/map pair-to-list) List/join)]
+                 (` (repeat (~ seed')
+                            (do R;Monad
+                              [(~@ bindings')]
+                              ((~' wrap) (~ body))))))
+               
+               (#Simple body)
+               body)]
+    (with-gensyms [g!test]
+      (wrap (list (` (def: #export (~ g!test)
+                       {#;;test (#;TextM (~ description))}
+                       (IO (Test Unit))
+                       (io (~ body)))))))))
+
+(def: (exported-tests module-name)
+  (-> Text (Lux (List [Text Text Text])))
+  (do Monad
+    [defs (compiler;exports module-name)]
+    (wrap (|> defs
+              (List/map (lambda [[def-name [_ def-anns _]]]
+                          (case (compiler;get-text-ann (ident-for #;;test) def-anns)
+                            (#;Some description)
+                            [true module-name def-name description]
+
+                            _
+                            [false module-name def-name ""])))
+              (list;filter product;left)
+              (List/map product;right)))))
+
+(syntax: #export (match pattern expression)
+  {#;doc (doc "Runs an expression and pattern-matches against it using the given pattern."
+              "If the pattern-matching succeeds, the test succeeds."
+              (match 15 (|> 5
+                            (?> [even?] [(* 2)]
+                                [odd?] [(* 3)]))))}
+  (with-gensyms [g!_]
+    (wrap (list (` (: (Test Unit)
+                      (case (~ expression)
+                        (~ pattern)
+                        (~' (:: Monad wrap []))
+
+                        (~ g!_)
+                        (fail (~ (ast;text (format "Pattern was not matched: " (ast;ast-to-text pattern)
+                                                   "\n\n" "From expression: " (ast;ast-to-text expression))))))))))))
+
+(def: #hidden (should-pass' veredict expr-repr)
+  (All [a] (-> (Error a) Text (Test a)))
+  (case veredict
+    (#;Left message) (fail (format "'" message "' @ " expr-repr))
+    (#;Right value)  (:: Monad wrap value)))
+
+(def: #hidden (should-fail' veredict expr-repr)
+  (All [a] (-> (Error a) Text (Test Unit)))
+  (case veredict
+    (#;Left message) (:: Monad wrap [])
+    (#;Right value)  (fail (format "Should have failed: " expr-repr))))
+
+(do-template [  ]
+  [(syntax: #export ( expr)
+     {#;doc }
+     (wrap (list (` ( (~ expr) (~ (ast;text (ast;ast-to-text expr))))))))]
+
+  [should-pass should-pass' "Verifies that a (Error a) computation succeeds/passes."]
+  [should-fail should-fail' "Verifies that a (Error a) computation fails."]
+  )
+
+(syntax: #export (match+ pattern source)
+  {#;doc (doc "Same as \"match\", but the expression/source is expected to be of type (Test a)."
+              "That is, it's asynchronous and it may fail."
+              "If, however, it succeeds, it's value will be pattern-matched against."
+              (match+ 5 (commit (do Monad
+                                  [_ (write 5 _var)
+                                   value (read _var)]
+                                  (wrap (#;Right value))))))}
+  (with-gensyms [g!temp]
+    (wrap (list (` (: (Test Unit)
+                      (do Monad
+                        [(~ g!temp) (~ source)]
+                        (match (~ pattern) (~ g!temp)))))))))
+
+(syntax: #export (run)
+  {#;doc (doc "Runs all the tests defined on the current module, and in all imported modules."
+              (run))}
+  (with-gensyms [g!_]
+    (do @
+      [current-module compiler;current-module-name
+       modules (compiler;imported-modules current-module)
+       tests (: (Lux (List [Text Text Text]))
+                (:: @ map List/join (mapM @ exported-tests (#;Cons current-module modules))))
+       #let [tests+ (List/map (lambda [[module-name test desc]]
+                                (` [(~ (ast;text module-name)) (~ (ast;symbol [module-name test])) (~ (ast;text desc))]))
+                              tests)
+             groups (list;split-all (|> (list;size tests+) (/+ concurrency-level) (++ +1) (min+ +16))
+                                    tests+)]]
+      (wrap (list (` (: (IO Unit)
+                        (io (exec (do Monad
+                                    [(~@ (List/join (List/map (lambda [group]
+                                                                (list g!_ (` (run' (list (~@ group))))))
+                                                              groups)))]
+                                    (exec (log! "Test-suite finished!")
+                                      (future exit)))
+                              [])))))))))
+
+(syntax: #export (all {tests (s;some s;any)})
+  {#;doc (doc "Given a sequence of tests, runs them all sequentially, and succeeds if the all succeed."
+              (test: "lux/pipe exports"
+                (all (match 1 (|> 20
+                                  (* 3)
+                                  (+ 4)
+                                  (_> 0 inc)))
+                     (match 10 (|> 5
+                                   (@> (+ @ @))))
+                     (match 15 (|> 5
+                                   (?> [even?] [(* 2)]
+                                       [odd?] [(* 3)]
+                                       [(_> -1)])))
+                     )))}
+  (with-gensyms [g!_]
+    (let [pairs (|> tests
+                    (List/map (: (-> AST (List AST)) (lambda [test] (list g!_ test))))
+                    List/join)]
+      (wrap (list (` (: (Test Unit)
+                        (do Monad
+                          [(~@ pairs)]
+                          ((~' wrap) [])))))))))
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
new file mode 100644
index 000000000..4a84582c4
--- /dev/null
+++ b/stdlib/source/lux/type.lux
@@ -0,0 +1,275 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control eq
+                monad)
+       (data [text "Text/" Monoid Eq]
+             [number "Nat/" Codec]
+             maybe
+             (struct [list #+ "List/" Monad Monoid Fold]))
+       (macro [ast])
+       ))
+
+## [Utils]
+(def: (beta-reduce env type)
+  (-> (List Type) Type Type)
+  (case type
+    (#;HostT name params)
+    (#;HostT name (List/map (beta-reduce env) params))
+    
+    (^template []
+     ( left right)
+     ( (beta-reduce env left) (beta-reduce env right)))
+    ([#;SumT] [#;ProdT])
+    
+    (^template []
+     ( left right)
+     ( (beta-reduce env left) (beta-reduce env right)))
+    ([#;LambdaT]
+     [#;AppT])
+
+    (^template []
+     ( old-env def)
+     (case old-env
+       #;Nil
+       ( env def)
+
+       _
+       type))
+    ([#;UnivQ]
+     [#;ExQ])
+    
+    (#;BoundT idx)
+    (default type (list;at idx env))
+    
+    (#;NamedT name type)
+    (beta-reduce env type)
+
+    _
+    type
+    ))
+
+## [Structures]
+(struct: #export _ (Eq Type)
+  (def: (= x y)
+    (case [x y]
+      [(#;HostT xname xparams) (#;HostT yname yparams)]
+      (and (Text/= xname yname)
+           (=+ (list;size yparams) (list;size xparams))
+           (List/fold (lambda [[x y] prev] (and prev (= x y)))
+                      true
+                      (list;zip2 xparams yparams)))
+
+      (^template []
+       [ ]
+       true)
+      ([#;VoidT] [#;UnitT])
+      
+      (^template []
+       [( xid) ( yid)]
+       (=+ yid xid))
+      ([#;VarT] [#;ExT] [#;BoundT])
+
+      (^or [(#;LambdaT xleft xright) (#;LambdaT yleft yright)]
+       [(#;AppT xleft xright) (#;AppT yleft yright)])
+      (and (= xleft yleft)
+           (= xright yright))
+
+      [(#;NamedT [xmodule xname] xtype) (#;NamedT [ymodule yname] ytype)]
+      (and (Text/= xmodule ymodule)
+           (Text/= xname yname)
+           (= xtype ytype))
+
+      (^template []
+       [( xL xR) ( yL yR)]
+       (and (= xL yL) (= xR yR)))
+      ([#;SumT] [#;ProdT])
+      
+      (^or [(#;UnivQ xenv xbody) (#;UnivQ yenv ybody)]
+       [(#;ExQ xenv xbody) (#;ExQ yenv ybody)])
+      (and (=+ (list;size yenv) (list;size xenv))
+           (= xbody ybody)
+           (List/fold (lambda [[x y] prev] (and prev (= x y)))
+                      true
+                      (list;zip2 xenv yenv)))
+
+      _
+      false
+      )))
+
+## [Values]
+(def: #export (flatten-function type)
+  (-> Type [(List Type) Type])
+  (case type
+    (#;LambdaT in out')
+    (let [[ins out] (flatten-function out')]
+      [(list& in ins) out])
+
+    _
+    [(list) type]))
+
+(def: #export (flatten-apply type)
+  (-> Type [Type (List Type)])
+  (case type
+    (#;AppT left' right)
+    (let [[left rights] (flatten-apply left')]
+      [left (List/append rights (list right))])
+
+    _
+    [type (list)]))
+
+(do-template [ ]
+  [(def: #export ( type)
+     (-> Type (List Type))
+     (case type
+       ( left right)
+       (list& left ( right))
+
+       _
+       (list type)))]
+
+  [flatten-sum  #;SumT]
+  [flatten-prod #;ProdT]
+  )
+
+(def: #export (apply-type type-fun param)
+  (-> Type Type (Maybe Type))
+  (case type-fun
+    (^template []
+     ( env body)
+     (#;Some (beta-reduce (list& type-fun param env) body)))
+    ([#;UnivQ] [#;ExQ])
+
+    (#;AppT F A)
+    (do Monad
+      [type-fn* (apply-type F A)]
+      (apply-type type-fn* param))
+
+    (#;NamedT name type)
+    (apply-type type param)
+    
+    _
+    #;None))
+
+(def: #export (type-to-ast type)
+  (-> Type AST)
+  (case type
+    (#;HostT name params)
+    (` (#;HostT (~ (ast;text name))
+                (list (~@ (List/map type-to-ast params)))))
+
+    (^template []
+     
+     (` ))
+    ([#;VoidT] [#;UnitT])
+
+    (^template []
+     ( idx)
+     (` ( (~ (ast;nat idx)))))
+    ([#;VarT] [#;ExT] [#;BoundT])
+
+    (^template []
+     ( left right)
+     (` ( (~ (type-to-ast left))
+               (~ (type-to-ast right)))))
+    ([#;LambdaT] [#;AppT])
+
+    (^template [  ]
+     ( left right)
+     (` ( (~@ (List/map type-to-ast ( type))))))
+    ([#;SumT  | flatten-sum]
+     [#;ProdT & flatten-prod])
+
+    (#;NamedT name sub-type)
+    (ast;symbol name)
+
+    (^template []
+     ( env body)
+     (` ( (list (~@ (List/map type-to-ast env)))
+               (~ (type-to-ast body)))))
+    ([#;UnivQ] [#;ExQ])
+    ))
+
+(def: #export (type-to-text type)
+  (-> Type Text)
+  (case type
+    (#;HostT name params)
+    (case params
+      #;Nil
+      ($_ Text/append "(^ " name ")")
+
+      _
+      ($_ Text/append "(^ " name " " (|> params (List/map type-to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")"))
+
+    #;VoidT
+    "Void"
+    
+    #;UnitT
+    "Unit"
+
+    (^template [   ]
+     ( _)
+     ($_ Text/append 
+         (|> ( type)
+             (List/map type-to-text)
+             list;reverse
+             (list;interpose " ")
+             (List/fold Text/append ""))
+         ))
+    ([#;SumT  "(| " ")" flatten-sum]
+     [#;ProdT "["   "]" flatten-prod])
+
+    (#;LambdaT input output)
+    (let [[ins out] (flatten-function type)]
+      ($_ Text/append  "(-> "
+          (|> ins
+              (List/map type-to-text)
+              list;reverse
+              (list;interpose " ")
+              (List/fold Text/append ""))
+          " " (type-to-text out) ")"))
+
+    (#;BoundT idx)
+    (Nat/encode idx)
+
+    (#;VarT id)
+    ($_ Text/append "⌈v:" (Nat/encode id) "⌋")
+
+    (#;ExT id)
+    ($_ Text/append "⟨e:" (Nat/encode id) "⟩")
+
+    (#;AppT fun param)
+    (let [[type-fun type-args] (flatten-apply type)]
+      ($_ Text/append  "(" (type-to-text type-fun) " " (|> type-args (List/map type-to-text) list;reverse (list;interpose " ") (List/fold Text/append "")) ")"))
+
+    (#;UnivQ env body)
+    ($_ Text/append "(All " (type-to-text body) ")")
+
+    (#;ExQ env body)
+    ($_ Text/append "(Ex " (type-to-text body) ")")
+
+    (#;NamedT [module name] type)
+    ($_ Text/append module ";" name)
+    ))
+
+(def: #export (un-alias type)
+  (-> Type Type)
+  (case type
+    (#;NamedT _ (#;NamedT ident type'))
+    (un-alias (#;NamedT ident type'))
+
+    _
+    type))
+
+(def: #export (un-name type)
+  (-> Type Type)
+  (case type
+    (#;NamedT ident type')
+    (un-name type')
+
+    _
+    type))
diff --git a/stdlib/source/lux/type/auto.lux b/stdlib/source/lux/type/auto.lux
new file mode 100644
index 000000000..a1a795c80
--- /dev/null
+++ b/stdlib/source/lux/type/auto.lux
@@ -0,0 +1,211 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (data [text]
+             text/format
+             [number]
+             (struct [list "List/" Monad Fold]
+                     [dict])
+             [bool]
+             [product])
+       [compiler #+ Monad]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])
+       [type]
+       (type ["tc" check #+ Check Monad])
+       ))
+
+(def: (find-member-type idx sig-type)
+  (-> Nat Type (Check Type))
+  (case sig-type
+    (#;NamedT _ sig-type')
+    (find-member-type idx sig-type')
+
+    (#;AppT func arg)
+    (case (type;apply-type func arg)
+      #;None
+      (tc;fail (format "Can't apply type " (%type func) " to type " (%type arg)))
+
+      (#;Some sig-type')
+      (find-member-type idx sig-type'))
+
+    (#;ProdT left right)
+    (if (=+ +0 idx)
+      (:: Monad wrap left)
+      (find-member-type (dec+ idx) right))
+
+    _
+    (if (=+ +0 idx)
+      (:: Monad wrap sig-type)
+      (tc;fail (format "Can't find member type " (%n idx) " for " (%type sig-type))))))
+
+(def: (resolve-member member)
+  (-> Ident (Lux [Nat Type]))
+  (do Monad
+    [member (compiler;normalize member)
+     [idx tag-list sig-type] (compiler;resolve-tag member)]
+    (wrap [idx sig-type])))
+
+(def: (prepare-defs this-module-name defs)
+  (-> Text (List [Text Def]) (List [Ident Type]))
+  (|> defs
+      (list;filter (lambda [[name [def-type def-anns def-value]]]
+                     (compiler;struct? def-anns)))
+      (List/map (lambda [[name [def-type def-anns def-value]]]
+                  [[this-module-name name] def-type]))))
+
+(def: local-env
+  (Lux (List [Ident Type]))
+  (do Monad
+    [local-batches compiler;locals
+     #let [total-locals (List/fold (lambda [[name type] table]
+                                     (dict;put~ name type table))
+                                   (: (dict;Dict Text Type)
+                                      (dict;new text;Hash))
+                                   (List/join local-batches))]]
+    (wrap (|> total-locals
+              dict;entries
+              (List/map (lambda [[name type]] [["" name] type]))))))
+
+(def: local-structs
+  (Lux (List [Ident Type]))
+  (do Monad
+    [this-module-name compiler;current-module-name
+     defs (compiler;defs this-module-name)]
+    (wrap (prepare-defs this-module-name defs))))
+
+(def: import-structs
+  (Lux (List [Ident Type]))
+  (do Monad
+    [this-module-name compiler;current-module-name
+     imp-mods (compiler;imported-modules this-module-name)
+     export-batches (mapM @ compiler;exports imp-mods)]
+    (wrap (prepare-defs this-module-name (List/join export-batches)))))
+
+(def: (apply-function-type func arg)
+  (-> Type Type (Check Type))
+  (case func
+    (#;NamedT _ func')
+    (apply-function-type func' arg)
+
+    (#;UnivQ _)
+    (do Monad
+      [[id var] tc;create-var]
+      (apply-function-type (default (undefined)
+                             (type;apply-type func var))
+                           arg))
+
+    (#;LambdaT input output)
+    (do Monad
+      [_ (tc;check input arg)]
+      (wrap output))
+
+    _
+    (tc;fail (format "Invalid function type: " (%type func)))))
+
+(def: (check-apply member-type input-types output-type)
+  (-> Type (List Type) Type (Check []))
+  (do Monad
+    [member-type' (foldM Monad
+                         (lambda [input member]
+                           (apply-function-type member input))
+                         member-type
+                         input-types)]
+    (tc;check output-type member-type')))
+
+(def: compiler-type-context
+  (Lux tc;Context)
+  (lambda [compiler]
+    (let [type-vars (get@ #;type-vars compiler)
+          context (|> tc;fresh-context
+                      (set@ #tc;var-id (get@ #;counter type-vars))
+                      (set@ #tc;bindings (dict;from-list number;Hash (get@ #;mappings type-vars))))]
+      (#;Right [compiler context]))))
+
+(def: (test-alternatives sig-type member-idx input-types output-type alts)
+  (-> Type Nat (List Type) Type (List [Ident Type]) (Lux (List Ident)))
+  (do Monad
+    [context compiler-type-context]
+    (case (|> alts
+              (list;filter (lambda [[alt-name alt-type]]
+                             (case (tc;run context
+                                           (do Monad
+                                             [_ (tc;check sig-type alt-type)
+                                              member-type (find-member-type member-idx alt-type)]
+                                             (check-apply member-type input-types output-type)))
+                               (#;Left error)
+                               false
+
+                               (#;Right _)
+                               true)))
+              (List/map product;left))
+      #;Nil
+      (compiler;fail "No alternatives.")
+
+      found
+      (wrap found))))
+
+(def: (find-alternatives sig-type member-idx input-types output-type)
+  (-> Type Nat (List Type) Type (Lux (List Ident)))
+  (let [test (test-alternatives sig-type member-idx input-types output-type)]
+    ($_ compiler;either
+        (do Monad [alts local-env] (test alts))
+        (do Monad [alts local-structs] (test alts))
+        (do Monad [alts import-structs] (test alts)))))
+
+(def: (var? input)
+  (-> AST Bool)
+  (case input
+    [_ (#;SymbolS _)]
+    true
+
+    _
+    false))
+
+(def: (join-pair [l r])
+  (All [a] (-> [a a] (List a)))
+  (list l r))
+
+(syntax: #export (::: {member s;symbol}
+                      {args (s;alt (s;some s;symbol)
+                                   (s;some s;any))})
+  (case args
+    (#;Left args)
+    (do @
+      [[member-idx sig-type] (resolve-member member)
+       input-types (mapM @ compiler;find-type args)
+       output-type compiler;expected-type
+       chosen-ones (find-alternatives sig-type member-idx input-types output-type)]
+      (case chosen-ones
+        #;Nil
+        (compiler;fail (format "No structure option could be found for member " (%ident member)))
+
+        (#;Cons chosen #;Nil)
+        (wrap (list (` (:: (~ (ast;symbol chosen))
+                           (~ (ast;symbol member))
+                           (~@ (List/map ast;symbol args))))))
+
+        _
+        (compiler;fail (format "Too many available options: "
+                               (|> chosen-ones
+                                   (List/map %ident)
+                                   (text;join-with ", ")
+                                   )))))
+
+    (#;Right args)
+    (do @
+      [#let [args-to-bind (list;filter (bool;complement var?) args)]
+       labels (seqM @ (list;repeat (list;size args-to-bind)
+                                   (compiler;gensym "")))
+       #let [retry (` (let [(~@ (|> (list;zip2 labels args-to-bind) (List/map join-pair) List/join))]
+                        (;;::: (~ (ast;symbol member)) (~@ labels))))]]
+      (wrap (list retry)))))
+
+(comment
+  (::: map inc (list 0 1 2 3 4))
+  )
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
new file mode 100644
index 000000000..9eb72cbcb
--- /dev/null
+++ b/stdlib/source/lux/type/check.lux
@@ -0,0 +1,518 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control functor
+                applicative
+                monad)
+       (data [text "Text/" Monoid Eq]
+             text/format
+             [number]
+             maybe
+             (struct [list]
+                     [dict])
+             error)
+       [type "Type/" Eq]
+       ))
+
+(type: #export Id Nat)
+
+(type: #export Fixpoints (List [[Type Type] Bool]))
+
+(type: #export Context
+  {#var-id Id
+   #ex-id Id
+   #bindings (dict;Dict Id (Maybe Type))
+   #fixpoints Fixpoints
+   })
+
+(type: #export (Check a)
+  (-> Context (Error [Context a])))
+
+(struct: #export _ (Functor Check)
+  (def: (map f fa)
+    (lambda [context]
+      (case (fa context)
+        (#;Left error)
+        (#;Left error)
+
+        (#;Right [context' output])
+        (#;Right [context' (f output)])
+        ))))
+
+(struct: #export _ (Applicative Check)
+  (def: functor Functor)
+
+  (def: (wrap x)
+    (lambda [context]
+      (#;Right [context x])))
+
+  (def: (apply ff fa)
+    (lambda [context]
+      (case (ff context)
+        (#;Right [context' f])
+        (case (fa context')
+          (#;Right [context'' a])
+          (#;Right [context'' (f a)])
+
+          (#;Left error)
+          (#;Left error))
+
+        (#;Left error)
+        (#;Left error)
+        )))
+  )
+
+(struct: #export _ (Monad Check)
+  (def: applicative Applicative)
+
+  (def: (join ffa)
+    (lambda [context]
+      (case (ffa context)
+        (#;Right [context' fa])
+        (case (fa context')
+          (#;Right [context'' a])
+          (#;Right [context'' a])
+
+          (#;Left error)
+          (#;Left error))
+
+        (#;Left error)
+        (#;Left error)
+        )))
+  )
+
+(open Monad "Check/")
+
+## [[Logic]]
+(def: #export (run context proc)
+  (All [a] (-> Context (Check a) (Error a)))
+  (case (proc context)
+    (#;Left error)
+    (#;Left error)
+
+    (#;Right [context' output])
+    (#;Right output)))
+
+(def: (apply-type! t-func t-arg)
+  (-> Type Type (Check Type))
+  (lambda [context]
+    (case (type;apply-type t-func t-arg)
+      #;None
+      (#;Left (format "Invalid type application: " (type;type-to-text t-func) " on " (type;type-to-text t-arg)))
+
+      (#;Some output)
+      (#;Right [context output]))))
+
+(def: #export existential
+  (Check [Id Type])
+  (lambda [context]
+    (let [id (get@ #ex-id context)]
+      (#;Right [(update@ #ex-id inc+ context)
+                [id (#;ExT id)]]))))
+
+(def: (bound? id)
+  (-> Id (Check Bool))
+  (lambda [context]
+    (case (|> context (get@ #bindings) (dict;get id))
+      (#;Some (#;Some _))
+      (#;Right [context true])
+
+      (#;Some #;None)
+      (#;Right [context false])
+      
+      #;None
+      (#;Left (format "Unknown type-var: " (%n id))))))
+
+(def: (deref id)
+  (-> Id (Check Type))
+  (lambda [context]
+    (case (|> context (get@ #bindings) (dict;get id))
+      (#;Some (#;Some type))
+      (#;Right [context type])
+
+      (#;Some #;None)
+      (#;Left (format "Unbound type-var: " (%n id)))
+      
+      #;None
+      (#;Left (format "Unknown type-var: " (%n id))))))
+
+(def: (set-var id type)
+  (-> Id Type (Check []))
+  (lambda [context]
+    (case (|> context (get@ #bindings) (dict;get id))
+      (#;Some (#;Some bound))
+      (#;Left (format "Can't rebind type-var: " (%n id) " | Current type: " (type;type-to-text bound)))
+      
+      (#;Some #;None)
+      (#;Right [(update@ #bindings (dict;put id (#;Some type)) context)
+                []])
+
+      #;None
+      (#;Left (format "Unknown type-var: " (%n id))))))
+
+(def: (reset-var id type)
+  (-> Id Type (Check []))
+  (lambda [context]
+    (case (|> context (get@ #bindings) (dict;get id))
+      (#;Some _)
+      (#;Right [(update@ #bindings (dict;put id (#;Some type)) context)
+                []])
+      
+      #;None
+      (#;Left (format "Unknown type-var: " (%n id))))))
+
+(def: (unset-var id)
+  (-> Id (Check []))
+  (lambda [context]
+    (case (|> context (get@ #bindings) (dict;get id))
+      (#;Some _)
+      (#;Right [(update@ #bindings (dict;put id #;None) context)
+                []])
+      
+      #;None
+      (#;Left (format "Unknown type-var: " (%n id))))))
+
+(def: (clean t-id type)
+  (-> Id Type (Check Type))
+  (case type
+    (#;VarT id)
+    (if (=+ t-id id)
+      (do Monad
+        [? (bound? id)]
+        (if ?
+          (deref id)
+          (wrap type)))
+      (do Monad
+        [? (bound? id)]
+        (if ?
+          (do Monad
+            [=type (deref id)
+             ==type (clean t-id =type)]
+            (case ==type
+              (#;VarT =id)
+              (if (=+ t-id =id)
+                (do Monad
+                  [_ (unset-var id)]
+                  (wrap type))
+                (do Monad
+                  [_ (reset-var id ==type)]
+                  (wrap type)))
+
+              _
+              (do Monad
+                [_ (reset-var id ==type)]
+                (wrap type))))
+          (wrap type))))
+
+    (#;HostT name params)
+    (do Monad
+      [=params (mapM @ (clean t-id) params)]
+      (wrap (#;HostT name =params)))
+    
+    (^template []
+     ( left right)
+     (do Monad
+       [=left (clean t-id left)
+        =right (clean t-id right)]
+       (wrap ( =left =right))))
+    ([#;LambdaT]
+     [#;AppT]
+     [#;ProdT]
+     [#;SumT])
+
+    (^template []
+     ( env body)
+     (do Monad
+       [=env (mapM @ (clean t-id) env)
+        =body (clean t-id body)] ## TODO: DON'T CLEAN THE BODY
+       (wrap ( =env =body))))
+    ([#;UnivQ]
+     [#;ExQ])
+    
+    _
+    (:: Monad wrap type)
+    ))
+
+(def: #export create-var
+  (Check [Id Type])
+  (lambda [context]
+    (let [id (get@ #var-id context)]
+      (#;Right [(|> context
+                    (update@ #var-id inc+)
+                    (update@ #bindings (dict;put id #;None)))
+                [id (#;VarT id)]]))))
+
+(do-template [   ]
+  [(def: 
+     (Check )
+     (lambda [context]
+       (#;Right [context
+                 (get@  context)])))
+
+   (def: ( value)
+     (->  (Check []))
+     (lambda [context]
+       (#;Right [(set@  value context)
+                 []])))]
+
+  [get-bindings  set-bindings  #bindings  (dict;Dict Id (Maybe Type))]
+  [get-fixpoints set-fixpoints #fixpoints Fixpoints]
+  )
+
+(def: #export (delete-var id)
+  (-> Id (Check []))
+  (do Monad
+    [? (bound? id)
+     _ (if ?
+         (wrap [])
+         (do Monad
+           [[ex-id ex] existential]
+           (set-var id ex)))
+     bindings get-bindings
+     bindings' (mapM @
+                     (lambda [(^@ binding [b-id b-type])]
+                       (if (=+ id b-id)
+                         (wrap binding)
+                         (case b-type
+                           #;None
+                           (wrap binding)
+
+                           (#;Some b-type')
+                           (case b-type'
+                             (#;VarT t-id)
+                             (if (=+ id t-id)
+                               (wrap [b-id #;None])
+                               (wrap binding))
+
+                             _
+                             (do Monad
+                               [b-type'' (clean id b-type')]
+                               (wrap [b-id (#;Some b-type'')])))
+                           )))
+                     (dict;entries bindings))]
+    (set-bindings (|> bindings' (dict;from-list number;Hash) (dict;remove id)))))
+
+(def: #export (with-var k)
+  (All [a] (-> (-> [Id Type] (Check a)) (Check a)))
+  (do Monad
+    [[id var] create-var
+     output (k [id var])
+     _ (delete-var id)]
+    (wrap output)))
+
+(def: #export fresh-context
+  Context
+  {#var-id +0
+   #ex-id +0
+   #bindings (dict;new number;Hash)
+   #fixpoints (list)
+   })
+
+(def: (attempt op)
+  (All [a] (-> (Check a) (Check (Maybe a))))
+  (lambda [context]
+    (case (op context)
+      (#;Right [context' output])
+      (#;Right [context' (#;Some output)])
+
+      (#;Left _)
+      (#;Right [context #;None]))))
+
+(def: #export (fail message)
+  (All [a] (-> Text (Check a)))
+  (lambda [context]
+    (#;Left message)))
+
+(def: (fail-check expected actual)
+  (-> Type Type (Check []))
+  (fail (format "Expected: " (type;type-to-text expected) "\n\n"
+                "Actual:   " (type;type-to-text actual))))
+
+(def: success (Check []) (Check/wrap []))
+
+(def: (|| left right)
+  (All [a] (-> (Check a) (Check a) (Check a)))
+  (lambda [context]
+    (case (left context)
+      (#;Right [context' output])
+      (#;Right [context' output])
+
+      (#;Left _)
+      (right context))))
+
+(def: (fp-get [e a] fixpoints)
+  (-> [Type Type] Fixpoints (Maybe Bool))
+  (list;find (lambda [[[fe fa] status]]
+               (if (and (Type/= e fe)
+                        (Type/= a fa))
+                 (#;Some status)
+                 #;None))
+             fixpoints))
+
+(def: (fp-put ea status fixpoints)
+  (-> [Type Type] Bool Fixpoints Fixpoints)
+  (#;Cons [ea status] fixpoints))
+
+(def: #export (check expected actual)
+  (-> Type Type (Check []))
+  (if (== expected actual)
+    success
+    (case [expected actual]
+      [(#;VarT e-id) (#;VarT a-id)]
+      (if (=+ e-id a-id)
+        success
+        (do Monad
+          [ebound (attempt (deref e-id))
+           abound (attempt (deref a-id))]
+          (case [ebound abound]
+            [#;None #;None]
+            (set-var e-id actual)
+            
+            [(#;Some etype) #;None]
+            (check etype actual)
+
+            [#;None (#;Some atype)]
+            (check expected atype)
+
+            [(#;Some etype) (#;Some atype)]
+            (check etype atype))))
+      
+      [(#;VarT id) _]
+      (|| (set-var id actual)
+          (do Monad
+            [bound (deref id)]
+            (check bound actual)))
+      
+      [_ (#;VarT id)]
+      (|| (set-var id expected)
+          (do Monad
+            [bound (deref id)]
+            (check expected bound)))
+
+      [(#;AppT (#;ExT eid) eA) (#;AppT (#;ExT aid) aA)]
+      (if (=+ eid aid)
+        (check eA aA)
+        (fail-check expected actual))
+
+      [(#;AppT (#;VarT id) A1) (#;AppT F2 A2)]
+      (|| (do Monad
+            [F1 (deref id)]
+            (check (#;AppT F1 A1) actual))
+          (do Monad
+            [_ (check (#;VarT id) F2)
+             e' (apply-type! F2 A1)
+             a' (apply-type! F2 A2)]
+            (check e' a')))
+      
+      [(#;AppT F1 A1) (#;AppT (#;VarT id) A2)]
+      (|| (do Monad
+            [F2 (deref id)]
+            (check expected (#;AppT F2 A2)))
+          (do Monad
+            [_ (check F1 (#;VarT id))
+             e' (apply-type! F1 A1)
+             a' (apply-type! F1 A2)]
+            (check e' a')))
+
+      [(#;AppT F A) _]
+      (do Monad
+        [#let [fp-pair [expected actual]]
+         fixpoints get-fixpoints]
+        (case (fp-get fp-pair fixpoints)
+          (#;Some ?)
+          (if ?
+            success
+            (fail-check expected actual))
+
+          #;None
+          (do Monad
+            [expected' (apply-type! F A)
+             _ (set-fixpoints (fp-put fp-pair true fixpoints))]
+            (check expected' actual))))
+
+      [_ (#;AppT F A)]
+      (do Monad
+        [actual' (apply-type! F A)]
+        (check expected actual'))
+
+      [(#;UnivQ _) _]
+      (do Monad
+        [[ex-id ex] existential
+         expected' (apply-type! expected ex)]
+        (check expected' actual))
+
+      [_ (#;UnivQ _)]
+      (with-var
+        (lambda [[var-id var]]
+          (do Monad
+            [actual' (apply-type! actual var)
+             =output (check expected actual')
+             _ (clean var-id expected)]
+            success)))
+
+      [(#;ExQ e!env e!def) _]
+      (with-var
+        (lambda [[var-id var]]
+          (do Monad
+            [expected' (apply-type! expected var)
+             =output (check expected' actual)
+             _ (clean var-id actual)]
+            success)))
+
+      [_ (#;ExQ a!env a!def)]
+      (do Monad
+        [[ex-id ex] existential
+         actual' (apply-type! actual ex)]
+        (check expected actual'))
+
+      [(#;HostT e-name e-params) (#;HostT a-name a-params)]
+      (if (Text/= e-name a-name)
+        (do Monad
+          [_ (mapM Monad
+                   (lambda [[e a]] (check e a))
+                   (list;zip2 e-params a-params))]
+          success)
+        (fail-check expected actual))
+
+      (^template [ ]
+       [ ]
+       success
+       
+       [( eL eR) ( aL aR)]
+       (do Monad
+         [_ (check eL aL)]
+         (check eR aR)))
+      ([#;VoidT #;SumT]
+       [#;UnitT #;ProdT])
+      
+      [(#;LambdaT eI eO) (#;LambdaT aI aO)]
+      (do Monad
+        [_ (check aI eI)]
+        (check eO aO))
+
+      [(#;ExT e!id) (#;ExT a!id)]
+      (if (=+ e!id a!id)
+        success
+        (fail-check expected actual))
+
+      [(#;NamedT _ ?etype) _]
+      (check ?etype actual)
+
+      [_ (#;NamedT _ ?atype)]
+      (check expected ?atype)
+
+      _
+      (fail-check expected actual))))
+
+(def: #export (checks? expected actual)
+  (-> Type Type Bool)
+  (case (run fresh-context (check expected actual))
+    (#;Left error)
+    false
+
+    (#;Right _)
+    true))
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
new file mode 100644
index 000000000..947ec5b6f
--- /dev/null
+++ b/stdlib/test/test/lux.lux
@@ -0,0 +1,164 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  lux/test
+  (lux (control monad)
+       (codata [io])
+       [math]
+       (math ["R" random])
+       (data text/format)
+       [compiler]
+       (macro ["s" syntax #+ syntax:])))
+
+(test: "Every value is identical to itself, and the 'id' function doesn't change values in any way."
+  [value R;int]
+  (assert "" (and (== value value)
+                  (== value (id value)))))
+
+(test: "Values created separately can't be identical."
+  [x R;int
+   y R;int]
+  (match false (== x y)))
+
+(do-template [category rand-gen inc dec even? odd? = < >]
+  [(test: (format "[" category "] " "Moving up-down or down-up should result in same value.")
+     [value rand-gen]
+     (assert "" (and (|> value inc dec (= value))
+                     (|> value dec inc (= value)))))
+
+   (test: (format "[" category "] " "(x+1) > x && (x-1) < x")
+     [value rand-gen]
+     (assert "" (and (|> value inc (> value))
+                     (|> value dec (< value)))))
+
+   (test: (format "[" category "] " "Every odd/even number is surrounded by two of the other kind.")
+     [value rand-gen]
+     (assert ""
+             (if (even? value)
+               (and (|> value inc odd?)
+                    (|> value dec odd?))
+               (and (|> value inc even?)
+                    (|> value dec even?)))))]
+
+  ["Nat" R;nat inc+ dec+ even?+ odd?+ =+ <+ >+]
+  ["Int" R;int inc  dec  even?  odd?  =  <  >]
+  )
+
+(do-template [category rand-gen = < > <= >= min max]
+  [(test: (format "[" category "] " "The symmetry of numerical comparisons.")
+     [x rand-gen
+      y rand-gen]
+     (assert ""
+             (or (= x y)
+                 (if (< y x)
+                   (> x y)
+                   (< x y)))))
+
+   (test: (format "[" category "] " "Minimums and maximums.")
+     [x rand-gen
+      y rand-gen]
+     (assert ""
+             (and (and (<= x (min x y))
+                       (<= y (min x y)))
+                  (and (>= x (max x y))
+                       (>= y (max x y)))
+                  )))]
+
+  ["Int"  R;int  =   <   >   <=   >=   min   max]
+  ["Nat"  R;nat  =+  <+  >+  <=+  >=+  min+  max+]
+  ["Real" R;real =.  <.  >.  <=.  >=.  min.  max.]
+  ["Frac" R;frac =.. <.. >.. <=.. >=.. min.. max..]
+  )
+
+(do-template [category rand-gen = + - * / <%> > <0> <1> <10> %x  ]
+  [(test: (format "[" category "] " "Additive identity")
+     [x rand-gen]
+     (assert ""
+             (and (|> x (+ <0>) (= x))
+                  (|> x (- <0>) (= x)))))
+
+   (test: (format "[" category "] " "Addition & Substraction")
+     [x (:: @ map  rand-gen)
+      y (:: @ map  rand-gen)
+      #let [x (* <10> x)
+            y (* <10> y)
+            cond (and (|> x (- y) (+ y) (= x))
+                      (|> x (+ y) (- y) (= x)))
+            _ (if cond
+                []
+                (exec
+                  (log! "+- SAMPLE")
+                  (log! (format (%x x) " -+ " (%x y) " = " (%x (|> x (- y) (+ y)))))
+                  (log! (format (%x x) " +- " (%x y) " = " (%x (|> x (+ y) (- y)))))))
+            ]]
+     (assert ""
+             (and (|> x (- y) (+ y) (= x))
+                  (|> x (+ y) (- y) (= x)))))
+
+   (test: (format "[" category "] " "Multiplicative identity")
+     [x rand-gen]
+     (assert ""
+             (and (|> x (* <1>) (= x))
+                  (|> x (/ <1>) (= x)))))
+
+   (test: (format "[" category "] " "Multiplication & Division")
+     [x (:: @ map  rand-gen)
+      y (|> rand-gen
+            (:: @ map )
+            (R;filter (|>. (= <0>) not)))
+      #let [r (<%> y x)
+            x' (- r x)]]
+     (assert ""
+             (or (> x' y)
+                 (|> x' (/ y) (* y) (= x')))
+             ))]
+
+  ["Nat"  R;nat  =+ ++ -+ *+ /+ ;%+ >+ +0  +1   +1000000   %n (;%+ +1000) id]
+  ["Int"  R;int  =  +  -  *  /  ;%  >   0   1    1000000   %i (;%   1000) id]
+  ["Real" R;real =. +. -. *. /. ;%. >.  0.0 1.0  1000000.0 %r id          math;floor]
+  )
+
+(do-template [category rand-gen -> <- =  %a %z]
+  [(test: (format "[" category "] " "Numeric conversions")
+     [value rand-gen
+      #let [value ( value)]]
+     (assert ""
+             (|> value -> <- (= value))))]
+
+  ["Int->Nat"  R;int  int-to-nat  nat-to-int  =  (;%  1000000)   %i %n]
+  ["Nat->Int"  R;nat  nat-to-int  int-to-nat  =+ (;%+ +1000000)  %n %i]
+  ["Int->Real" R;int  int-to-real real-to-int =  (;%  1000000)   %i %r]
+  ["Real->Int" R;real real-to-int int-to-real =. math;floor %r %i]
+  ## [R;real real-to-frac frac-to-real =. (;%. 1.0) %r %f]
+  )
+
+(test: "Simple macros and constructs"
+  (all (match ["lux" "yolo"] (ident-for ;yolo))
+       (match ["test/lux" "yolo"] (ident-for ;;yolo))
+       (match ["" "yolo"] (ident-for yolo))
+       (match ["lux/test" "yolo"] (ident-for lux/test;yolo))
+       (match ["lux" "yolo"] (ident-for #;yolo))
+       (match ["test/lux" "yolo"] (ident-for #;;yolo))
+       (match ["" "yolo"] (ident-for #yolo))
+       (match ["lux/test" "yolo"] (ident-for #lux/test;yolo))
+
+       (match 1000 (loop [counter 0
+                          value 1]
+                     (if (< 3 counter)
+                       (recur (inc counter) (* 10 value))
+                       value)))
+
+       (match (^ (list 1 2 3))
+              (list 1 2 3))
+       (match (^ (list 1 2 3 4 5 6))
+              (list& 1 2 3 (list 4 5 6)))
+
+       (match "yolo" (default "yolo"
+                       #;None))
+       (match "lol" (default "yolo"
+                      (#;Some "lol")))
+       ))
diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux
new file mode 100644
index 000000000..c95ec9e9c
--- /dev/null
+++ b/stdlib/test/test/lux/cli.lux
@@ -0,0 +1,84 @@
+(;module:
+  [lux #- not]
+  (lux (codata [io])
+       (control monad)
+       (data text/format
+             [number]
+             [product]
+             [sum])
+       (codata function)
+       [cli #- run])
+  [lux/test #-  assert])
+
+(test: "lux/cli exports"
+  (test-all (match (#;Right "foo")
+                   (cli;run any (list "foo" "bar" "baz")))
+            (match (#;Left _)
+                   (cli;run any (list)))
+            (match (#;Right 123)
+                   (cli;run (parse (:: number;Codec decode) any) (list "123")))
+            (match (#;Left _)
+                   (cli;run (option (list "-p" "--port")) (list)))
+            (match (#;Left _)
+                   (cli;run (option (list "-p" "--port")) (list "yolo")))
+            (match (#;Right "123")
+                   (cli;run (option (list "-p" "--port")) (list "-p" "123")))
+            (match (#;Right "123")
+                   (cli;run (option (list "-p" "--port")) (list "--port" "123")))
+            (match (#;Right false)
+                   (cli;run (flag (list "-h" "--help")) (list)))
+            (match (#;Right false)
+                   (cli;run (flag (list "-h" "--help")) (list "yolo")))
+            (match (#;Right true)
+                   (cli;run (flag (list "-h" "--help")) (list "-h")))
+            (match (#;Right true)
+                   (cli;run (flag (list "-h" "--help")) (list "--help")))
+            (match (#;Right [])
+                   (cli;run end (list)))
+            (match (#;Left _)
+                   (cli;run end (list "yolo")))
+            (match (#;Left "YOLO")
+                   (cli;run (assert false "YOLO") (list "yolo")))
+            (match (#;Right [])
+                   (cli;run (assert true "YOLO") (list "yolo")))
+            (match (#;Right #;None)
+                   (cli;run (opt any) (list)))
+            (match (#;Right (#;Some "yolo"))
+                   (cli;run (opt any) (list "yolo")))
+            (match (#;Right ["foo" "bar"])
+                   (cli;run (seq any any) (list "foo" "bar" "baz")))
+            (match (#;Right ["foo" "bar"])
+                   (cli;run (seq any any) (list "foo" "bar")))
+            (match (#;Left _)
+                   (cli;run (seq any any) (list "foo")))
+            ## (match (#;Right (#;Left 123))
+            ##          (cli;run (alt (parse (:: number;Codec decode) any)
+            ##                       any)
+            ##                   (list "123" "foo")))
+            ## (match (#;Right (#;Right "foo"))
+            ##          (cli;run (alt (parse (:: number;Codec decode) any)
+            ##                       any)
+            ##                   (list "foo")))
+            (match (#;Left _)
+                   (cli;run (alt (parse (:: number;Codec decode) any)
+                                 (parse (:: number;Codec decode) any))
+                            (list "foo")))
+            (match (#;Left _)
+                   (cli;run (not (parse (:: number;Codec decode) any))
+                            (list "123")))
+            (match (#;Right [])
+                   (cli;run (not (parse (:: number;Codec decode) any))
+                            (list "yolo")))
+            (match (^ (#;Right (list "foo" "bar" "baz")))
+                   (cli;run (some any) (list "foo" "bar" "baz")))
+            (match (^ (#;Right (list)))
+                   (cli;run (some any) (list)))
+            (match (^ (#;Right (list "foo" "bar" "baz")))
+                   (cli;run (many any) (list "foo" "bar" "baz")))
+            (match (#;Left _)
+                   (cli;run (many any) (list)))
+            (match (#;Right "yolo")
+                   (cli;run (either (parse sum;right any)
+                                    any)
+                            (list "yolo")))
+            ))
diff --git a/stdlib/test/test/lux/codata/env.lux b/stdlib/test/test/lux/codata/env.lux
new file mode 100644
index 000000000..7a374cd4d
--- /dev/null
+++ b/stdlib/test/test/lux/codata/env.lux
@@ -0,0 +1,23 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             text/format
+             [number])
+       (codata function
+               env))
+  lux/test)
+
+(test: "lux/codata/env exports"
+  (test-all (match 123 (run 123 ask))
+            (match 246 (run 123 (local (* 2) ask)))
+            (match 134 (run 123 (:: Functor map inc (+ 10))))
+            (match 10 (run 123 (:: Applicative wrap 10)))
+            (match 30 (run 123 (let [(^open) Applicative]
+                                 (apply (wrap (+ 10)) (wrap 20)))))
+            (match 30 (run 123 (do Monad
+                                 [f (wrap +)
+                                  x (wrap 10)
+                                  y (wrap 20)]
+                                 (wrap (f x y)))))))
diff --git a/stdlib/test/test/lux/codata/io.lux b/stdlib/test/test/lux/codata/io.lux
new file mode 100644
index 000000000..5d521faff
--- /dev/null
+++ b/stdlib/test/test/lux/codata/io.lux
@@ -0,0 +1,21 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [text "Text/" Monoid]
+             text/format
+             [number])
+       (codata function
+               io))
+  lux/test)
+
+(test: "lux/codata/io exports"
+  (test-all (match "YOLO" (run (io "YOLO")))
+            (match 11 (run (:: Functor map inc (io 10))))
+            (match 10 (run (:: Applicative wrap 10)))
+            (match 30 (run (let [(^open) Applicative]
+                             (apply (wrap (+ 10)) (wrap 20)))))
+            (match 30 (run (do Monad
+                             [f (wrap +)
+                              x (wrap 10)
+                              y (wrap 20)]
+                             (wrap (f x y)))))))
diff --git a/stdlib/test/test/lux/codata/state.lux b/stdlib/test/test/lux/codata/state.lux
new file mode 100644
index 000000000..054b59d45
--- /dev/null
+++ b/stdlib/test/test/lux/codata/state.lux
@@ -0,0 +1,34 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             text/format
+             [number]
+             [product])
+       (codata function
+               state))
+  lux/test)
+
+(test: "lux/codata/state exports"
+  (test-all (match 123 (product;right (run 123 get)))
+            (match 321 (product;right (run 123 (do Monad
+                                                 [_ (put 321)]
+                                                 get))))
+            (match 369 (product;right (run 123 (do Monad
+                                                 [_ (update (* 3))]
+                                                 get))))
+            (match 124 (product;right (run 123 (use inc))))
+            (match 246 (product;right (run 123 (local (* 2) get))))
+            (match 124 (product;right (run 123 (:: Functor map inc get))))
+            (match 10 (product;right (run 123 (:: Applicative wrap 10))))
+            (match 30 (product;right (run 123 (let [(^open) Applicative]
+                                                (apply (wrap (+ 10)) (wrap 20))))))
+            (match 30 (product;right (run 123 (: (State Int Int)
+                                                 (do Monad
+                                                   [f (wrap +)
+                                                    x (wrap 10)
+                                                    y (wrap 20)]
+                                                   
+                                                   (wrap (f x y)))))))
+            ))
diff --git a/stdlib/test/test/lux/codata/struct/stream.lux b/stdlib/test/test/lux/codata/struct/stream.lux
new file mode 100644
index 000000000..28292a405
--- /dev/null
+++ b/stdlib/test/test/lux/codata/struct/stream.lux
@@ -0,0 +1,68 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                comonad)
+       (data [text "Text/" Monoid]
+             text/format
+             [number "Int/" Codec])
+       (codata function
+               [cont]
+               (struct stream)))
+  lux/test)
+
+(test: "lux/codata/stream exports"
+  (let% [ (do-template [   ]
+                             [(match (^ (list 0 1 2))
+                                     (  (iterate inc 0)))
+                              (match (^=> (^stream& w x y z ...)
+                                          {[w x y z] [3 4 5 6]})
+                                     (  (iterate inc 0)))
+                              (match (^=> (^ [(list 0 1 2) _stream_])
+                                          {_stream_ (^stream& w x y z ...)}
+                                          {[w x y z] [3 4 5 6]})
+                                     (  (iterate inc 0)))]
+
+                             [take       drop       split      +3]
+                             [take-while drop-while split-with (< 3)])
+         ]
+    (test-all (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [0 1 2 3]})
+                     (iterate inc 0))
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [0 0 0 0]})
+                     (repeat 0))
+              (match (^=> (#;Some the-stream)
+                          {the-stream (^stream& w x y z ...)}
+                          {[w x y z] [0 1 0 1]})
+                     (cycle (list 0 1)))
+              (match 0 (head (iterate inc 0)))
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [1 2 3 4]})
+                     (tail (iterate inc 0)))
+              (match 9 (at +9 (iterate inc 0)))
+              (match 0 (at +0 (iterate inc 0)))
+              
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] ["0" "1" "2" "3"]})
+                     (unfold (lambda [n] [(inc n) (Int/encode n)])
+                             0))
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [0 2 4 6]})
+                     (filter even? (iterate inc 0)))
+              (match (^=> [e_stream o_stream]
+                          {e_stream (^stream& w x y z ...)}
+                          {o_stream (^stream& a b c d ...)}
+                          {[w x y z a b c d] [0 2 4 6 1 3 5 7]})
+                     (partition even? (iterate inc 0)))
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [0 1 4 9]})
+                     (let [square (lambda [n] (* n n))]
+                       (:: Functor map square (iterate inc 0))))
+              (match (^=> (^stream& w x y z ...)
+                          {[w x y z] [4 9 16 25]})
+                     (let [square (lambda [n] (* n n))]
+                       (be CoMonad
+                         [inputs (iterate inc 2)]
+                         (square (head inputs)))))
+              )))
diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux
new file mode 100644
index 000000000..e9a19e8ea
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/actor.lux
@@ -0,0 +1,70 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [number]
+             text/format
+             error)
+       (concurrency [promise #+ Promise Monad "Promise/" Monad]
+                    actor)
+       (codata function
+               [io #- run]))
+  lux/test)
+
+(actor: Adder
+  Int
+
+  (method: (add! {offset Int})
+    [Int Int]
+    (let [*state*' (+ offset *state*)]
+      (wrap (#;Right [*state*' [*state* *state*']]))))
+  
+  (stop:
+    (exec (log! (format "Cause of death: " (default "???" *cause*)))
+      (log! (format "Current state: " (%i *state*)))
+      (wrap []))))
+
+(test: "lux/concurrency/actor exports"
+  (let [counter-proc (: (Proc Int (Promise Int))
+                        [(lambda [self output state]
+                           (let [state' (inc state)]
+                             (exec (io;run (promise;resolve state' output))
+                               (Promise/wrap (#;Right state')))))
+                         (lambda [?error state] (Promise/wrap []))])]
+    (test-all (match true
+                     (let [counter (: (Actor Int (Promise Int))
+                                      (io;run (spawn 0 counter-proc)))]
+                       (alive? counter)))
+              (match [true false]
+                     (let [counter (: (Actor Int (Promise Int))
+                                      (io;run (spawn 0 counter-proc)))]
+                       [(io;run (poison counter))
+                        (alive? counter)]))
+              (match [true false]
+                     (let [counter (: (Actor Int (Promise Int))
+                                      (io;run (spawn 0 counter-proc)))]
+                       [(io;run (poison counter))
+                        (io;run (poison counter))]))
+              (match+ [1 2 3]
+                      (do Monad
+                        [#let [counter (: (Actor Int (Promise Int))
+                                          (io;run (spawn 0 counter-proc)))
+                               output-1 (: (Promise Int) (promise;promise))
+                               output-2 (: (Promise Int) (promise;promise))
+                               output-3 (: (Promise Int) (promise;promise))]
+                         ?1 (send output-1 counter)
+                         ?2 (send output-2 counter)
+                         ?3 (send output-3 counter)]
+                        (if (and ?1 ?2 ?3)
+                          (from-promise ($_ promise;seq output-1 output-2 output-3))
+                          (wrap (#;Left "Uh, oh...")))))
+              (match+ [[0 1] [1 3] [3 6]]
+                      (do Monad
+                        [#let [adder (: Adder
+                                        (io;run (spawn 0 Adder//new)))]
+                         t1 (add! 1 adder)
+                         t2 (add! 2 adder)
+                         t3 (add! 3 adder)
+                         #let [? (io;run (poison adder))]]
+                        (wrap (#;Right [t1 t2 t3]))
+                        ))
+              )))
diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux
new file mode 100644
index 000000000..62ca0b57d
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/frp.lux
@@ -0,0 +1,54 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [number]
+             text/format
+             error)
+       (concurrency [promise #+ Promise Monad "Promise/" Monad]
+                    frp)
+       (codata function
+               io))
+  lux/test)
+
+(def: (List->Chan values)
+  (-> (List Int) (Chan Int))
+  (let [_chan (: (Chan Int) (chan))]
+    (run (do Monad
+           [_ (mapM Monad
+                    (lambda [value]
+                      (write value _chan))
+                    values)
+            _ (close _chan)]
+           (wrap _chan)))))
+
+(test: "lux/concurrency/frp exports"
+  (test-all (match+ (^ (list 0 1 2 3 4 5))
+                    (from-promise (consume (List->Chan (list 0 1 2 3 4 5)))))
+            (match+ (^ (list 0 1 2 3 4 5))
+                    (from-promise (consume (let [input (List->Chan (list 0 1 2 3 4 5))
+                                               output (: (Chan Int) (chan))]
+                                           (exec (pipe input output)
+                                             output)))))
+            (match+ (^ (list 0 2 4))
+                    (from-promise (consume (filter even? (List->Chan (list 0 1 2 3 4 5))))))
+            (match+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5))
+                    (from-promise (consume (merge (list (List->Chan (list 0 1 2 3 4 5))
+                                                      (List->Chan (list 0 -1 -2 -3 -4 -5)))))))
+            (match+ 15 (from-promise (fold (lambda [base input] (Promise/wrap (+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))))
+            (match+ (^ (list 0 1 2 3 4 5))
+                    (from-promise (consume (no-dups number;Eq (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))))
+            (match+ (^ (list 12345))
+                    (from-promise (consume (as-chan (:: promise;Monad wrap 12345)))))
+            (match+ (^ (list 1 2 3 4 5 6))
+                    (from-promise (consume (:: Functor map inc (List->Chan (list 0 1 2 3 4 5))))))
+            (match+ (^ (list 12345))
+                    (from-promise (consume (:: Applicative wrap 12345))))
+            (match+ (^ (list 12346))
+                    (from-promise (consume (let [(^open) Applicative]
+                                           (apply (wrap inc) (wrap 12345))))))
+            (match+ (^ (list 12346))
+                    (from-promise (consume (do Monad
+                                           [f (wrap inc)
+                                            a (wrap 12345)]
+                                           (wrap (f a))))))
+            ))
diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux
new file mode 100644
index 000000000..77e5a0aed
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/promise.lux
@@ -0,0 +1,31 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [number]
+             text/format
+             error)
+       (concurrency promise)
+       (codata function
+               [io #*]))
+  lux/test)
+
+(test: "lux/concurrency/promise exports"
+  (test-all (match+ true (from-promise (future (io true))))
+            (match+ [] (from-promise (wait +500)))
+            (match+ [true false] (from-promise (seq (future (io true))
+                                                  (future (io false)))))
+            (match+ (#;Left true) (from-promise (alt (delay +100 true)
+                                                   (delay +200 false))))
+            (match+ (#;Right false) (from-promise (alt (delay +200 true)
+                                                     (delay +100 false))))
+            (match+ true (from-promise (either (delay +100 true)
+                                             (delay +200 false))))
+            (match+ false (from-promise (either (delay +200 true)
+                                              (delay +100 false))))
+            (match (#;Some true) (poll (:: Monad wrap true)))
+            (match #;None (poll (delay +200 true)))
+            (match false (io;run (resolve false (:: Monad wrap true))))
+            (match true (io;run (resolve true (: (Promise Bool) (promise)))))
+            (match+ #;None (from-promise (time-out +100 (delay +200 true))))
+            (match+ (#;Some true) (from-promise (time-out +200 (delay +100 true))))
+            ))
diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux
new file mode 100644
index 000000000..e29a5294b
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/stm.lux
@@ -0,0 +1,57 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [number]
+             (struct [list "" Functor])
+             text/format)
+       (concurrency stm
+                    [promise])
+       (codata function))
+  lux/test)
+
+(def: vars Int 5)
+(def: processes/vars Int 5)
+(def: iterations/processes Int 100)
+
+(test: "lux/concurrency/stm exports"
+  (let [_var (var 0)
+        changes (io;run (follow "test" _var))
+        tests (: (List (Test Int))
+                 (map (lambda [_]
+                        (let [_concurrency-var (var 0)]
+                          (from-promise (do promise;Monad
+                                          [_ (seqM @
+                                                   (map (lambda [_]
+                                                          (mapM @ (lambda [_] (commit (update inc _concurrency-var)))
+                                                                (list;range 1 iterations/processes)))
+                                                        (list;range 1 processes/vars)))]
+                                          (commit (read _concurrency-var))))))
+                      (list;range 1 vars)))]
+    (test-all (match+ 0 (commit (do Monad
+                                  [value (read _var)]
+                                  (wrap (#;Right value)))))
+              (match+ 5 (commit (do Monad
+                                  [_ (write 5 _var)
+                                   value (read _var)]
+                                  (wrap (#;Right value)))))
+              (match+ 5 (commit (do Monad
+                                  [value (read _var)]
+                                  (wrap (#;Right value)))))
+              (match+ 15 (commit (do Monad
+                                   [_ (update (* 3) _var)
+                                    value (read _var)]
+                                   (wrap (#;Right value)))))
+              (match+ 15 (commit (do Monad
+                                   [value (read _var)]
+                                   (wrap (#;Right value)))))
+              (match+ [5 15] (do promise;Monad
+                               [?c1+changes' changes
+                                #let [[c1 changes'] (default [-1 changes] ?c1+changes')]
+                                ?c2+changes' changes'
+                                #let [[c2 changes'] (default [-1 changes] ?c2+changes')]]
+                               (wrap (#;Right [c1 c2]))))
+              ## Temporarily commented-out due to type-checking bug in
+              ## compiler...
+              ## (match+ _ (seqM Monad tests))
+              )))
diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux
new file mode 100644
index 000000000..e20027818
--- /dev/null
+++ b/stdlib/test/test/lux/data/bit.lux
@@ -0,0 +1,65 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control [monad])
+       (codata [io])
+       (data ["&" bit]
+             number)
+       (math ["R" random]))
+  lux/test)
+
+(def: width Nat +64)
+
+(test: "Bitwise operations."
+  [pattern R;nat
+   idx (:: @ map (%+ width) R;nat)]
+  (all (assert "" (and (<+ (&;count (&;set idx pattern))
+                           (&;count (&;clear idx pattern)))
+                       (<=+ (&;count pattern)
+                            (&;count (&;clear idx pattern)))
+                       (>=+ (&;count pattern)
+                            (&;count (&;set idx pattern)))
+
+                       (or (and (&;set? idx pattern)
+                                (not (&;set? idx (&;clear idx pattern))))
+                           (and (not (&;set? idx pattern))
+                                (&;set? idx (&;set idx pattern))))
+
+                       (or (and (&;set? idx pattern)
+                                (not (&;set? idx (&;flip idx pattern))))
+                           (and (not (&;set? idx pattern))
+                                (&;set? idx (&;flip idx pattern))))
+                       
+                       (=+ width
+                           (++ (&;count pattern)
+                               (&;count (&;~ pattern))))
+
+                       (=+ +0
+                           (&;& pattern
+                                (&;~ pattern)))
+                       (=+ (&;~ +0)
+                           (&;| pattern
+                                (&;~ pattern)))
+                       (=+ (&;~ +0)
+                           (&;^ pattern
+                                (&;~ pattern)))
+                       (=+ +0
+                           (&;^ pattern
+                                pattern))
+
+                       (|> pattern (&;rotate-left idx) (&;rotate-right idx) (=+ pattern))
+                       (|> pattern (&;rotate-right idx) (&;rotate-left idx) (=+ pattern))
+                       (|> pattern (&;rotate-left idx) (&;rotate-left (-+ idx width)) (=+ pattern))
+                       (|> pattern (&;rotate-right idx) (&;rotate-right (-+ idx width)) (=+ pattern))
+                       ))
+       
+       (assert "Shift right respect the sign of ints."
+               (let [value (nat-to-int pattern)]
+                 (if (< 0 value)
+                   (< 0 (&;>> idx value))
+                   (>= 0 (&;>> idx value)))))
+       ))
diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux
new file mode 100644
index 000000000..218846e2e
--- /dev/null
+++ b/stdlib/test/test/lux/data/bool.lux
@@ -0,0 +1,38 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control [monad])
+       (codata [io])
+       (data bool)
+       (math ["R" random]))
+  lux/test)
+
+(test: "Boolean operations."
+  [value R;bool]
+  (assert "" (and (not (and value (not value)))
+                  (or value (not value))
+
+                  (not (:: Or@Monoid unit))
+                  (:: Or@Monoid append value (not value))
+                  (:: And@Monoid unit)
+                  (not (:: And@Monoid append value (not value)))
+                  
+                  (:: Eq = value (not (not value)))
+                  (not (:: Eq = value (not value)))
+
+                  (not (:: Eq = value ((complement id) value)))
+                  (:: Eq = value ((complement not) value))
+
+                  (case (|> value
+                            (:: Codec encode)
+                            (:: Codec decode))
+                    (#;Right dec-value)
+                    (:: Eq = value dec-value)
+
+                    (#;Left _)
+                    false)
+                  )))
diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux
new file mode 100644
index 000000000..ab2e84d59
--- /dev/null
+++ b/stdlib/test/test/lux/data/char.lux
@@ -0,0 +1,47 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control [monad])
+       (codata [io])
+       (data char
+             [text])
+       (math ["R" random])
+       pipe
+       [host #- try])
+  lux/test)
+
+(test: "Char operations"
+  [value R;char]
+  (assert "" (and (:: Eq = value value)
+                  (|> value code char (:: Eq = value))
+                  (|> value
+                      (:: Codec encode)
+                      (:: Codec decode)
+                      (case> (#;Right dec-value)
+                             (:: Eq = value dec-value)
+
+                             (#;Left _)
+                             false))
+                  (|> value as-text
+                      (text;at +0) (default (undefined))
+                      (:: Eq = value))
+                  (|> value as-text text;upper-case
+                      (text;at +0) (default (undefined))
+                      (:: Ord <= value))
+                  (|> value as-text text;lower-case
+                      (text;at +0) (default (undefined))
+                      (:: Ord >= value))
+                  )))
+
+(test: "Special cases"
+  (all (assert "" (space? #" "))
+       (assert "" (space? #"\n"))
+       (assert "" (space? #"\t"))
+       (assert "" (space? #"\r"))
+       (assert "" (space? #"\f"))
+       (assert "" (not (space? #"a")))
+       ))
diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux
new file mode 100644
index 000000000..a1d2cb6ff
--- /dev/null
+++ b/stdlib/test/test/lux/data/error.lux
@@ -0,0 +1,42 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data error))
+  lux/test)
+
+(test: "lux/data/error exports"
+  (all (match (#;Right 11)
+              (:: Functor map inc (: (Error Int)
+                                            (#;Right 10))))
+       (match (#;Left "YOLO")
+              (:: Functor map inc (: (Error Int)
+                                            (#;Left "YOLO"))))
+       
+       (match (#;Right 20)
+              (:: Applicative wrap 20))
+       (match (#;Right 11)
+              (let [(^open) Applicative]
+                (apply (wrap inc) (wrap 10))))
+       (match (#;Left "YOLO")
+              (let [(^open) Applicative]
+                (apply (wrap inc) (#;Left "YOLO"))))
+       
+       (match (#;Right 30)
+              (do Monad
+                [f (wrap +)
+                 a (wrap 10)
+                 b (wrap 20)]
+                (wrap (f a b))))
+       (match (#;Left "YOLO")
+              (do Monad
+                [f (wrap +)
+                 a (#;Left "YOLO")
+                 b (wrap 20)]
+                (wrap (f a b))))
+       ))
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
new file mode 100644
index 000000000..78b0b1a76
--- /dev/null
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -0,0 +1,314 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             text/format
+             error
+             (format [json #* "JSON/" Eq Codec])
+             (struct [vector #+ vector]
+                     [dict]))
+       [compiler #+ with-gensyms]
+       (macro [ast]
+              [syntax #+ syntax:]
+              [poly #+ derived:])
+       [pipe]
+       test)
+  )
+
+## [Utils]
+(syntax: (reads-to-itself expr)
+  (with-gensyms [g!json g!parsed g!message]
+    (wrap (list (` (: (Test Unit)
+                      (let [(~ g!json) (~ expr)]
+                        (case (|> (~ g!json) JSON/encode JSON/decode)
+                          (#;Left (~ g!message))
+                          (fail (~ g!message))
+
+                          (#;Right (~ g!parsed))
+                          (if (JSON/= (~ g!json) (~ g!parsed))
+                            (~ (' (:: Monad wrap [])))
+                            (fail (format "Expression does not parse to itself: " (~ (ast;text (ast;ast-to-text expr)))
+                                          "\n\nWhich is: " (|> (~ g!json) JSON/encode)
+                                          "\n\nInstead, it parsed to: " (JSON/encode (~ g!parsed))))
+                            ))))
+                   )))))
+
+## [Tests]
+## (derived: (Codec ;Bool))
+## (derived: (Codec ;Int))
+## (derived: (Codec ;Real))
+## (derived: (Codec ;Char))
+## (derived: (Codec ;Text))
+
+## (type: Int-List (List Int))
+## (derived: (Codec ;;Int-List))
+
+## (type: Int-Maybe (Maybe Int))
+## (derived: (Codec ;;Int-Maybe))
+
+## (type: Triple [Bool Int Text])
+## (derived: (Codec ;;Triple))
+
+## (type: User
+##   {#alive? Bool
+##    #age Int
+##    #name Text})
+## (derived: (Codec ;;User))
+
+## (type: Options
+##   (#One Bool)
+##   (#Two Int)
+##   (#Three Text))
+## (derived: (Codec ;;Options))
+
+## (test: "Auto-generated codecs"
+##   (let% [ (do-template [  ]
+##                    [(match 
+##                            (|> 
+##                                (::  encode)
+##                                JSON/encode))
+##                     (match+ 
+##                             (should-pass (|> (JSON/decode )
+##                                              (pipe;%> Error/Monad
+##                                                       [(::  decode)]))))]
+
+##                    [true   "true"     Codec]
+##                    [123    "123.0"    Codec]
+##                    [123.45 "123.45"   Codec]
+##                    [#"a"   "\"a\""    Codec]
+##                    ["yolo" "\"yolo\"" Codec]
+
+##                    [(#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) "[1.0,2.0,3.0]" Codec]
+##                    [#;Nil "[]" Codec]
+##                    [(#;Some 1) "1.0" Codec]
+##                    [#;None "null" Codec]
+##                    [[false 456 "lol"] "[false,456.0,\"lol\"]" Codec]
+##                    [{#alive? true #age 25 #name "Eduardo Julian"}
+##                     "{\"alive?\":true,\"age\":25.0,\"name\":\"Eduardo Julian\"}"
+##                     Codec]
+##                    [(#One true) "[\"One\",true]" Codec]
+##                    [(#Two 123) "[\"Two\",123.0]" Codec]
+##                    [(#Three "yolo") "[\"Three\",\"yolo\"]" Codec]
+##                    )]
+##     (test-all 
+##               )))
+
+(test: "Basics"
+  (test-all (match #json;Null
+                   null)
+
+            (match (#json;Boolean true)
+                   (gen-boolean true))
+
+            (match (#json;Boolean false)
+                   (gen-boolean false))
+
+            (match (#json;Number 123.45)
+                   (gen-number 123.45))
+
+            (match (#json;String "YOLO")
+                   (gen-string "YOLO"))
+
+            ## (match (^ (#json;Array (list (#json;Boolean true) (#json;Number 123.45) (#json;String "YOLO"))))
+            ##        (json [(gen-boolean true) (gen-number 123.45) (gen-string "YOLO")]))
+
+            ## (match (^ (#json;Object (list ["yolo" (#json;Boolean true)]
+            ##                               ["lol" (#json;Number 123.45)])))
+            ##        (json {"yolo" (gen-boolean true)
+            ##                    "lol" (gen-number 123.45)}))
+
+            (match (#;Some (#json;Boolean true))
+                   (get "yolo" (json {"yolo" true
+                                      "lol" 123.45})))
+
+            (match (#;Left _)
+                   (get "yolo" (json {})))
+
+            ## (match (^ (#;Some (#json;Object (list ["lol" (#json;Number 123.45)]
+            ##                                       ["yolo" (#json;Boolean true)]))))
+            ##        (|> (json {"yolo" (gen-boolean true)})
+            ##            (set "lol" (gen-number 123.45))))
+
+            (match (#;Right true)
+                   (get-boolean "value" (json {"value" true})))
+
+            (match (#;Right 123.45)
+                   (get-number "value" (json {"value" 123.45})))
+
+            (match (#;Right "YOLO")
+                   (get-string "value" (json {"value" "YOLO"})))
+
+            ## (match (^ (#;Right (list (#json;Boolean true) (#json;Number 123.45) (#json;String "YOLO"))))
+            ##        (get-array "value" (json {"value" (json [(gen-boolean true)
+            ##                                                           (gen-number 123.45)
+            ##                                                           (gen-string "YOLO")])})))
+
+            ## (match (^ (#;Right (list ["yolo" (#json;Boolean true)]
+            ##                          ["lol" (#json;Number 123.45)])))
+            ##        (get-object "value" (json {"value" (json {"yolo" (gen-boolean true)
+            ##                                                            "lol" (gen-number 123.45)})})))
+
+            (match (#;Left _)
+                   (get-array "value" (json {})))
+
+            (match (#;Left _)
+                   (get-array "value" (gen-boolean true)))
+            ))
+
+(test: "Encoding"
+  (test-all (match "null"
+                   (JSON/encode (json #null)))
+
+            (match "123.0"
+                   (JSON/encode (json 123)))
+
+            (match "123.46"
+                   (JSON/encode (json 123.46)))
+
+            (match "true"
+                   (JSON/encode (json true)))
+
+            (match "false"
+                   (JSON/encode (json false)))
+
+            (match "\"YOLO\""
+                   (JSON/encode (json "YOLO")))
+
+            (match "[null,123.46,true,\"YOLO\",[\"nyan\",\"cat\"]]"
+                   (JSON/encode (json [#null 123.46 true "YOLO" ["nyan" "cat"]])))
+
+            (match "{\"foo\":\"bar\",\"baz\":null,\"quux\":[\"nyan\",{\"cat\":\"meme\"}]}"
+                   (JSON/encode (json {"foo" "bar"
+                                       "baz" #null
+                                       "quux" ["nyan" {"cat" "meme"}]})))
+            ))
+
+(test: "Decoding"
+  (test-all (reads-to-itself (json #null))
+            (reads-to-itself (json 123))
+            (reads-to-itself (json 123.46))
+            (reads-to-itself (json true))
+            (reads-to-itself (json false))
+            (reads-to-itself (json "\tY\"OLO\n"))
+            (reads-to-itself (json [#null 123.46 true "YOLO" ["nyan" "cat"]]))
+            (reads-to-itself (json {"foo" "bar"
+                                    "baz" #null
+                                    "quux" ["nyan" {"cat" "meme"}]}))
+            ))
+
+(test: "Parser"
+  (test-all (should-pass (run unit
+                              (json #null)))
+            (should-fail (run unit
+                              (json 123)))
+
+            (match+ 123.45
+                    (should-pass (run real
+                                      (json 123.45))))
+            (should-fail (run real
+                              (json #null)))
+
+            (match+ 123
+                    (should-pass (run int
+                                      (json 123))))
+            (should-fail (run int
+                              (json #null)))
+
+            (match+ true
+                    (should-pass (run bool
+                                      (json true))))
+            (should-fail (run bool
+                              (json 123)))
+
+            (match+ "YOLO"
+                    (should-pass (run text
+                                      (json "YOLO"))))
+            (should-fail (run text
+                              (json 123)))
+
+            (match+ (^ (list "YOLO" "LOL" "MEME"))
+                    (should-pass (run (array text)
+                                      (json ["YOLO" "LOL" "MEME"]))))
+            (should-fail (run (array text)
+                              (json 123)))
+
+            (match+ "LOL"
+                    (should-pass (run (at +1 text)
+                                      (json ["YOLO" "LOL" "MEME"]))))
+            (should-fail (run (array text)
+                              (json 123)))
+
+            (match+ "MEME"
+                    (should-pass (run (field "baz" text)
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (should-fail (run (field "baz" text)
+                              (json 123)))
+
+            (match+ (#json;Number 123.0)
+                    (should-pass (run any
+                                      (json 123))))
+
+            (match+ ["YOLO" "MEME"]
+                    (should-pass (run (seq (field "foo" text)
+                                           (field "baz" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (should-fail (run (seq (field "foo" text)
+                                   (field "baz" text))
+                              (json {"foo" "YOLO"
+                                     "bar" "LOL"})))
+
+            (match+ (#;Left "YOLO")
+                    (should-pass (run (alt (field "foo" text)
+                                           (field "baz" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (match+ (#;Right "MEME")
+                    (should-pass (run (alt (field "fool" text)
+                                           (field "baz" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (should-fail (run (alt (field "fool" text)
+                                   (field "baz" text))
+                              (json {"foo" "YOLO"
+                                     "bar" "LOL"})))
+
+            (match+ "YOLO"
+                    (should-pass (run (either (field "foo" text)
+                                              (field "baz" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (match+ "MEME"
+                    (should-pass (run (either (field "fool" text)
+                                              (field "baz" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (should-fail (run (either (field "fool" text)
+                                      (field "baz" text))
+                              (json {"foo" "YOLO"
+                                     "bar" "LOL"})))
+
+            (match+ (#;Some "YOLO")
+                    (should-pass (run (opt (field "foo" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            (match+ #;None
+                    (should-pass (run (opt (field "fool" text))
+                                      (json {"foo" "YOLO"
+                                             "bar" "LOL"
+                                             "baz" "MEME"}))))
+            ))
diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux
new file mode 100644
index 000000000..8cb85175f
--- /dev/null
+++ b/stdlib/test/test/lux/data/ident.lux
@@ -0,0 +1,53 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data ["&" ident]
+             [text "Text/" Eq])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(test: "Idents"
+  [## First Ident
+   sizeM1 (|> R;nat (:: @ map (%+ +100)))
+   sizeN1 (|> R;nat (:: @ map (%+ +100)))
+   module1 (R;text sizeM1)
+   name1 (R;text sizeN1)
+   #let [ident1 [module1 name1]]
+   ## Second Ident
+   sizeM2 (|> R;nat (:: @ map (%+ +100)))
+   sizeN2 (|> R;nat (:: @ map (%+ +100)))
+   module2 (R;text sizeM2)
+   name2 (R;text sizeN2)
+   #let [ident2 [module2 name2]]
+   #let [(^open "&/") &;Eq
+         (^open "&/") &;Codec]]
+  (all (assert "Can get the module & name parts of an ident."
+               (and (== module1 (&;module ident1))
+                    (== name1 (&;name ident1))))
+
+       (assert "Can compare idents for equality."
+               (and (&/= ident1 ident1)
+                    (if (&/= ident1 ident2)
+                      (and (Text/= module1 module2)
+                           (Text/= name1 name2))
+                      (or (not (Text/= module1 module2))
+                          (not (Text/= name1 name2))))))
+
+       (assert "Can encode idents as text."
+               (|> ident1
+                   &/encode &/decode
+                   (case> (#;Right dec-ident) (&/= ident1 dec-ident)
+                          _ false)))
+
+       (assert "Encoding an ident without a module component results in text equal to the name of the ident."
+               (if (text;empty? module1)
+                 (Text/= name1 (&/encode ident1))
+                 true))
+       ))
diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux
new file mode 100644
index 000000000..f492a801e
--- /dev/null
+++ b/stdlib/test/test/lux/data/identity.lux
@@ -0,0 +1,36 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                comonad)
+       (data identity
+             [text "Text/" Monoid]))
+  lux/test)
+
+(test: "lux/data/identity exports"
+  (all (match "yololol" (:: Functor map (Text/append "yolo") "lol"))
+       
+       (match "yolo" (:: Applicative wrap "yolo"))
+       (match "yololol" (let [(^open) Applicative]
+                          (apply (wrap (Text/append "yolo")) (wrap "lol"))))
+       
+       (match "yololol"
+              (do Monad
+                [f (wrap Text/append)
+                 a (wrap "yolo")
+                 b (wrap "lol")]
+                (wrap (f a b))))
+       
+       (match "yololol" (:: CoMonad unwrap "yololol"))
+       (match "yololol"
+              (be CoMonad
+                [f Text/append
+                 a "yolo"
+                 b "lol"]
+                (f a b)))
+       ))
diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux
new file mode 100644
index 000000000..c052a29da
--- /dev/null
+++ b/stdlib/test/test/lux/data/log.lux
@@ -0,0 +1,32 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data log
+             [text "Text/" Monoid]
+             [number])
+       (codata function))
+  lux/test)
+
+(test: "lux/data/log exports"
+  (all (match ["" 11]
+              (:: Functor map inc ["" 10]))
+       (match ["" 20]
+              (:: (Applicative text;Monoid) wrap 20))
+       (match ["" 30]
+              (let [(^open) (Applicative text;Monoid)]
+                (apply (wrap (+ 10)) (wrap 20))))
+       (match ["" 30]
+              (do (Monad text;Monoid)
+                [f (wrap +)
+                 a (wrap 10)
+                 b (wrap 20)]
+                (wrap (f a b))))
+       (match ["YOLO" []]
+              (log "YOLO"))
+       ))
diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux
new file mode 100644
index 000000000..bd44593d7
--- /dev/null
+++ b/stdlib/test/test/lux/data/maybe.lux
@@ -0,0 +1,49 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data maybe
+             [text "Text/" Monoid]
+             [number]))
+  lux/test)
+
+(test: "lux/data/maybe exports"
+  (all (match #;None (:: Monoid unit))
+       (match (#;Some "yolo") (:: Monoid append (#;Some "yolo") (#;Some "lol")))
+       (match (#;Some "yolo") (:: Monoid append (#;Some "yolo") #;None))
+       (match (#;Some "lol") (:: Monoid append #;None (#;Some "lol")))
+       (match #;None (: (Maybe Text) (:: Monoid append #;None #;None)))
+       
+       (match #;None (:: Functor map (Text/append "yolo") #;None))
+       (match (#;Some "yololol") (:: Functor map (Text/append "yolo") (#;Some "lol")))
+       
+       (match (#;Some "yolo") (:: Applicative wrap "yolo"))
+       (match (#;Some "yololol")
+              (let [(^open) Applicative]
+                (apply (wrap (Text/append "yolo")) (wrap "lol"))))
+       
+       (match (#;Some "yololol")
+              (do Monad
+                [f (wrap Text/append)
+                 a (wrap "yolo")
+                 b (wrap "lol")]
+                (wrap (f a b))))
+
+       (match true (:: (Eq text;Eq) =
+                       (: (Maybe Text) #;None)
+                       (: (Maybe Text) #;None)))
+       (match true (:: (Eq text;Eq) =
+                       (#;Some "yolo")
+                       (#;Some "yolo")))
+       (match false (:: (Eq text;Eq) =
+                        (#;Some "yolo")
+                        (#;Some "lol")))
+       (match false (:: (Eq text;Eq) =
+                        (#;Some "yolo")
+                        (: (Maybe Text) #;None)))
+       ))
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
new file mode 100644
index 000000000..adefb480a
--- /dev/null
+++ b/stdlib/test/test/lux/data/number.lux
@@ -0,0 +1,135 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data number
+             [text "Text/" Monoid]
+             text/format)
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(do-template [category rand-gen  ]
+  [(test: (format "[" category "] " "Eq & Ord")
+     [x rand-gen
+      y rand-gen]
+     (assert "" (and (::  = x x)
+                     (or (::  = x y)
+                         (::  < y x)
+                         (::  > y x)))))]
+
+  ["Nat"  R;nat  Eq  Ord]
+  ["Int"  R;int  Eq  Ord]
+  ["Real" R;real Eq Ord]
+  ["Frac" R;frac Eq Ord]
+  )
+
+(do-template [category rand-gen ]
+  [(test: (format "[" category "] " "Number")
+     [x rand-gen]
+     (assert "" (let [(^open) ]
+                  (and (>= x (abs x))
+                       (<= x (negate (abs x)))
+                       (= x (* (signum x)
+                               (abs x)))))))]
+
+  ["Nat"  R;nat  Number]
+  ["Int"  R;int  Number]
+  ["Real" R;real Number]
+  )
+
+(do-template [category rand-gen  ]
+  [(test: (format "[" category "] " "Enum")
+     [x rand-gen]
+     (assert "" (let [(^open) ]
+                  (and (> x
+                          (::  succ x))
+                       (< x
+                          (::  pred x))
+                       
+                       (= x
+                          (|> x (::  pred) (::  succ)))
+                       (= x
+                          (|> x (::  succ) (::  pred)))
+                       ))))]
+
+  ["Nat"  R;nat Enum Number]
+  ["Int"  R;int Enum Number]
+  )
+
+(do-template [category rand-gen  ]
+  [(test: (format "[" category "] " "Bounded")
+     [x rand-gen]
+     (assert "" (let [(^open) ]
+                  (and (<= x (::  bottom))
+                       (>= x (::  top))
+                       ))))]
+
+  ["Nat"  R;nat  Number  Bounded]
+  ["Int"  R;int  Number  Bounded]
+  ["Real" R;real Number Bounded]
+  )
+
+(do-template [category rand-gen   ]
+  [(test: (format "[" category "] " "Monoid")
+     [x (:: @ map (|>. (::  abs) ) rand-gen)]
+     (assert "" (let [(^open) 
+                      (^open) ]
+                  (and (= x (append unit x))
+                       (= x (append x unit))
+                       (= unit (append unit unit))
+                       (>= x (append x x))))))]
+
+  ["Nat/Add"  R;nat  Number  Add@Monoid  (;%+ +1000)]
+  ["Nat/Mul"  R;nat  Number  Mul@Monoid  (;%+ +1000)]
+  ["Nat/Min"  R;nat  Number  Min@Monoid  (;%+ +1000)]
+  ["Nat/Max"  R;nat  Number  Max@Monoid  (;%+ +1000)]
+  ["Int/Add"  R;int  Number  Add@Monoid  (;% 1000)]
+  ["Int/Mul"  R;int  Number  Mul@Monoid  (;% 1000)]
+  ["Int/Min"  R;int  Number  Min@Monoid  (;% 1000)]
+  ["Int/Max"  R;int  Number  Max@Monoid  (;% 1000)]
+  ["Real/Add" R;real Number Add@Monoid (;%. 1000.0)]
+  ["Real/Mul" R;real Number Mul@Monoid (;%. 1000.0)]
+  ["Real/Min" R;real Number Min@Monoid (;%. 1000.0)]
+  ["Real/Max" R;real Number Max@Monoid (;%. 1000.0)]
+  )
+
+(do-template [category rand-gen  ]
+  [(test: (format "[" category "] " "Codec")
+     [x rand-gen]
+     (assert "" (|> x
+                    (::  encode)
+                    (::  decode)
+                    (case> (#;Right x')
+                           (::  = x x')
+
+                           (#;Left _)
+                           false))))]
+
+  ["Nat"  R;nat  Number  Codec]
+  ["Int"  R;int  Number  Codec]
+  ["Real" R;real Number Codec]
+  ## ["Frac" R;frac Number Codec]
+  )
+
+(do-template [category rand-gen  ]
+  [(test: (format "[" category "] " "Alternative formats")
+     [x rand-gen]
+     (assert "" (|> x
+                    (::  encode)
+                    (::  decode)
+                    (case> (#;Right x')
+                           (::  = x x')
+
+                           (#;Left _)
+                           false))))]
+
+  ["Nat/Binary" R;nat  Number  Binary@Codec]
+  ["Nat/Octal"  R;nat  Number  Octal@Codec]
+  ["Nat/Hex"    R;nat  Number  Hex@Codec]
+  )
diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux
new file mode 100644
index 000000000..51c23e47d
--- /dev/null
+++ b/stdlib/test/test/lux/data/product.lux
@@ -0,0 +1,20 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data product
+             [text "Text/" Monoid]
+             [number])
+       (codata function))
+  lux/test)
+
+(test: "Product operations"
+  (all (match 1 (left [1 2]))
+       (match 2 (right [1 2]))
+       (match [2 1] (swap [1 2]))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/array.lux b/stdlib/test/test/lux/data/struct/array.lux
new file mode 100644
index 000000000..171631bd9
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/array.lux
@@ -0,0 +1,130 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control [monad])
+       (codata [io])
+       (data (struct ["&" array]
+                     [list])
+             [number])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: bounded-size
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (|>. (%+ +100) (++ +1)))))
+
+(test: "Arrays and their copies"
+  [size bounded-size
+   original (R;array size R;nat)
+   #let [clone (&;clone original)
+         copy (: (&;Array Nat)
+                 (&;new size))
+         manual-copy (: (&;Array Nat)
+                        (&;new size))]]
+  (all (assert "Size function must correctly return size of array."
+               (=+ size (&;size original)))
+       (assert "Cloning an array should yield and identical array, but not the same one."
+               (and (:: (&;Eq number;Eq) = original clone)
+                    (not (== original clone))))
+       (assert "Full-range manual copies should give the same result as cloning."
+               (exec (&;copy size +0 original +0 copy)
+                 (and (:: (&;Eq number;Eq) = original copy)
+                      (not (== original copy)))))
+       (assert "Array folding should go over all values."
+               (exec (:: &;Fold fold
+                         (lambda [x idx]
+                           (exec (&;put idx x manual-copy)
+                             (inc+ idx)))
+                         +0
+                         original)
+                 (:: (&;Eq number;Eq) = original manual-copy)))
+       (assert "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
+               (|> original
+                   &;to-list &;from-list
+                   (:: (&;Eq number;Eq) = original)))
+       ))
+
+(test: "Array mutation"
+  [size bounded-size
+   idx (:: @ map (%+ size) R;nat)
+   array (|> (R;array size R;nat)
+             (R;filter (|>. &;to-list (list;any? odd?+))))
+   #let [value (default (undefined)
+                 (&;get idx array))]]
+  (all (assert "Shouldn't be able to find a value in an unoccupied cell."
+               (case (&;get idx (&;remove idx array))
+                 (#;Some _) false
+                 #;None     true))
+       (assert "You should be able to access values put into the array."
+               (case (&;get idx (&;put idx value array))
+                 (#;Some value') (=+ value' value)
+                 #;None          false))
+       (assert "All cells should be occupied on a full array."
+               (and (=+ size (&;occupied array))
+                    (=+ +0 (&;vacant array))))
+       (assert "Filtering mutates the array to remove invalid values."
+               (exec (&;filter even?+ array)
+                 (and (<+ size (&;occupied array))
+                      (>+ +0 (&;vacant array))
+                      (=+ size (++ (&;occupied array)
+                                   (&;vacant array))))))
+       ))
+
+(test: "Finding values."
+  [size bounded-size
+   array (|> (R;array size R;nat)
+             (R;filter (|>. &;to-list (list;any? even?+))))]
+  (all (assert "Can find values inside arrays."
+               (|> (&;find even?+ array)
+                   (case> (#;Some _) true
+                          #;None     false)))
+       (assert "Can find values inside arrays (with access to indices)."
+               (|> (&;find+ (lambda [idx n]
+                              (and (even?+ n)
+                                   (<+ size idx)))
+                            array)
+                   (case> (#;Some _) true
+                          #;None     false)))))
+
+(test: "Functor"
+  [size bounded-size
+   array (R;array size R;nat)]
+  (let [(^open) &;Functor
+        (^open) (&;Eq number;Eq)]
+    (all (assert "Functor shouldn't alter original array."
+                 (let [copy (map id array)]
+                   (and (= array copy)
+                        (not (== array copy)))))
+         (assert "Functor should go over all available array elements."
+                 (let [there (map inc+ array)
+                       back-again (map dec+ there)]
+                   (and (not (= array there))
+                        (= array back-again)))))))
+
+(test: "Monoid"
+  [sizeL bounded-size
+   sizeR bounded-size
+   left (R;array sizeL R;nat)
+   right (R;array sizeR R;nat)
+   #let [(^open) &;Monoid
+         (^open) (&;Eq number;Eq)
+         fusion (append left right)]]
+  (all (assert "Appending two arrays should produce a new one twice as large."
+               (=+ (++ sizeL sizeR) (&;size fusion)))
+       (assert "First elements of fused array should equal the first array."
+               (|> (: (&;Array Nat)
+                      (&;new sizeL))
+                   (&;copy sizeL +0 fusion +0)
+                   (= left)))
+       (assert "Last elements of fused array should equal the second array."
+               (|> (: (&;Array Nat)
+                      (&;new sizeR))
+                   (&;copy sizeR sizeL fusion +0)
+                   (= right)))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/dict.lux b/stdlib/test/test/lux/data/struct/dict.lux
new file mode 100644
index 000000000..06b9550aa
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/dict.lux
@@ -0,0 +1,136 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad
+                [eq])
+       (data [text "Text/" Monoid]
+             text/format
+             [number]
+             [char]
+             (struct ["&" dict]
+                     [list "List/" Fold Functor]))
+       (codata function)
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(test: "Dictionaries."
+  [#let [capped-nat (:: R;Monad map (%+ +100) R;nat)]
+   size capped-nat
+   dict (R;dict char;Hash size R;char capped-nat)
+   non-key (|> R;char
+               (R;filter (lambda [key] (not (&;contains? key dict)))))
+   test-val (|> R;nat
+                (R;filter (lambda [val] (not (list;member? number;Eq (&;values dict) val)))))]
+  (all (assert "Size function should correctly represent Dict size."
+               (=+ size (&;size dict)))
+       
+       (assert "Dicts of size 0 should be considered empty."
+               (if (=+ +0 size)
+                 (&;empty? dict)
+                 (not (&;empty? dict))))
+       
+       (assert "The functions 'entries', 'keys' and 'values' should be synchronized."
+               (:: (list;Eq (eq;conj char;Eq number;Eq)) =
+                   (&;entries dict)
+                   (list;zip2 (&;keys dict)
+                              (&;values dict))))
+       
+       (assert "Dict should be able to recognize it's own keys."
+               (list;every? (lambda [key] (&;contains? key dict))
+                            (&;keys dict)))
+       
+       (assert "Should be able to get every key."
+               (list;every? (lambda [key] (case (&;get key dict)
+                                       (#;Some _) true
+                                       _          false))
+                            (&;keys dict)))
+       
+       (assert "Shouldn't be able to access non-existant keys."
+               (case (&;get non-key dict)
+                 (#;Some _) false
+                 _          true))
+       
+       (assert "Should be able to put and then get a value."
+               (case (&;get non-key (&;put non-key test-val dict))
+                 (#;Some v) (=+ test-val v)
+                 _          true))
+       
+       (assert "Should be able to put~ and then get a value."
+               (case (&;get non-key (&;put~ non-key test-val dict))
+                 (#;Some v) (=+ test-val v)
+                 _          true))
+       
+       (assert "Shouldn't be able to put~ an existing key."
+               (or (=+ +0 size)
+                   (let [first-key (|> dict &;keys list;head (default (undefined)))]
+                     (case (&;get first-key (&;put~ first-key test-val dict))
+                       (#;Some v) (not (=+ test-val v))
+                       _          true))))
+       
+       (assert "Removing a key should make it's value inaccessible."
+               (let [base (&;put non-key test-val dict)]
+                 (and (&;contains? non-key base)
+                      (not (&;contains? non-key (&;remove non-key base))))))
+       
+       (assert "Should be possible to update values via their keys."
+               (let [base (&;put non-key test-val dict)
+                     updt (&;update non-key inc+ base)]
+                 (case [(&;get non-key base) (&;get non-key updt)]
+                   [(#;Some x) (#;Some y)]
+                   (=+ (inc+ x) y)
+
+                   _
+                   false)))
+       
+       (assert "Additions and removals to a Dict should affect its size."
+               (let [plus (&;put non-key test-val dict)
+                     base (&;remove non-key plus)]
+                 (and (=+ (inc+ (&;size dict)) (&;size plus))
+                      (=+ (dec+ (&;size plus)) (&;size base)))))
+
+       (assert "A Dict should equal itself & going to<->from lists shouldn't change that."
+               (let [(^open) (&;Eq number;Eq)]
+                 (and (= dict dict)
+                      (|> dict &;entries (&;from-list char;Hash) (= dict)))))
+
+       (assert "Merging a Dict to itself changes nothing."
+               (let [(^open) (&;Eq number;Eq)]
+                 (= dict (&;merge dict dict))))
+
+       (assert "If you merge, and the second dict has overlapping keys, it should overwrite yours."
+               (let [dict' (|> dict &;entries
+                               (List/map (lambda [[k v]] [k (inc+ v)]))
+                               (&;from-list char;Hash))
+                     (^open) (&;Eq number;Eq)]
+                 (= dict' (&;merge dict' dict))))
+
+       (assert "Can merge values in such a way that they become combined."
+               (list;every? (lambda [[x x*2]] (=+ (*+ +2 x) x*2))
+                            (list;zip2 (&;values dict)
+                                       (&;values (&;merge-with ++ dict dict)))))
+
+       (assert "Should be able to select subset of keys from dict."
+               (|> dict
+                   (&;put non-key test-val)
+                   (&;select (list non-key))
+                   &;size
+                   (=+ +1)))
+
+       (assert "Should be able to re-bind existing values to different keys."
+               (or (=+ +0 size)
+                   (let [first-key (|> dict &;keys list;head (default (undefined)))
+                         rebound (&;re-bind first-key non-key dict)]
+                     (and (=+ (&;size dict) (&;size rebound))
+                          (&;contains? non-key rebound)
+                          (not (&;contains? first-key rebound))
+                          (=+ (default (undefined)
+                                (&;get first-key dict))
+                              (default (undefined)
+                                (&;get non-key rebound)))))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/list.lux b/stdlib/test/test/lux/data/struct/list.lux
new file mode 100644
index 000000000..6baf13c6c
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/list.lux
@@ -0,0 +1,191 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" list])
+             [text "Text/" Monoid]
+             [number]
+             [bool]
+             [product])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: bounded-size
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (|>. (%+ +100) (++ +10)))))
+
+(test: "Lists"
+  [size bounded-size
+   idx (:: @ map (%+ size) R;nat)
+   sample (R;list size R;nat)
+   other-size bounded-size
+   other-sample (R;list other-size R;nat)
+   separator R;nat
+   #let [(^open) (&;Eq number;Eq)
+         (^open "&/") &;Functor]]
+  (all (assert "The size function should correctly portray the size of the list."
+               (=+ size (&;size sample)))
+
+       (assert "The repeat function should produce as many elements as asked of it."
+               (=+ size (&;size (&;repeat size []))))
+
+       (assert "Reversing a list does not change it's size."
+               (=+ (&;size sample)
+                   (&;size (&;reverse sample))))
+       
+       (assert "Reversing a list twice results in the original list."
+               (= sample
+                  (&;reverse (&;reverse sample))))
+
+       (assert "Filtering by a predicate and its complement should result in a number of elements equal to the original list."
+               (and (=+ (&;size sample)
+                        (++ (&;size (&;filter even?+ sample))
+                            (&;size (&;filter (bool;complement even?+) sample))))
+                    (let [[plus minus] (&;partition even?+ sample)]
+                      (=+ (&;size sample)
+                          (++ (&;size plus)
+                              (&;size minus))))))
+
+       (assert "If every element in a list satisfies a predicate, there can't be any that satisfy its complement."
+               (if (&;every? even?+ sample)
+                 (and (not (&;any? (bool;complement even?+) sample))
+                      (&;empty? (&;filter (bool;complement even?+) sample)))
+                 (&;any? (bool;complement even?+) sample)))
+
+       (assert "Any element of the list can be considered it's member."
+               (let [elem (default (undefined)
+                            (&;at idx sample))]
+                 (&;member? number;Eq sample elem)))
+
+       (assert "Appending the head and the tail should yield the original list."
+               (let [head (default (undefined)
+                            (&;head sample))
+                     tail (default (undefined)
+                            (&;tail sample))]
+                 (= sample
+                    (#;Cons head tail))))
+
+       (assert "Appending the inits and the last should yield the original list."
+               (let [(^open) &;Monoid
+                     inits (default (undefined)
+                             (&;inits sample))
+                     last (default (undefined)
+                            (&;last sample))]
+                 (= sample
+                    (append inits (list last)))))
+
+       (assert "Functor should go over every element of the list."
+               (let [(^open) &;Functor
+                     there (map inc+ sample)
+                     back-again (map dec+ there)]
+                 (and (not (= sample there))
+                      (= sample back-again))))
+
+       (assert "Splitting a list into chunks and re-appending them should yield the original list."
+               (let [(^open) &;Monoid
+                     [left right] (&;split idx sample)
+                     [left' right'] (&;split-with even?+ sample)]
+                 (and (= sample
+                         (append left right))
+                      (= sample
+                         (append left' right'))
+                      (= sample
+                         (append (&;take idx sample)
+                                 (&;drop idx sample)))
+                      (= sample
+                         (append (&;take-while even?+ sample)
+                                 (&;drop-while even?+ sample)))
+                      )))
+
+       (assert "Segmenting the list in pairs should yield as many elements as N/2."
+               (=+ (/+ +2 size)
+                   (&;size (&;as-pairs sample))))
+
+       (assert "Sorting a list shouldn't change it's size."
+               (=+ (&;size sample)
+                   (&;size (&;sort <+ sample))))
+
+       (assert "Sorting a list with one order should yield the reverse of sorting it with the opposite order."
+               (= (&;sort <+ sample)
+                  (&;reverse (&;sort >+ sample))))
+
+       (assert "If you zip 2 lists, the result's size will be that of the smaller list."
+               (=+ (&;size (&;zip2 sample other-sample))
+                   (min+ (&;size sample) (&;size other-sample))))
+       
+       (assert "I can pair-up elements of a list in order."
+               (let [(^open) &;Functor
+                     zipped (&;zip2 sample other-sample)
+                     num-zipper (&;size zipped)]
+                 (and (|> zipped (map product;left) (= (&;take num-zipper sample)))
+                      (|> zipped (map product;right) (= (&;take num-zipper other-sample))))))
+       
+       (assert "You can generate indices for any size, and they will be in ascending order."
+               (let [(^open) &;Functor
+                     indices (&;indices size)]
+                 (and (=+ size (&;size indices))
+                      (= indices
+                         (&;sort <+ indices))
+                      (&;every? (=+ (dec+ size))
+                                (&;zip2-with ++
+                                             indices
+                                             (&;sort >+ indices)))
+                      )))
+
+       (assert "The 'interpose' function places a value between every member of a list."
+               (let [(^open) &;Functor
+                     sample+ (&;interpose separator sample)]
+                 (and (=+ (|> size (*+ +2) dec+)
+                          (&;size sample+))
+                      (|> sample+ &;as-pairs (map product;right) (&;every? (=+ separator))))))
+
+       (assert "List append is a monoid."
+               (let [(^open) &;Monoid]
+                 (and (= sample (append unit sample))
+                      (= sample (append sample unit))
+                      (let [[left right] (&;split size (append sample other-sample))]
+                        (and (= sample left)
+                             (= other-sample right))))))
+
+       (assert "Applicative allows you to create singleton lists, and apply lists of functions to lists of values."
+               (let [(^open) &;Applicative]
+                 (and (= (list separator) (wrap separator))
+                      (= (map inc+ sample)
+                         (apply (wrap inc+) sample)))))
+
+       (assert "List concatenation is a monad."
+               (let [(^open) &;Monad
+                     (^open) &;Monoid]
+                 (= (append sample other-sample)
+                    (join (list sample other-sample)))))
+
+       (assert "You can find any value that satisfies some criterium, if such values exist in the list."
+               (case (&;find even?+ sample)
+                 (#;Some found)
+                 (and (even?+ found)
+                      (&;any? even?+ sample)
+                      (not (&;every? (bool;complement even?+) sample)))
+
+                 #;None
+                 (and (not (&;any? even?+ sample))
+                      (&;every? (bool;complement even?+) sample))))
+
+       (assert "You can iteratively construct a list, generating values until you're done."
+               (= (&;range+ +0 (dec+ size))
+                  (&;iterate (lambda [n] (if (<+ size n) (#;Some (inc+ n)) #;None))
+                             +0)))
+
+       (assert "Can enumerate all elements in a list."
+               (let [enum-sample (&;enumerate sample)]
+                 (and (= (&;indices (&;size enum-sample))
+                         (&/map product;left enum-sample))
+                      (= sample
+                         (&/map product;right enum-sample)))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/queue.lux b/stdlib/test/test/lux/data/struct/queue.lux
new file mode 100644
index 000000000..895929ab4
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/queue.lux
@@ -0,0 +1,54 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" queue])
+             [number])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(test: "Queues"
+  [size (:: @ map (%+ +100) R;nat)
+   sample (R;queue size R;nat)
+   non-member (|> R;nat
+                  (R;filter (. not (&;enqueued? number;Eq sample))))]
+  (all (assert "I can query the size of a queue (and empty queues have size 0)."
+               (if (=+ +0 size)
+                 (&;empty? sample)
+                 (=+ size (&;size sample))))
+
+       (assert "Enqueueing and dequeing affects the size of queues."
+               (and (=+ (inc+ size) (&;size (&;enqueue non-member sample)))
+                    (or (&;empty? sample)
+                        (=+ (dec+ size) (&;size (&;dequeue sample))))
+                    (=+ size (&;size (&;dequeue (&;enqueue non-member sample))))))
+
+       (assert "Transforming to/from list can't change the queue."
+               (let [(^open "&/") (&;Eq number;Eq)]
+                 (|> sample
+                     &;to-list &;from-list
+                     (&/= sample))))
+
+       (assert "I can always peek at a non-empty queue."
+               (case (&;peek sample)
+                 #;None     (&;empty? sample)
+                 (#;Some _) true))
+
+       (assert "I can query whether an element belongs to a queue."
+               (and (not (&;enqueued? number;Eq sample non-member))
+                    (&;enqueued? number;Eq (&;enqueue non-member sample)
+                                 non-member)
+                    (case (&;peek sample)
+                      #;None
+                      (&;empty? sample)
+                      
+                      (#;Some first)
+                      (and (&;enqueued? number;Eq sample first)
+                           (not (&;enqueued? number;Eq (&;dequeue sample) first))))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/set.lux b/stdlib/test/test/lux/data/struct/set.lux
new file mode 100644
index 000000000..3725e7f93
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/set.lux
@@ -0,0 +1,67 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" set]
+                     [list "" Fold])
+             [number])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: gen-nat
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (%+ +100))))
+
+(test: "Sets"
+  [sizeL gen-nat
+   sizeR gen-nat
+   setL (R;set number;Hash sizeL gen-nat)
+   setR (R;set number;Hash sizeR gen-nat)
+   non-member (|> gen-nat
+                  (R;filter (. not (&;member? setL))))
+   #let [(^open "&/") &;Eq]]
+  (all (assert "I can query the size of a set."
+               (and (=+ sizeL (&;size setL))
+                    (=+ sizeR (&;size setR))))
+
+       (assert "Converting sets to/from lists can't change their values."
+               (|> setL
+                   &;to-list (&;from-list number;Hash)
+                   (&/= setL)))
+
+       (assert "Every set is a sub-set of the union of itself with another."
+               (let [setLR (&;union setL setR)]
+                 (and (&;sub? setLR setL)
+                      (&;sub? setLR setR))))
+
+       (assert "Every set is a super-set of the intersection of itself with another."
+               (let [setLR (&;intersection setL setR)]
+                 (and (&;super? setLR setL)
+                      (&;super? setLR setR))))
+
+       (assert "Union with the empty set leaves a set unchanged."
+               (&/= setL
+                    (&;union (&;new number;Hash)
+                             setL)))
+
+       (assert "Intersection with the empty set results in the empty set."
+               (let [empty-set (&;new number;Hash)]
+                 (&/= empty-set
+                      (&;intersection empty-set setL))))
+
+       (assert "After substracting a set A from another B, no member of A can be a member of B."
+               (let [sub (&;difference setR setL)]
+                 (not (list;any? (&;member? setL) (&;to-list setR)))))
+
+       (assert "Every member of a set must be identifiable."
+               (and (not (&;member? setL non-member))
+                    (&;member? (&;add non-member setL) non-member)
+                    (not (&;member? (&;remove non-member (&;add non-member setL)) non-member))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/stack.lux b/stdlib/test/test/lux/data/struct/stack.lux
new file mode 100644
index 000000000..dc3bb1e89
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/stack.lux
@@ -0,0 +1,47 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" stack]
+                     [list "" Fold])
+             [number])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: gen-nat
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (%+ +100))))
+
+(test: "Stacks"
+  [size gen-nat
+   sample (R;stack size gen-nat)
+   new-top gen-nat]
+  (all (assert "Can query the size of a stack."
+               (=+ size (&;size sample)))
+
+       (assert "Can peek inside non-empty stacks."
+               (case (&;peek sample)
+                 #;None     (&;empty? sample)
+                 (#;Some _) (not (&;empty? sample))))
+
+       (assert "Popping empty stacks doesn't change anything.
+                But, if they're non-empty, the top of the stack is removed."
+               (let [sample' (&;pop sample)]
+                 (or (=+ (&;size sample) (inc+ (&;size sample')))
+                     (and (&;empty? sample) (&;empty? sample')))
+                 ))
+
+       (assert "Pushing onto a stack always increases it by 1, adding a new value at the top."
+               (and (== sample
+                        (&;pop (&;push new-top sample)))
+                    (=+ (inc+ (&;size sample)) (&;size (&;push new-top sample)))
+                    (|> (&;push new-top sample) &;peek (default (undefined))
+                        (== new-top))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/tree.lux b/stdlib/test/test/lux/data/struct/tree.lux
new file mode 100644
index 000000000..0595ca7b3
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/tree.lux
@@ -0,0 +1,39 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" tree]
+                     [list "List/" Monad])
+             [number])
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: gen-nat
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (%+ +100))))
+
+(test: "Trees"
+  [leaf (:: @ map &;leaf R;nat)
+   branchS gen-nat
+   branchV R;nat
+   branchC (R;list branchS R;nat)
+   #let [branch (&;branch branchV (List/map &;leaf branchC))]
+   #let [(^open "&/") (&;Eq number;Eq)
+         (^open "List/") (list;Eq number;Eq)]]
+  (all (assert "Can compare trees for equality."
+               (and (&/= leaf leaf)
+                    (&/= branch branch)
+                    (not (&/= leaf branch))
+                    (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC)))))))
+
+       (assert "Can flatten a tree to get all the nodes as a flat tree."
+               (List/= (list& branchV branchC)
+                       (&;flatten branch)))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/vector.lux b/stdlib/test/test/lux/data/struct/vector.lux
new file mode 100644
index 000000000..87f8fa4cb
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/vector.lux
@@ -0,0 +1,84 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" vector]
+                     [list "List/" Fold Functor])
+             [text "Text/" Monoid]
+             text/format
+             [number])
+       (codata function)
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(test: "Vectors"
+  [size (|> R;nat (:: @ map (%+ +100)))
+   idx (|> R;nat (:: @ map (%+ size)))
+   sample (R;vector size R;nat)
+   other-sample (R;vector size R;nat)
+   non-member (|> R;nat (R;filter (. not (&;member? number;Eq sample))))
+   #let [(^open "&/") (&;Eq number;Eq)
+         (^open "&/") &;Monad
+         (^open "&/") &;Fold
+         (^open "&/") &;Monoid]]
+  (all (assert "Can query size of vector."
+               (if (&;empty? sample)
+                 (and (=+ +0 size)
+                      (=+ +0 (&;size sample)))
+                 (=+ size (&;size sample))))
+
+       (assert "Can add and remove elements to vectors."
+               (and (=+ (inc+ size)
+                        (&;size (&;add non-member sample)))
+                    (=+ (dec+ size)
+                        (&;size (&;pop sample)))))
+
+       (assert "Can put and get elements into vectors."
+               (|> sample
+                   (&;put idx non-member)
+                   (&;at idx)
+                   (default (undefined))
+                   (== non-member)))
+
+       (assert "Can update elements of vectors."
+               (|> sample
+                   (&;put idx non-member)
+                   (&;update idx inc+)
+                   (&;at idx)
+                   (default (undefined))
+                   (=+ (inc+ non-member))))
+
+       (assert "Can safely transform to/from lists."
+               (|> sample
+                   &;to-list &;from-list
+                   (&/= sample)))
+
+       (assert "Can identify members of a vector."
+               (and (not (&;member? number;Eq sample non-member))
+                    (&;member? number;Eq (&;add non-member sample) non-member)))
+
+       (assert "Can fold over elements of vector."
+               (=+ (List/fold ++ +0 (&;to-list sample))
+                   (&/fold ++ +0 sample)))
+       
+       (assert "Functor goes over every element."
+               (let [there (&/map inc+ sample)
+                     back-again (&/map dec+ there)]
+                 (and (not (&/= sample there))
+                      (&/= sample back-again))))
+
+       (assert "Applicative allows you to create singleton vectors, and apply vectors of functions to vectors of values."
+               (and (&/= (&;vector non-member) (&/wrap non-member))
+                    (&/= (&/map inc+ sample)
+                         (&/apply (&/wrap inc+) sample))))
+
+       (assert "Vector concatenation is a monad."
+               (&/= (&/append sample other-sample)
+                    (&/join (&;vector sample other-sample))))
+       ))
diff --git a/stdlib/test/test/lux/data/struct/zipper.lux b/stdlib/test/test/lux/data/struct/zipper.lux
new file mode 100644
index 000000000..a3bede88d
--- /dev/null
+++ b/stdlib/test/test/lux/data/struct/zipper.lux
@@ -0,0 +1,127 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data (struct ["&" zipper]
+                     [tree]
+                     [list "List/" Fold Functor])
+             [text "Text/" Monoid]
+             text/format
+             [number])
+       (codata function)
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(def: gen-tree
+  (R;Random (tree;Tree Nat))
+  (R;rec (lambda [gen-tree]
+           (do R;Monad
+             ## Each branch can have, at most, 1 child.
+             [size (|> R;nat (:: @ map (%+ +2)))]
+             (R;seq R;nat
+                    (R;list size gen-tree))))))
+
+(def: (to-end zipper)
+  (All [a] (-> (&;Zipper a) (&;Zipper a)))
+  (loop [zipper zipper]
+    (if (&;end? zipper)
+      zipper
+      (recur (&;next zipper)))))
+
+(test: "Zippers"
+  [sample gen-tree
+   new-val R;nat
+   pre-val R;nat
+   post-val R;nat
+   #let [(^open "Tree/") (tree;Eq number;Eq)
+         (^open "List/") (list;Eq number;Eq)]]
+  (all (assert "Trees can be converted to/from zippers."
+               (|> sample
+                   &;from-tree &;to-tree
+                   (Tree/= sample)))
+
+       (assert "Creating a zipper gives you a root node."
+               (|> sample &;from-tree &;root?))
+       
+       (assert "Can move down inside branches. Can move up from lower nodes."
+               (let [zipper (&;from-tree sample)]
+                 (if (&;branch? zipper)
+                   (let [child (|> zipper &;down)]
+                     (and (not (Tree/= sample (&;to-tree child)))
+                          (|> child &;parent (default (undefined)) (== zipper))
+                          (|> child &;up (== zipper))
+                          (|> child &;root (== zipper))))
+                   (and (&;leaf? zipper)
+                        (|> zipper (&;prepend-child new-val) &;branch?)))))
+
+       (assert "Can prepend and append children."
+               (let [zipper (&;from-tree sample)]
+                 (if (&;branch? zipper)
+                   (let [mid-val (|> zipper &;down &;value)
+                         zipper (|> zipper
+                                    (&;prepend-child pre-val)
+                                    (&;append-child post-val))]
+                     (and (|> zipper &;down &;value (== pre-val))
+                          (|> zipper &;down &;right &;value (== mid-val))
+                          (|> zipper &;down &;right &;right &;value (== post-val))
+                          (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val))
+                          (|> zipper &;down &;right &;left &;value (== mid-val))
+                          (|> zipper &;down &;rightmost &;value (== post-val))))
+                   true)))
+
+       (assert "Can insert children around a node (unless it's root)."
+               (let [zipper (&;from-tree sample)]
+                 (if (&;branch? zipper)
+                   (let [mid-val (|> zipper &;down &;value)
+                         zipper (|> zipper
+                                    &;down
+                                    (&;insert-left pre-val)
+                                    (default (undefined))
+                                    (&;insert-right post-val)
+                                    (default (undefined))
+                                    &;up)]
+                     (and (|> zipper &;down &;value (== pre-val))
+                          (|> zipper &;down &;right &;value (== mid-val))
+                          (|> zipper &;down &;right &;right &;value (== post-val))
+                          (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val))
+                          (|> zipper &;down &;right &;left &;value (== mid-val))
+                          (|> zipper &;down &;rightmost &;value (== post-val))))
+                   (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false
+                                                                  #;None     true))
+                        (|> zipper (&;insert-right post-val) (case> (#;Some _) false
+                                                                    #;None     true))))))
+       
+       (assert "Can set and update the value of a node."
+               (|> sample &;from-tree (&;set new-val) &;value (=+ new-val)))
+
+       (assert "Zipper traversal follows the outline of the tree depth-first."
+               (List/= (tree;flatten sample)
+                       (loop [zipper (&;from-tree sample)]
+                         (if (&;end? zipper)
+                           (list)
+                           (#;Cons (&;value zipper)
+                                   (recur (&;next zipper)))))))
+
+       (assert "Backwards zipper traversal yield reverse tree flatten."
+               (List/= (list;reverse (tree;flatten sample))
+                       (loop [zipper (to-end (&;from-tree sample))]
+                         (if (&;root? zipper)
+                           (list)
+                           (#;Cons (&;value zipper)
+                                   (recur (&;prev zipper)))))))
+
+       (assert "Can remove nodes (except root nodes)."
+               (let [zipper (&;from-tree sample)]
+                 (if (&;branch? zipper)
+                   (and (|> zipper &;down &;root? not)
+                        (|> zipper &;down &;remove (case> #;None false
+                                                          (#;Some node) (&;root? node))))
+                   (|> zipper &;remove (case> #;None     true
+                                              (#;Some _) false)))))
+       ))
diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux
new file mode 100644
index 000000000..a23eeec00
--- /dev/null
+++ b/stdlib/test/test/lux/data/sum.lux
@@ -0,0 +1,32 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data sum
+             [text "Text/" Monoid]
+             [number])
+       (codata function))
+  lux/test)
+
+(test: "Sum operations"
+  (all (match (+0 1) (left 1))
+       (match (+1 2) (right 2))
+       (match (^ (list "0" "2"))
+              (lefts (: (List (| Text Text))
+                        (list (+0 "0") (+1 "1") (+0 "2")))))
+       (match (^ (list "1"))
+              (rights (: (List (| Text Text))
+                         (list (+0 "0") (+1 "1") (+0 "2")))))
+       (match (^ [(list "0" "2") (list "1")])
+              (partition (: (List (| Text Text))
+                            (list (+0 "0") (+1 "1") (+0 "2")))))
+       (match 10
+              (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+0 ""))))
+       (match 20
+              (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+1 ""))))
+       ))
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
new file mode 100644
index 000000000..640ae3f4c
--- /dev/null
+++ b/stdlib/test/test/lux/data/text.lux
@@ -0,0 +1,150 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data ["&" text]
+             [char]
+             text/format
+             [number]
+             (struct [list]))
+       (codata function)
+       (math ["R" random])
+       pipe)
+  lux/test)
+
+(test: "Size"
+  [size (:: @ map (%+ +100) R;nat)
+   sample (R;text size)]
+  (assert "" (or (and (=+ +0 size)
+                      (&;empty? sample))
+                 (=+ size (&;size sample)))))
+
+(def: bounded-size
+  (R;Random Nat)
+  (|> R;nat
+      (:: R;Monad map (|>. (%+ +100) (++ +1)))))
+
+(test: "Locations"
+  [size bounded-size
+   idx (:: @ map (%+ size) R;nat)
+   sample (R;text size)]
+  (assert "" (|> sample
+                 (&;at idx)
+                 (case> (^=> (#;Some char)
+                             {(char;as-text char) char'}
+                             {[(&;index-of char' sample)
+                               (&;last-index-of char' sample)
+                               (&;index-of' char' idx sample)
+                               (&;last-index-of' char' idx sample)]
+                              [(#;Some io) (#;Some lio)
+                               (#;Some io') (#;Some lio')]})
+                        (and (<=+ idx io)
+                             (>=+ idx lio)
+
+                             (=+ idx io')
+                             (>=+ idx lio')
+
+                             (&;contains? char' sample))
+
+                        _
+                        false
+                        ))
+          ))
+
+(test: "Text functions"
+  [sizeL bounded-size
+   sizeR bounded-size
+   sampleL (R;text sizeL)
+   sampleR (R;text sizeR)
+   #let [sample (&;concat (list sampleL sampleR))
+         fake-sample (&;join-with " " (list sampleL sampleR))
+         dup-sample (&;join-with "" (list sampleL sampleR))
+         enclosed-sample (&;enclose [sampleR sampleR] sampleL)
+         (^open) &;Eq]]
+  (assert "" (and (not (= sample fake-sample))
+                  (= sample dup-sample)
+                  (&;starts-with? sampleL sample)
+                  (&;ends-with? sampleR sample)
+                  (= enclosed-sample
+                     (&;enclose' sampleR sampleL))
+                  
+                  (|> (&;split sizeL sample)
+                      (case> (#;Right [_l _r])
+                             (and (= sampleL _l)
+                                  (= sampleR _r)
+                                  (= sample (&;concat (list _l _r))))
+
+                             _
+                             false))
+                  
+                  (|> [(&;sub +0 sizeL sample)
+                       (&;sub sizeL (&;size sample) sample)
+                       (&;sub' sizeL sample)
+                       (&;sub' +0 sample)]
+                      (case> [(#;Right _l) (#;Right _r) (#;Right _r') (#;Right _f)]
+                             (and (= sampleL _l)
+                                  (= sampleR _r)
+                                  (= _r _r')
+                                  (= sample _f))
+
+                             _
+                             false))
+                  )
+          ))
+
+(test: "More text functions"
+  [sizeS bounded-size
+   sizeP bounded-size
+   sizeL bounded-size
+   sep1 (R;text sizeS)
+   sep2 (R;text sizeS)
+   #let [part-gen (|> (R;text sizeP)
+                      (R;filter (. not (&;contains? sep1))))]
+   parts (R;list sizeL part-gen)
+   #let [sample1 (&;concat (list;interpose sep1 parts))
+         sample2 (&;concat (list;interpose sep2 parts))
+         (^open) &;Eq]]
+  (assert "" (and (=+ (list;size parts)
+                      (list;size (&;split-all-with sep1 sample1)))
+                  (= sample2
+                     (&;replace sep1 sep2 sample1))
+                  )))
+
+(test: "Other text functions"
+  (all (match "abc" (&;lower-case "ABC"))
+       (match "ABC" (&;upper-case "abc"))
+       (match "ABC" (&;trim " \tABC\n\r"))
+       ))
+
+(test: "Structures"
+  (all (assert "" (:: &;Ord < "bcd" "abc"))
+       (assert "" (not (:: &;Ord < "abc" "abc")))
+       (assert "" (not (:: &;Ord < "abc" "bcd")))
+       (assert "" (:: &;Ord <= "bcd" "abc"))
+       (assert "" (:: &;Ord <= "abc" "abc"))
+       (assert "" (not (:: &;Ord <= "abc" "bcd")))
+       (assert "" (:: &;Ord > "abc" "bcd"))
+       (assert "" (not (:: &;Ord > "abc" "abc")))
+       (assert "" (not (:: &;Ord > "bcd" "abc")))
+       (assert "" (:: &;Ord >= "abc" "bcd"))
+       (assert "" (:: &;Ord >= "abc" "abc"))
+       (assert "" (not (:: &;Ord >= "bcd" "abc")))
+       ))
+
+(test: "Codec"
+  [size bounded-size
+   sample (R;text size)
+   #let [(^open) &;Eq]]
+  (assert "" (|> sample
+                 (:: &;Codec encode)
+                 (:: &;Codec decode)
+                 (case> (#;Right decoded)
+                        (= sample decoded)
+
+                        _
+                        false))))
diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux
new file mode 100644
index 000000000..cd15c8584
--- /dev/null
+++ b/stdlib/test/test/lux/data/text/format.lux
@@ -0,0 +1,22 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data text/format
+             [number])
+       (codata function))
+  lux/test)
+
+(test: "Formatters"
+  (all (match "true" (%b true))
+       (match "123" (%i 123))
+       (match "123.456" (%r 123.456))
+       (match "#\"t\"" (%c #"t"))
+       (match "\"YOLO\"" (%t "YOLO"))
+       (match "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true)))
+       ))
diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.lux
new file mode 100644
index 000000000..109d8dfed
--- /dev/null
+++ b/stdlib/test/test/lux/host.lux
@@ -0,0 +1,54 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data text/format
+             [number]
+             [product])
+       (codata function
+               [io])
+       host)
+  lux/test)
+
+(jvm-import java.lang.Object
+  (new []))
+
+(jvm-import java.lang.String)
+
+(jvm-import (java.lang.Class a)
+  (getName [] String))
+
+(test: "lux/host exports"
+  (let% [ (do-template [  ]
+                           [(match  (|>   ))]
+
+                           [123   l2d d2l]
+                           [123   l2f f2l]
+                           [123   l2i i2l]
+                           [123.0 d2l l2d]
+                           [123.0 d2f f2d]
+                           [123.0 d2i i2d]
+                           )
+          (do-template [ ]
+                           [(match 123 (|> 123 l2i   i2l))]
+
+                           [i2c c2i]
+                           )]
+    (test-all (match "java.lang.Class" (Class.getName [] (class-for java.lang.Class)))
+              (match "java.lang.Class" (Class.getName [] (class-for Class)))
+              (match true (null? (: Object (null))))
+              (match false (null? (Object.new [])))
+              (match #;None (: (Maybe Object) (??? (null))))
+              (match (#;Some _) (: (Maybe Object) (??? (Object.new []))))
+              (match true (null? (!!! (: (Maybe Object) (??? (null))))))
+              (match false (null? (!!! (: (Maybe Object) (??? (Object.new []))))))
+              (match true (instance? Object (Object.new [])))
+              (match false (instance? String (Object.new [])))
+              (match 123 (synchronized (Object.new [])
+                           123))
+              (match +10 (array-length (array String +10)))
+              (match "YOLO" (let [array (array String +10)] 
+                              (exec (array-store +0 "YOLO" array)
+                                (array-load +0 array))))
+              
+              
+              )))
diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux
new file mode 100644
index 000000000..d0b17fe4b
--- /dev/null
+++ b/stdlib/test/test/lux/lexer.lux
@@ -0,0 +1,133 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  [lux #- not]
+  (lux (control monad)
+       (codata [io])
+       (data error)
+       [test #- fail assert]
+       lexer))
+
+## [Tests]
+(test: "Lexer end works"
+  (test-all (should-pass (run end ""))
+            (should-fail (run end "YOLO"))))
+
+(test: "Simple text lexers"
+  (test-all (match (#;Right "YO")
+                   (run (this "YO") "YOLO"))
+            (should-fail (run (this "YO") "MEME"))))
+
+(test: "Char lexers"
+  (test-all (match (#;Right #"Y")
+                   (run (this-char #"Y") "YOLO"))
+            (should-fail (run (this-char #"Y") "MEME"))
+            (match (#;Right #"Y")
+                   (run (char-range #"X" #"Z") "YOLO"))
+            (should-fail (run (char-range #"X" #"Z") "MEME"))
+            (match (#;Right #"Y")
+                   (run upper "YOLO"))
+            (should-fail (run upper "meme"))
+            (match (#;Right #"y")
+                   (run lower "yolo"))
+            (should-fail (run lower "MEME"))
+            (match (#;Right #"1")
+                   (run digit "1"))
+            (should-fail (run digit " "))
+            (match (#;Right #"7")
+                   (run oct-digit "7"))
+            (should-fail (run oct-digit "8"))
+            (match (#;Right #"A")
+                   (run any "A"))
+            (should-fail (run any ""))))
+
+(test: "Combinators"
+  (test-all (match (#;Right [#"Y" #"O"])
+                   (run (seq any any) "YOLO"))
+            (should-fail (run (seq any any) "Y"))
+            (match+ (#;Left #"0")
+                    (should-pass (run (alt digit upper) "0")))
+            (match+ (#;Right #"A")
+                    (should-pass (run (alt digit upper) "A")))
+            (should-fail (run (alt digit upper) "a"))
+            (should-pass (run (not (alt digit upper)) "a"))
+            (should-fail (run (not (alt digit upper)) "A"))
+            (match (#;Right #"0")
+                   (run (either digit upper) "0"))
+            (match (#;Right #"A")
+                   (run (either digit upper) "A"))
+            (should-fail (run (either digit upper) "a"))
+            (match (#;Right #"A")
+                   (run alpha "A"))
+            (match (#;Right #"a")
+                   (run alpha "a"))
+            (should-fail (run alpha "1"))
+            (match (#;Right #"A")
+                   (run alpha-num "A"))
+            (match (#;Right #"a")
+                   (run alpha-num "a"))
+            (match (#;Right #"1")
+                   (run alpha-num "1"))
+            (should-fail (run alpha-num " "))
+            (match (#;Right #"1")
+                   (run hex-digit "1"))
+            (match (#;Right #"a")
+                   (run hex-digit "a"))
+            (match (#;Right #"A")
+                   (run hex-digit "A"))
+            (should-fail (run hex-digit " "))
+            (match (#;Right #" ")
+                   (run space " "))
+            (should-fail (run space "8"))
+            (match (#;Right #"C")
+                   (run (one-of "ABC") "C"))
+            (should-fail (run (one-of "ABC") "D"))
+            (match (#;Right #"D")
+                   (run (none-of "ABC") "D"))
+            (should-fail (run (none-of "ABC") "C"))
+            (match (#;Right #"D")
+                   (run (satisfies (lambda [c] true)) "D"))
+            (should-fail (run (satisfies (lambda [c] false)) "C"))
+            (match (#;Right "0123456789ABCDEF")
+                   (run (many' hex-digit) "0123456789ABCDEF yolo"))
+            (should-fail (run (many' hex-digit) "yolo"))
+            (match (#;Right "")
+                   (run (some' hex-digit) "yolo"))
+            ))
+
+(test: "Yet more combinators..."
+  (test-all (should-fail (run (fail "Well, it really SHOULD fail...") "yolo"))
+            (should-fail (run (assert false "Well, it really SHOULD fail...") "yolo"))
+            (should-pass (run (assert true "GO, GO, GO!") "yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (many hex-digit) "0123456789ABCDEF yolo"))
+            (should-fail (run (many hex-digit) "yolo"))
+            (match (^ (#;Right (list)))
+                   (run (some hex-digit) "yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (exactly +16 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2")))
+                   (run (exactly +3 hex-digit) "0123456789ABCDEF yolo"))
+            (should-fail (run (exactly +17 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (at-most +16 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2")))
+                   (run (at-most +3 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (at-most +17 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (between +0 +16 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (between +3 +16 hex-digit) "0123456789ABCDEF yolo"))
+            (should-fail (run (between +17 +100 hex-digit) "0123456789ABCDEF yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
+                   (run (between +15 +20 hex-digit) "0123456789ABCDEF yolo"))
+            (match (#;Right (#;Some #"1")) (run (opt hex-digit) "123abc"))
+            (match (#;Right #;None) (run (opt hex-digit) "yolo"))
+            (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"a" #"b" #"c" #"d" #"e" #"f")))
+                   (run (sep-by space hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO"))
+            (match (#;Right "yolo") (run get-input "yolo"))
+            ))
diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux
new file mode 100644
index 000000000..b06efce01
--- /dev/null
+++ b/stdlib/test/test/lux/macro/ast.lux
@@ -0,0 +1,31 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             [number])
+       (macro ast)
+       (codata function))
+  lux/test)
+
+(test: "lux/macro/ast exports"
+  (let% [ (do-template [  ]
+                   [(match  )
+                    (match  (ast-to-text ))
+                    (match true (:: Eq =  ))]
+
+                   [(bool true)                             "true"       [["" -1 -1] (#;BoolS true)]]
+                   [(bool false)                            "false"      [_ (#;BoolS false)]]
+                   [(int 123)                               "123"        [_ (#;IntS 123)]]
+                   [(real 123.0)                            "123.0"      [_ (#;RealS 123.0)]]
+                   [(char #"\n")                            "#\"\\n\""   [_ (#;CharS #"\n")]]
+                   [(text "\n")                             "\"\\n\""    [_ (#;TextS "\n")]]
+                   [(tag ["yolo" "lol"])                    "#yolo;lol"  [_ (#;TagS ["yolo" "lol"])]]
+                   [(symbol ["yolo" "lol"])                 "yolo;lol"   [_ (#;SymbolS ["yolo" "lol"])]]
+                   [(form (list (bool true) (int 123)))     "(true 123)" (^ [_ (#;FormS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])]
+                   [(tuple (list (bool true) (int 123)))    "[true 123]" (^ [_ (#;TupleS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])]
+                   [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;RecordS (list [[_ (#;BoolS true)] [_ (#;IntS 123)]]))])]
+                   [(local-tag "lol")                       "#lol"       [_ (#;TagS ["" "lol"])]]
+                   [(local-symbol "lol")                    "lol"        [_ (#;SymbolS ["" "lol"])]]
+                   )]
+    (test-all )))
diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux
new file mode 100644
index 000000000..99f8550c0
--- /dev/null
+++ b/stdlib/test/test/lux/macro/syntax.lux
@@ -0,0 +1,176 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             [number])
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])
+       (codata function))
+  lux/test)
+
+(test: "lux/macro/syntax exports [Part 1]"
+  (let% [ (do-template [    ]
+                          [(match (#;Right [_ ])
+                                  (s;run (list )
+                                         ))
+                           (match (#;Right [_ true])
+                                  (s;run (list )
+                                         ( )))
+                           (match (#;Right [_ []])
+                                  (s;run (list )
+                                         ( )))]
+
+                          [true           (ast;bool true)             s;bool   s;bool?   s;bool!]
+                          [123            (ast;int 123)               s;int    s;int?    s;int!]
+                          [123.0          (ast;real 123.0)            s;real   s;real?   s;real!]
+                          [#"\n"          (ast;char #"\n")            s;char   s;char?   s;char!]
+                          ["\n"           (ast;text "\n")             s;text   s;text?   s;text!]
+                          [["yolo" "lol"] (ast;symbol ["yolo" "lol"]) s;symbol s;symbol? s;symbol!]
+                          [["yolo" "lol"] (ast;tag ["yolo" "lol"])    s;tag    s;tag?    s;tag!]
+                          )
+          (do-template [ ]
+                         [(match (#;Right [_ [true 123]])
+                                 (s;run (list ( (list (ast;bool true) (ast;int 123))))
+                                        ( (s;seq s;bool s;int))))
+                          (match (#;Right [_ true])
+                                 (s;run (list ( (list (ast;bool true))))
+                                        ( s;bool)))
+                          (match (#;Left _)
+                                 (s;run (list ( (list (ast;bool true) (ast;int 123))))
+                                        ( s;bool)))
+                          (match (#;Right [_ (#;Left true)])
+                                 (s;run (list ( (list (ast;bool true))))
+                                        ( (s;alt s;bool s;int))))
+                          (match (#;Right [_ (#;Right 123)])
+                                 (s;run (list ( (list (ast;int 123))))
+                                        ( (s;alt s;bool s;int))))
+                          (match (#;Left _)
+                                 (s;run (list ( (list (ast;real 123.0))))
+                                        ( (s;alt s;bool s;int))))]
+
+                         [s;form  ast;form]
+                         [s;tuple ast;tuple])]
+    (test-all (match (#;Right [_ [_ (#;BoolS true)]])
+                     (s;run (list (ast;bool true) (ast;int 123))
+                            s;any))
+              
+              (match (#;Right [_ []])
+                     (s;run (list (ast;bool true) (ast;int 123))
+                            (s;assert true "yolo")))
+              (match (#;Left _)
+                     (s;run (list (ast;bool true) (ast;int 123))
+                            (s;assert false "yolo")))
+              (match (#;Right [_ +123])
+                     (s;run (list (ast;nat +123))
+                            s;nat))
+              (match (#;Left _)
+                     (s;run (list (ast;int -123))
+                            s;nat))
+              (match (#;Right [_ "yolo"])
+                     (s;run (list (ast;local-symbol "yolo"))
+                            s;local-symbol))
+              (match (#;Left _)
+                     (s;run (list (ast;symbol ["yolo" "lol"]))
+                            s;local-symbol))
+              (match (#;Right [_ "yolo"])
+                     (s;run (list (ast;local-tag "yolo"))
+                            s;local-tag))
+              (match (#;Left _)
+                     (s;run (list (ast;tag ["yolo" "lol"]))
+                            s;local-tag))
+              
+              )))
+
+(test: "lux/macro/syntax exports [Part 2]"
+  (test-all (match (#;Right [_ [true 123]])
+                   (s;run (list (ast;record (list [(ast;bool true) (ast;int 123)])))
+                          (s;record (s;seq s;bool s;int))))
+            (match (#;Right [_ (#;Some +123)])
+                   (s;run (list (ast;nat +123))
+                          (s;opt s;nat)))
+            (match (#;Right [_ #;None])
+                   (s;run (list (ast;int -123))
+                          (s;opt s;nat)))
+            (match (^ (#;Right [_ (list +123 +456 +789)]))
+                   (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789))
+                          (s;some s;nat)))
+            (match (^ (#;Right [_ (list)]))
+                   (s;run (list (ast;int -123))
+                          (s;some s;nat)))
+            (match (^ (#;Right [_ (list +123 +456 +789)]))
+                   (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789))
+                          (s;many s;nat)))
+            (match (^ (#;Right [_ (list +123)]))
+                   (s;run (list (ast;nat +123))
+                          (s;many s;nat)))
+            (match (#;Left _)
+                   (s;run (list (ast;int -123))
+                          (s;many s;nat)))
+            (match (#;Right [_ 123])
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;either s;pos-int s;int)))
+            (match (#;Right [_ -123])
+                   (s;run (list (ast;int -123) (ast;int 456) (ast;int 789))
+                          (s;either s;pos-int s;int)))
+            (match (#;Left _)
+                   (s;run (list (ast;bool true) (ast;int 456) (ast;int 789))
+                          (s;either s;pos-int s;int)))
+            (match (#;Right [_ true])
+                   (s;run (list)
+                          s;end?))
+            (match (#;Right [_ false])
+                   (s;run (list (ast;bool true))
+                          s;end?))
+            (match (#;Right [_ []])
+                   (s;run (list)
+                          s;end))
+            (match (#;Left _)
+                   (s;run (list (ast;bool true))
+                          s;end))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;exactly +3 s;int)))
+            (match (^ (#;Right [_ (list 123 456)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;exactly +2 s;int)))
+            (match (#;Left _)
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;exactly +4 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-least +3 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-least +2 s;int)))
+            (match (#;Left _)
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-least +4 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-most +3 s;int)))
+            (match (^ (#;Right [_ (list 123 456)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-most +2 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;at-most +4 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;between +3 +10 s;int)))
+            (match (#;Left _)
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;between +4 +10 s;int)))
+            (match (^ (#;Right [_ (list 123 456 789)]))
+                   (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789))
+                          (s;sep-by (s;text! "YOLO") s;int)))
+            (match (^ (#;Right [_ (list 123 456)]))
+                   (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789))
+                          (s;sep-by (s;text! "YOLO") s;int)))
+            (match (#;Left _)
+                   (s;run (list (ast;int 123) (ast;int 456) (ast;int 789))
+                          (s;not s;int)))
+            (match (#;Right [_ []])
+                   (s;run (list (ast;bool true) (ast;int 456) (ast;int 789))
+                          (s;not s;int)))
+            ))
diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux
new file mode 100644
index 000000000..3d5e053f7
--- /dev/null
+++ b/stdlib/test/test/lux/math.lux
@@ -0,0 +1,45 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             text/format
+             [number]
+             (struct [list "List/" Fold Functor])
+             [product])
+       (codata function)
+       math)
+  lux/test)
+
+(test: "lux/math exports"
+  (test-all (match 1.0 (cos 0.0))
+            (match -1.0 (cos (/. 2.0 tau)))
+            ## (match 0.0 (cos (/. 4.0 tau)))
+            ## (match 0.0 (cos (*. (/. 4.0 3.0) tau)))
+
+            (match 1.0 (sin (/. 4.0 tau)))
+            (match -1.0 (sin (*. (/. 4.0 3.0) tau)))
+            ## (match 0.0 (sin 0.0))
+            ## (match 0.0 (sin (/. 2.0 tau)))
+
+            (match 4 (ceil 3.75))
+            (match 3 (floor 3.75))
+            (match 4 (round 3.75))
+            (match 3 (round 3.25))
+
+            (match 3.0 (cbrt 27.0))
+            (match 4.0 (sqrt 16.0))
+
+            (match 90.0 (degrees (/. 4.0 tau)))
+            (match true (=. tau (radians (degrees tau))))
+
+            (match 9 (gcd 450 27))
+            (match 40 (lcm 10 8))
+
+            (match 27 (infix 27))
+            (match 9 (infix [27 gcd 450]))
+            (match 9 (infix [(* 3 9) gcd 450]))
+            (match true (infix [#and 27 < 450 < 2000]))
+            (match true (infix [#and 27 < 450 > 200]))
+            (match true (infix [[27 < 450] and [200 < 2000]]))
+            ))
diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux
new file mode 100644
index 000000000..a601bbf98
--- /dev/null
+++ b/stdlib/test/test/lux/pipe.lux
@@ -0,0 +1,47 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data text/format
+             [number]
+             [product]
+             identity)
+       (codata function)
+       pipe)
+  lux/test)
+
+(test: "lux/pipe exports"
+  (test-all (match 1 (|> 20
+                         (* 3)
+                         (+ 4)
+                         (_> 0 inc)))
+            (match 10 (|> 5
+                          (@> [(+ @ @)])))
+            (match 15 (|> 5
+                          (?> [even?] [(* 2)]
+                              [odd?] [(* 3)]
+                              [(_> -1)])))
+            (match 15 (|> 5
+                          (?> [even?] [(* 2)]
+                              [odd?] [(* 3)])))
+            (match 10 (|> 1
+                          (!> [(< 10)]
+                              [inc])))
+            (match 20 (|> 5
+                          (%> Monad
+                              [(* 3)]
+                              [(+ 4)]
+                              [inc])))
+            (match "five" (|> 5
+                              (case> 0 "zero"
+                                     1 "one"
+                                     2 "two"
+                                     3 "three"
+                                     4 "four"
+                                     5 "five"
+                                     6 "six"
+                                     7 "seven"
+                                     8 "eight"
+                                     9 "nine"
+                                     _ "???")))
+            ))
diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux
new file mode 100644
index 000000000..66355bdca
--- /dev/null
+++ b/stdlib/test/test/lux/regex.lux
@@ -0,0 +1,200 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data error
+             [product])
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax:])
+       test
+       [lexer]
+       regex))
+
+(syntax: (should-regex {veredict (s;alt s;bool s;any)} {regex s;text} {input s;text})
+  (case veredict
+    (+0 ?)
+    (if ?
+      (wrap (list (` (match+ (~ (ast;text input))
+                             (should-pass (lexer;run (regex (~ (ast;text regex)))
+                                                     (~ (ast;text input))))))))
+      (wrap (list (` (should-fail (lexer;run (regex (~ (ast;text regex)))
+                                             (~ (ast;text input))))))))
+
+    (+1 result)
+    (wrap (list (` (match+ (~ result)
+                           (should-pass (lexer;run (regex (~ (ast;text regex)))
+                                                   (~ (ast;text input))))))))))
+
+## [Tests]
+(test: "Regular Expressions [Basics]"
+  (test-all (should-regex true "a" "a")
+            (should-regex false "a" ".")
+            (should-regex true "\\." ".")
+            (should-regex false "\\." "a")
+            ))
+
+(test: "Regular Expressions [System character classes]"
+  (test-all (should-regex true "." "a")
+
+            (should-regex true "\\d" "0")
+            (should-regex false "\\d" "m")
+            (should-regex true "\\D" "m")
+            (should-regex false "\\D" "0")
+
+            (should-regex true "\\s" " ")
+            (should-regex false "\\s" "m")
+            (should-regex true "\\S" "m")
+            (should-regex false "\\S" " ")
+
+            (should-regex true "\\w" "_")
+            (should-regex false "\\w" "^")
+            (should-regex true "\\W" ".")
+            (should-regex false "\\W" "a")
+
+            (should-regex true "\\p{Lower}" "m")
+            (should-regex false "\\p{Lower}" "M")
+
+            (should-regex true "\\p{Upper}" "M")
+            (should-regex false "\\p{Upper}" "m")
+
+            (should-regex true "\\p{Alpha}" "M")
+            (should-regex false "\\p{Alpha}" "0")
+
+            (should-regex true "\\p{Digit}" "1")
+            (should-regex false "\\p{Digit}" "n")
+
+            (should-regex true "\\p{Alnum}" "1")
+            (should-regex false "\\p{Alnum}" ".")
+
+            (should-regex true "\\p{Space}" " ")
+            (should-regex false "\\p{Space}" ".")
+
+            (should-regex true "\\p{HexDigit}" "a")
+            (should-regex false "\\p{HexDigit}" ".")
+
+            (should-regex true "\\p{OctDigit}" "6")
+            (should-regex false "\\p{OctDigit}" ".")
+
+            (should-regex true "\\p{Blank}" "\t")
+            (should-regex false "\\p{Blank}" ".")
+
+            (should-regex true "\\p{ASCII}" "\t")
+            (should-regex false "\\p{ASCII}" "\u1234")
+
+            (should-regex true "\\p{Contrl}" "\u0012")
+            (should-regex false "\\p{Contrl}" "a")
+
+            (should-regex true "\\p{Punct}" "@")
+            (should-regex false "\\p{Punct}" "a")
+
+            (should-regex true "\\p{Graph}" "@")
+            (should-regex false "\\p{Graph}" " ")
+
+            (should-regex true "\\p{Print}" "\u0020")
+            (should-regex false "\\p{Print}" "\u1234")
+            ))
+
+(test: "Regular Expressions [Custom character classes]"
+  (test-all (should-regex true "[abc]" "a")
+            (should-regex false "[abc]" "m")
+
+            (should-regex true "[a-z]" "a")
+            (should-regex true "[a-z]" "m")
+            (should-regex true "[a-z]" "z")
+
+            (should-regex true "[a-zA-Z]" "a")
+            (should-regex true "[a-zA-Z]" "m")
+            (should-regex true "[a-zA-Z]" "z")
+            (should-regex true "[a-zA-Z]" "A")
+            (should-regex true "[a-zA-Z]" "M")
+            (should-regex true "[a-zA-Z]" "Z")
+
+            (should-regex false "[^abc]" "a")
+            (should-regex true "[^abc]" "m")
+
+            (should-regex false "[^a-z]" "a")
+            (should-regex true "[^a-z]" "0")
+            (should-regex false "[^a-zA-Z]" "a")
+            (should-regex true "[^a-zA-Z]" "0")
+
+            (should-regex false "[a-z&&[def]]" "a")
+            (should-regex true "[a-z&&[def]]" "d")
+
+            (should-regex true "[a-z&&[^bc]]" "a")
+            (should-regex false "[a-z&&[^bc]]" "b")
+
+            (should-regex true "[a-z&&[^m-p]]" "a")
+            (should-regex false "[a-z&&[^m-p]]" "m")
+            (should-regex false "[a-z&&[^m-p]]" "p")
+            ))
+
+(test: "Regular Expressions [Reference]"
+  (test-all (let [number (regex "\\d+")]
+              (should-regex ["809-345-6789" "809" "345" "6789"] "(\\@)-(\\@)-(\\@)" "809-345-6789"))
+            ))
+
+(test: "Regular Expressions [Quantifiers]"
+  (test-all (should-regex "aa" "aa" "aa")
+
+            (should-regex "a" "a?" "a")
+            (should-regex "" "a?" "")
+            
+            (should-regex "aaa" "a*" "aaa")
+            (should-regex "" "a*" "")
+            
+            (should-regex "aaa" "a+" "aaa")
+            (should-regex "a" "a+" "a")
+            (should-regex false "a+" "")
+
+            (should-regex "aa" "a{2}" "aa")
+            (should-regex "a" "a{1}" "aa")
+            (should-regex false "a{3}" "aa")
+
+            (should-regex "aa" "a{1,}" "aa")
+            (should-regex "aa" "a{2,}" "aa")
+            (should-regex false "a{3,}" "aa")
+
+            (should-regex "a" "a{,1}" "aa")
+            (should-regex "aa" "a{,2}" "aa")
+            (should-regex "aa" "a{,3}" "aa")
+
+            (should-regex "a" "a{1,2}" "a")
+            (should-regex "aa" "a{1,2}" "aa")
+            (should-regex "aa" "a{1,2}" "aaa")
+            ))
+
+(test: "Regular Expressions [Groups]"
+  (test-all (should-regex ["abc" "b"] "a(.)c" "abc")
+            (should-regex ["abbbbbc" "bbbbb"] "a(b+)c" "abbbbbc")
+            (should-regex ["809-345-6789" "809" "345" "6789"] "(\\d{3})-(\\d{3})-(\\d{4})" "809-345-6789")
+            (should-regex ["809-345-6789" "809" "6789"] "(\\d{3})-(?:\\d{3})-(\\d{4})" "809-345-6789")
+            (should-regex ["809-809-6789" "809" "6789"] "(\\d{3})-\\0-(\\d{4})" "809-809-6789")
+            (should-regex ["809-809-6789" "809" "6789"] "(?\\d{3})-\\k-(\\d{4})" "809-809-6789")
+            (should-regex ["809-809-6789-6789" "809" "6789"] "(?\\d{3})-\\k-(\\d{4})-\\0" "809-809-6789-6789")
+
+            (should-regex ["809-345-6789" "809" ["345-6789" "345" "6789"]] "(\\d{3})-((\\d{3})-(\\d{4}))" "809-345-6789")
+            ))
+
+(test: "Regular Expressions [Alternation]"
+  (test-all (should-regex ["a" (+0 [])] "a|b" "a")
+            (should-regex ["b" (+1 [])] "a|b" "b")
+            (should-regex false "a|b" "c")
+
+            (should-regex ["abc" (+0 "b")] "a(.)c|b(.)d" "abc")
+            (should-regex ["bcd" (+1 "c")] "a(.)c|b(.)d" "bcd")
+            (should-regex false "a(.)c|b(.)d" "cde")
+
+            (should-regex ["abc" (+0 ["b" "c"])] "a(.)(.)|b(.)(.)" "abc")
+            (should-regex ["bcd" (+1 ["c" "d"])] "a(.)(.)|b(.)(.)" "bcd")
+            (should-regex false "a(.)(.)|b(.)(.)" "cde")
+
+            (should-regex ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])]
+                          "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d"
+                          "809-345-6789")
+            ))
diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux
new file mode 100644
index 000000000..8fa871e70
--- /dev/null
+++ b/stdlib/test/test/lux/type.lux
@@ -0,0 +1,41 @@
+(;module:
+  lux
+  (lux (codata [io])
+       (control monad)
+       (data [text "Text/" Monoid]
+             [number])
+       type
+       (codata function))
+  lux/test)
+
+(test: "lux/type exports"
+  (let% [ (do-template []
+                      [(match true (:: Eq =  ))]
+
+                      [(#;HostT "java.util.List" (list Int))]
+                      [#;UnitT]
+                      [#;VoidT]
+                      [(#;VarT +123)]
+                      [(#;ExT +123)]
+                      [(#;BoundT +123)]
+                      [(#;LambdaT Bool Int)]
+                      [(#;AppT List Int)]
+                      [(#;NamedT ["" "Int-List"] (#;AppT List Int))]
+                      [(#;SumT Bool Int)]
+                      [(#;ProdT Bool Int)]
+                      [(#;UnivQ (list) (#;ProdT Bool (#;BoundT +1)))]
+                      [(#;ExQ (list) (#;ProdT Bool (#;BoundT +1)))]
+                      )]
+    (test-all 
+              (match (^=> (#;Some _type) (:: Eq = _type (#;ProdT Bool Int)))
+                     (apply-type (type (Meta Bool)) Int))
+              (match #;None (apply-type Text Bool))
+              (match true
+                     (:: Eq =
+                         (#;NamedT ["" "a"]
+                                   (#;ProdT Bool Int))
+                         (un-alias (#;NamedT ["" "c"]
+                                             (#;NamedT ["" "b"]
+                                                       (#;NamedT ["" "a"]
+                                                                 (#;ProdT Bool Int)))))))
+              )))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
new file mode 100644
index 000000000..7b760c0f1
--- /dev/null
+++ b/stdlib/test/tests.lux
@@ -0,0 +1,84 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad)
+       (codata [io])
+       (concurrency [promise])
+       [cli #+ program:]
+       [test])
+  (test lux
+        (lux (data [bit]
+                   [bool]
+                   [char]
+                   [error]
+                   [ident]
+                   [identity]
+                   [log]
+                   [maybe]
+                   [number]
+                   [product]
+                   [sum]
+                   [text]
+                   [text/format]
+                   (struct [array]
+                           [dict]
+                           [list]
+                           [queue]
+                           [set]
+                           [stack]
+                           [tree]
+                           [vector]
+                           [zipper]
+                           )
+                   )
+             ## (codata ["_;" io]
+             ##         [env]
+             ##         [state]
+             ##         (struct [stream]))
+             ## (macro [ast]
+             ##        [syntax])
+             ## [type]
+             ## (concurrency ["_;" promise]
+             ##              [frp]
+             ##              [stm]
+             ##              [actor]
+             ##              )
+             ## [host]
+             ## ["_;" cli]
+             ## [math]
+             ## [pipe]
+             ## [lexer]
+             ## [regex]
+             ## (data (format [json]))
+             )
+        )
+  ## (lux ## (codata [cont])
+  ##      ## (data (struct [stack]
+  ##      ##               [tree]
+  ##      ##               [zipper])
+  ##      ##       (error exception))
+  ##      ## (concurrency [atom])
+  ##      ## [macro]
+  ##      ## (macro [template]
+  ##      ##        [poly]
+  ##      ##        (poly ["poly_;" eq]
+  ##      ##              ["poly_;" text-encoder]
+  ##      ##              ["poly_;" functor]))
+  ##      ## (math [ratio]
+  ##      ##       [complex]
+  ##      ##       [random])
+  ##      ## (type [check] [auto])
+  ##      ## (control [effect])
+  ##      ["_;" lexer]
+  ##      ["_;" regex]
+  ##      (data (format ["_;" json]))
+  ##      )
+  )
+
+## [Program]
+(program: args
+  (test;run))
-- 
cgit v1.2.3